/*REXX*/
/*--- CLOCK --- MS/PCDOS/NIX/WIN ----------- 2019 - Mark McDonald ------
  Demonstrates how REXX can control screen colors, text positioning
  and detect key presses.

  Tested in DOS: IBM PCREXX, BREXX, Personal REXX
          Linux: Regina
       WIN/Wine: Regina, ooREXX (Using ANSICON)

  Screen is cleared and a 24hr digital clock is displayed using ANSI
  escape codes. Keyboard is scanned for a keypress.  User may press N
  or P to see next Digital Clock display character. Press Ctrl Z
  to exit program.

  DOS/Dosbox will show Graphic Chars, Win/Nix equivalent UTF-8 Chars

  Regina: Invoke program 'regina CLOCK2.REX' or Linux regina will
          not find the sysgetkey function in libregina3 library.
          (see Regina regutil.pdf for the tiny mention of this :)

  ANSICON utility provides ANSI.SYS support for Windows and Wine. Load
  before invoking this program otherwise you will just see ANSI codes.
----------------------------------------------------------------------*/
/*--- Determine OS (First word placed into TOS, Rest into .) ---*/
      PARSE SOURCE TOS .
/*--- Set Screen Title ---*/
      SELECT
        WHEN TOS == "DOS"       THEN VRX = "PCDOS REXX"
        WHEN TOS == "MSDOS"     THEN VRX = "DOS BREXX"
        WHEN TOS == "PCDOS"     THEN VRX = "DOS PREXX"
        WHEN TOS == "UNIX"      THEN VRX = "Linux REGINA"
        WHEN TOS == "WIN32"     THEN VRX = "Wine REGINA"
        WHEN TOS == "WindowsNT" THEN VRX = "Wine ooREXX"
        WHEN TOS == "LINUX"     THEN VRX = "Linux ooREXX"
        OTHERWISE VRX = "Who Knows?"
      END
/*--- Get Interpreter Keyboard Support Code IF Needed ---*/
      SELECT
        WHEN TOS == "DOS" THEN NOP
        WHEN TOS == "MSDOS" THEN CALL IMPORT '\U\REXX\BREXX\CONIO.R'
        WHEN TOS == "PCDOS" THEN NOP
        WHEN TOS == "UNIX"  THEN CALL rxfuncadd 'SYSGETKEY','rexxutil','sysgetkey'
        /*WHEN TOS == "LINUX" THEN CALL rxfuncadd 'SYSGETKEY','rexxutil','SysGetKey'*/
        WHEN TOS == "WIN32" | TOS = "WindowsNT" THEN DO
         CALL rxfuncadd 'SYSGETKEY','RexxUtil','sysgetkey';END
        OTHERWISE NOP
      END
/*--- Init Vars --*/
      ESC = "1B"x||"["                      ;/*ANSI Prefix            */
      AC = 12                               ;/*Default Color          */
      DC.0  = 14                            ;/*Set # of Display Chars */
      DC.1  = "X"                           ;/*Display Char X         */
      DC.2  = "N"                           ;/*Explicit Numeral       */
      DC.3  = "#"                           ;/*Pound                  */
      DC.4  = "@"                           ;/*AT                     */
      DC.5  = X2C("DB")                     ;/*DOS Block Char         */
      DC.6  = X2C("DF")                     ;/*DOS Horizonal Char     */
      DC.7  = X2C("DD")                     ;/*DOS Vertical Char      */
      DC.8  = X2C("B0")                     ;/*DOS Light Shade Char   */
      DC.9  = X2C("B1")                     ;/*DOS Medium Shade Char  */
      DC.10 = X2C("B2")                     ;/*DOS Heavy Shade Char   */
      DC.11 = X2C("B3")                     ;/*DOS Single Bar         */
      DC.12 = X2C("7C")                     ;/*DOS REXX OR Char       */
      DC.13 = X2C("AF")                     ;/*NIX Bar Char           */
      DC.14 = X2C("7F")                     ;/*NIX Box Char           */
      DT = 1                                ;/*Set Initial Disp Char  */
      DCC = 1                               ;/*Display Char Count     */
      CSS = 10                              ;/*Character Width        */
      R = 8                                 ;/*Start Row              */
      HLP = 2                               ;/*Hours Left             */
      HRP = HLP + CSS                       ;/*Hours Right            */
      CLP = HRP + CSS                       ;/*Colon Left             */
      MLP = CLP + CSS                       ;/*Minutes Left           */
      MRP = MLP + CSS                       ;/*Minutes Right          */
      CRP = MRP + CSS                       ;/*Colon Right            */
      SLP = CRP + CSS                       ;/*Seconds Left           */
      SRP = SLP + CSS                       ;/*Seconds Right          */
