* calc.cbl
      *Author: Tim Corrie Jr. 10/13/2021 first COBOL program, tried to keep generic
      *Written for gnuCOBOL
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MAIN.

       DATA DIVISION.
         WORKING-STORAGE SECTION.
       01 KBD-NAME EXTERNAL.
         05 KBD-NAME-ARRAY OCCURS 20 TIMES PIC A(3).
       01 KBD-COLOR-ARRAY EXTERNAL.
         05 KBD-COLOR OCCURS 20 TIMES PIC 9(10).
       01 ACOLOR-ARRAY.
         05 ACOLOR OCCURS 4 TIMES PIC 9(10).
       01 STDIN-LINE PIC X(64).
       01 OUTSTR PIC X(4096).
       01 I PIC 99.
       01 J PIC 99.
       01 IJ PIC 99.
       01 KEY-ROW PIC 9(5).
       01 KEY-COL PIC 9(5).
       01 ROWCOL PIC 99.
       01 BEGIN-X PIC 9(5).
       01 BEGIN-Y PIC 9(5).
       01 END-X PIC 9(5).
       01 END-Y PIC 9(5).
         77 NZ-BEGIN-X PIC Z(4)9.
         77 NZ-BEGIN-Y PIC Z(4)9.
         77 NZ-END-X PIC Z(4)9.
         77 NZ-END-Y PIC Z(4)9.
         77 NZ-BUTTON PIC Z(4)9.
         77 NZ-Y PIC Z(4)9.
         77 NZ-COLOR PIC Z(9)9.
       01 BUTTON-X-Y.
        05 BUTTON PIC S9(5).
        05 X PIC S9(5).
        05 Y PIC S9(5).

       PROCEDURE DIVISION.
       MOVE 2628095  TO ACOLOR(1)
       MOVE 1015567  TO ACOLOR(2)
       MOVE 986895   TO ACOLOR(3)
       MOVE 12632256 TO ACOLOR(4)

       MOVE "Off" TO KBD-NAME-ARRAY(1)
       MOVE "C"   TO KBD-NAME-ARRAY(2)
       MOVE "<x]" TO KBD-NAME-ARRAY(3)
       MOVE "*"   TO KBD-NAME-ARRAY(4)
       MOVE "7"   TO KBD-NAME-ARRAY(5)
       MOVE "8"   TO KBD-NAME-ARRAY(6)
       MOVE "9"   TO KBD-NAME-ARRAY(7)
       MOVE "/"   TO KBD-NAME-ARRAY(8)
       MOVE "4"   TO KBD-NAME-ARRAY(9)
       MOVE "5"   TO KBD-NAME-ARRAY(10)
       MOVE "6"   TO KBD-NAME-ARRAY(11)
       MOVE "+"   TO KBD-NAME-ARRAY(12)
       MOVE "1"   TO KBD-NAME-ARRAY(13)
       MOVE "2"   TO KBD-NAME-ARRAY(14)
       MOVE "3"   TO KBD-NAME-ARRAY(15)
       MOVE "-"   TO KBD-NAME-ARRAY(16)
       MOVE "0"   TO KBD-NAME-ARRAY(17)
       MOVE "."   TO KBD-NAME-ARRAY(18)
       MOVE "+/-" TO KBD-NAME-ARRAY(19)
       MOVE "="   TO KBD-NAME-ARRAY(20)

       MOVE 2628095 TO KBD-COLOR(1)
       MOVE 2628095 TO KBD-COLOR(2)
       MOVE 2628095 TO KBD-COLOR(3)
       MOVE 1015567 TO KBD-COLOR(4)
       MOVE 986895  TO KBD-COLOR(5)
       MOVE 986895  TO KBD-COLOR(6)
       MOVE 986895  TO KBD-COLOR(7)
       MOVE 1015567 TO KBD-COLOR(8)
       MOVE 986895  TO KBD-COLOR(9)
       MOVE 986895  TO KBD-COLOR(10)
       MOVE 986895  TO KBD-COLOR(11)
       MOVE 986895  TO KBD-COLOR(12)
       MOVE 986895  TO KBD-COLOR(13)
       MOVE 986895  TO KBD-COLOR(14)
       MOVE 986895  TO KBD-COLOR(15)
       MOVE 1015567 TO KBD-COLOR(16)
       MOVE 986895  TO KBD-COLOR(17)
       MOVE 986895  TO KBD-COLOR(18)
       MOVE 986895  TO KBD-COLOR(19)
       MOVE 1015567 TO KBD-COLOR(20)

       PERFORM UNTIL 1=0
       ACCEPT STDIN-LINE FROM SYSIN
      * 1 IF
       IF STDIN-LINE IS EQUAL TO "drawapp" THEN 
       MOVE 1 TO IJ
       DISPLAY "Fo 0 611 3"
       DISPLAY "Fo 2 140 3"
       DISPLAY "F 0 16777215"
       DISPLAY "FR 0 0 0 10000 10000"
       DISPLAY "Z "
       INITIALIZE OUTSTR
       STRING
           "                       0"
         INTO OUTSTR
       END-STRING
       CALL "DISPLAYSTR" USING OUTSTR
       DISPLAY  "B 0 12632256"
       PERFORM VARYING I FROM 0 BY 1 UNTIL I > 4
       PERFORM VARYING J FROM 0 BY 1 UNTIL J > 3
       DISPLAY  "F 0 10526880"
       MULTIPLY 2000 BY J GIVING BEGIN-X
       ADD 220 TO BEGIN-X GIVING BEGIN-X
       MULTIPLY 1200 BY I GIVING BEGIN-Y
       ADD 1220 TO BEGIN-Y GIVING BEGIN-Y
       MULTIPLY 2000 BY J GIVING END-X
       ADD 2080 TO END-X GIVING END-X
       MULTIPLY 1200 BY I GIVING END-Y
       ADD 2280 TO END-Y GIVING END-Y
       MOVE BEGIN-X TO NZ-BEGIN-X
       MOVE BEGIN-Y TO NZ-BEGIN-Y
       MOVE END-X TO NZ-END-X
       MOVE END-Y TO NZ-END-Y
       INITIALIZE OUTSTR
       STRING
           'FR 0 '
           FUNCTION TRIM(NZ-BEGIN-X LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-BEGIN-Y LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-END-X LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-END-Y LEADING) DELIMITED BY SIZE
         INTO OUTSTR
       END-STRING
       DISPLAY FUNCTION TRIM(OUTSTR TRAILING)
       DISPLAY "F 0 986895"
       MULTIPLY 2000 BY J GIVING BEGIN-X
       ADD 200 TO BEGIN-X GIVING BEGIN-X
       MULTIPLY 1200 BY I GIVING BEGIN-Y
       ADD 1200 TO BEGIN-Y GIVING BEGIN-Y
       MULTIPLY 2000 BY J GIVING END-X
       ADD 2100 TO END-X GIVING END-X
       MULTIPLY 1200 BY I GIVING END-Y
       ADD 2300 TO END-Y GIVING END-Y
       MOVE BEGIN-X TO NZ-BEGIN-X
       MOVE BEGIN-Y TO NZ-BEGIN-Y
       MOVE END-X TO NZ-END-X
       MOVE END-Y TO NZ-END-Y
       INITIALIZE OUTSTR
       STRING
           'R 0 '
           FUNCTION TRIM(NZ-BEGIN-X LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-BEGIN-Y LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-END-X LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-END-Y LEADING) DELIMITED BY SIZE
         INTO OUTSTR
       END-STRING
       DISPLAY function TRIM(OUTSTR TRAILING)
       MOVE KBD-COLOR(IJ) TO NZ-COLOR
       INITIALIZE OUTSTR
       STRING
           "F 0 "
           FUNCTION TRIM(NZ-COLOR LEADING) DELIMITED BY SIZE
         INTO OUTSTR
       END-STRING
       DISPLAY function TRIM(OUTSTR TRAILING)
       MULTIPLY 2000 BY J GIVING BEGIN-X
       ADD 1100 TO BEGIN-X GIVING BEGIN-X
       MULTIPLY 1200 BY I GIVING BEGIN-Y
       ADD 1700 TO BEGIN-Y GIVING BEGIN-Y
       INITIALIZE OUTSTR
       MOVE BEGIN-X TO NZ-BEGIN-X
       MOVE BEGIN-Y TO NZ-BEGIN-Y
       STRING
           'C$ 0 '
           FUNCTION TRIM(NZ-BEGIN-X LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-BEGIN-Y LEADING) DELIMITED BY SIZE
           '"'
           KBD-NAME-ARRAY(IJ) DELIMITED BY SPACE
           '"'
         INTO OUTSTR
       END-STRING
       DISPLAY function TRIM(OUTSTR TRAILING)
       ADD 1 TO IJ giving IJ
       END-PERFORM
       END-PERFORM
       DISPLAY 'F 0 1810468'
       DISPLAY 'C$ 0 5000 800"COBOL cloud app"'
       DISPLAY 'F 2 255'
       DISPLAY 'C$ 2 5000 7200"Corrie Zucker Technologies LLC."'
       DISPLAY 'C$ 2 5000 7340"d/b/a CZ Technologies"'
       DISPLAY 'Z '
      * ELSE 1
       ELSE
      *  IF 2
       IF STDIN-LINE IS EQUAL TO "QUERY_REMOTE" THEN 
         DISPLAY "Rz 1200 900"
      *  ELSE 2
       ELSE
       UNSTRING STDIN-LINE DELIMITED BY ALL SPACES
       INTO
       BUTTON
       X
       Y
       END-UNSTRING
      *   IF 3
       IF X IS EQUAL TO -2 THEN
       EVALUATE BUTTON
       WHEN 79
       WHEN 111
       MOVE 1 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 99
       WHEN 67
       MOVE 2 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 8
       MOVE 3 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 42
       MOVE 4 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 55
       MOVE 5 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 56
       MOVE 6 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 57
       MOVE 7 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 47
       MOVE 8 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 52
       MOVE 9 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 53
       MOVE 10 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 54
       MOVE 11 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 43
       MOVE 12 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 49
       MOVE 13 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 50
       MOVE 14 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 51
       MOVE 15 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 45
       MOVE 16 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 48
       MOVE 17 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 46
       MOVE 18 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 105
       MOVE 19 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 73
       MOVE 19 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       WHEN 61
       MOVE 20 TO ROWCOL
       CALL "KEYTOEXE" USING ROWCOL
       END-EVALUATE
      *   ELSE 3
       ELSE
      *   IF 4
       IF X IS GREATER THAN OR EQUAL TO 0 THEN
       SUBTRACT 1200 FROM Y GIVING KEY-ROW
       DIVIDE 1200 INTO KEY-ROW GIVING KEY-ROW
       SUBTRACT 200 FROM X GIVING KEY-COL
       DIVIDE 2000 INTO KEY-COL GIVING KEY-COL
       MULTIPLY KEY-ROW BY 4 GIVING ROWCOL
       ADD KEY-COL TO ROWCOL GIVING ROWCOL
       ADD 1 TO ROWCOL GIVING ROWCOL
      *    IF 5
       IF KEY-ROW IS GREATER THAN OR EQUAL TO 0 AND
            KEY-ROW IS LESS THAN OR EQUAL TO 4 AND 
            KEY-COL IS GREATER THAN OR EQUAL TO 0 AND
            KEY-COL IS LESS THAN OR EQUAL TO 3 THEN
        CALL "KEYTOEXE" USING ROWCOL
      *   END-IF 5
       END-IF
      *   ELSE 4
       ELSE
      *    IF 5
       IF X EQUAL TO -4 THEN
       MOVE BUTTON TO NZ-BUTTON
       MOVE Y TO NZ-Y
       INITIALIZE OUTSTR
       STRING
           'Rz '
           FUNCTION TRIM(NZ-BUTTON LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-Y LEADING) DELIMITED BY SIZE
           ' '
         INTO OUTSTR
       END-STRING
       DISPLAY function TRIM(OUTSTR TRAILING)
      *   ELSE 5
       ELSE
      *   IF 5
       IF X EQUAL TO -5 THEN
       MOVE BUTTON TO NZ-BUTTON
       MOVE Y TO NZ-Y
       INITIALIZE OUTSTR
       STRING
           'Mv '
           FUNCTION TRIM(NZ-BUTTON LEADING) DELIMITED BY SIZE
           ' '
           FUNCTION TRIM(NZ-Y LEADING) DELIMITED BY SIZE
           ' '
         INTO OUTSTR
       END-STRING
       DISPLAY function TRIM(OUTSTR TRAILING)
      *    END-IF 5
       END-IF
      *   END-IF 4
       END-IF
      *   END-IF 3
       END-IF
      *  END-IF 2
       END-IF
      * END-IF 1
       END-IF
       END-PERFORM
       EXIT PROGRAM.