/*--- Define Character Patterns 8x7 ---*/
      CP.0  = "XXXXXXXXXX    XXXX    XXXX    XXXX    XXXX    XXXXXXXXXX"
      CP.1  = "  XXX      XX      XX      XX      XX      XX    XXXXXXX"
      CP.2  = "XXXXXXXXXX    XX      XXXXXXXXXXXX      XX    XXXXXXXXXX"
      CP.3  = "XXXXXXXXXX    XX      XXXXXXXXXX      XXXX    XXXXXXXXXX"
      CP.4  = "XX    XXXX    XXXX    XXXXXXXXXX      XX      XX      XX"
      CP.5  = "XXXXXXXXXX      XX      XXXXXXXX      XXXX    XXXXXXXXXX"
      CP.6  = "XXXXXXXXXX    XXXX      XXXXXXXXXX    XXXX    XXXXXXXXXX"
      CP.7  = "XXXXXXXXXX    XX      XX      XX      XX      XX      XX"
      CP.8  = "XXXXXXXXXX    XXXX    XXXXXXXXXXXX    XXXX    XXXXXXXXXX"
      CP.9  = "XXXXXXXXXX    XXXX    XXXXXXXXXX      XXXX    XXXXXXXXXX"
      CP.10 = "                   XX              XX                   "
/*--- Display Static Screen Info ---*/
GOTO1:
      CALL ASAY 0,0,0,""                    ;/*Clear Screen Area      */
      CALL ASAY 1,1,AC,CENTER("REXX Digital Clock Using "VRX,80," ")
      CALL ASAY 22,1,AC,CENTER(DATE(),80," ")
      CALL ASAY 24,1,8,CENTER("Ctrl Z to Exit, (N)ext/(P)rior Mode = "DCC,80," ")
      CALL ASAY 24,38,15,"N";CALL ASAY 24,45,15,"P"  ;/*Hilite N & P  */
GOTO2:
      CALL ASAY 24,59,13,DCC||" "           ;/*Disp Current Char Mode */
/*--- Hold/Old Time Values ---*/
      OHL = " "; OHR = " "                  ;/*Hour Left/Right #      */
      OML = " "; OMR = " "                  ;/*Minute Left/Right #    */
      OSL = " "; OSR = " "                  ;/*Second Left/Right #    */
      H = "00:00:00"                        ;/*Beginning Time String  */
      CCN = 0                               ;/*Current Color          */
/*--- Display Colon ---*/
      CALL BUILDNUMBER 10
      DO X = 1 TO 7
         CALL ASAY R+X-1,CLP,AC,CL.X       ;/*Left Colon              */
         CALL ASAY R+X-1,CRP,AC,CL.X       ;/*Right Colon             */
      END
/*--- Display Time ---*/
      DO FOREVER
         D = TIME('N')                      ;/*Get System Time        */
         IF D == "00:00:01" THEN SIGNAL GOTO1 ;/*Resets Date Display  */
         IF D == H THEN ITERATE             ;/*Any Change?            */
         CALL BUILDTIMEDISPLAY
         TKEY = ""
         /*--- Key Pressed? ---*/
         SELECT
           WHEN TOS == "DOS"       THEN DO;IF CHARS('') <> 0 THEN TKEY = RXGETKEY('NOECHO');END
           WHEN TOS == "MSDOS"     THEN DO;IF KBHIT() <> 0 THEN TKEY = GETCHE();END
           WHEN TOS == "PCDOS"     THEN DO;TKEY = INKEY("NOWAIT");END
           /*WHEN TOS == "LINUX"     THEN DO;TKEY = SYSGETKEY("NOECHO");END*/
           WHEN TOS == "UNIX"      THEN DO;TKEY = SYSGETKEY('n','.001');END
           WHEN TOS == "WIN32"     THEN DO;TKEY = SYSGETKEY('n','.001');END
           WHEN TOS == "WindowsNT" THEN DO;IF CHARS('') <> 0 THEN TKEY = SYSGETKEY('NOECHO');END
           OTHERWISE ITERATE
         END
         IF (TKEY = "" | TKEY = " ") THEN ITERATE
         /*--- Key press ocurred ---*/
         SELECT
           WHEN TKEY == "1A"x THEN SIGNAL EEXIT        ;/*CTRL Z -Exit*/
           WHEN TRANSLATE(TKEY) == "N" THEN DO         ;/*Next Char   */
                DCC =  DCC + 1
                IF DCC > DC.0 THEN DCC = 1
                DT = DC.DCC
                SIGNAL GOTO2; END
           WHEN TRANSLATE(TKEY) == "P" THEN DO         ;/*Prev Char   */
                DCC =  DCC - 1
                IF DCC < 1 THEN DCC = DC.0
                DT = DC.DCC
                SIGNAL GOTO2; END
           OTHERWISE NOP
         END
      END
EEXIT:
  CALL ASAY 0,0,7,""
  EXIT
/*--------------------------------------------------------------------*/
/*                            SUBROUTINES                             */
/*--------------------------------------------------------------------*/
BUILDTIMEDISPLAY:
  PARSE VALUE D WITH HL 2 HR 3 CX 4 ML 5 MR 6 CX 7 SL 8 SR
  SELECT
    WHEN SR <> OSR THEN DO; T = SR; C = SRP; OSR = SR; END;/*Right Sec*/
    WHEN SL <> OSL THEN DO; T = SL; C = SLP; OSL = SL; END;/*Left Sec */
    WHEN MR <> OMR THEN DO; T = MR; C = MRP; OMR = MR; END;/*Right Min*/
    WHEN ML <> OML THEN DO; T = ML; C = MLP; OML = ML; END;/*Left Min */
    WHEN HR <> OHR THEN DO; T = HR; C = HRP; OHR = HR; END;/*Right Hrs*/
    WHEN HL <> OHL THEN DO; T = HL; C = HLP; OHL = HL; END;/*Left Hrs */
    OTHERWISE RETURN
  END
   CALL BUILDNUMBER T
   CALL DISPLAYNUMBER
RETURN
/*--------------------------------------------------------------------*/
DISPLAYNUMBER:
  CCN = CCN + 1                             ;/*Increment Attribute    */
  IF CCN == 8 THEN CCN = 9
  IF CCN > 15 THEN CCN = 1
  DO X = 1 TO 7
     CALL ASAY R+X-1,C,CCN,CL.X             ;/*Display Number Array   */
  END
  CALL ASAY 24,60,0,""
RETURN
/*--------------------------------------------------------------------*/
BUILDNUMBER:
  ARG T
  /*--- Det Char to Display for Numeral ---*/
  SELECT
    WHEN DCC == 1 THEN DCT = "X"
    WHEN DCC == 2 THEN DCT = T
    OTHERWISE DCT = DC.DCC
  END
  CPT = TRANSLATE(CP.T,DCT,"X")
  PARSE VALUE CPT WITH CL.1 9 CL.2 17 CL.3 25 CL.4 33 CL.5 41 CL.6 49 CL.7
RETURN
/*--------------------------------------------------------------------*/
ASAY: PROCEDURE                                 ;/*Say w/o CRLF       */
  PARSE ARG ROW,COL,ATTR,TSTR
  /*--- Set ANSI Codes (256 Color Combinations) ---*/
  AF = "30 34 32 36 31 35 33 37 1;30 1;34 1;32 1;36 1;31 1;35 1;33 1;37"
  AB = "40m 44m 42m 46m 41m 45m 43m 47m 5;40m 5;44m 5;42m 5;46m 5;41m 5;45m 5;43m 5;47m"
  ESC = "1b"x||"["                              ;/*Set ESC Code       */
  CF = (ATTR // 16)                             ;/*Calc Fore Color    */
  CB = (((ATTR - CF) / 16) // 128)              ;/*Calc Back Color    */
  FC = WORD(AF,(CF+1)); BC = WORD(AB,(CB+1))    ;/*Det ANSI Color     */
  IF ROW == 0 THEN TSTR = ESC||"2J"             ;/*Clear Screen?      */
  IF ROW <> 0 THEN TSTR = TSTR||ESC||"0m"       ;/*Not Clearing Scrn  */
  TC = ESC||FC||";"||BC                         ;/*Set ANSI Color     */
  SP = ESC||ROW||";"||COL||"H"                  ;/*Set Position       */
  T = CHAROUT('',SP||TC||TSTR)                  ;/*Send to Screen     */
RETURN
/*--------------------------------------------------------------------*/