! calc.f90
!Author: Tim Corrie Jr. 10/08/2021 first FORTRAN program, at least since 1980 tried to keep generic
!Written for gfortran

subroutine displaystr(psz, color)
    character(len=24) :: psz
    integer :: color
    character(len=4096) :: outstr
    character(len=4096) :: outstrb
    WRITE(outstr,*) "F 0 16777215"
    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
    WRITE(outstr,*) "FR 0 0 0 9900 600"
    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
    WRITE(outstr,*) "F 0 ", color
    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
    WRITE(outstr,*) "R 0 100 100 9800 500"
    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
    WRITE(outstr,*) '"'//TRIM(ADJUSTL(TRIM(psz)))//'"'
    WRITE(outstrb,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
    WRITE(outstr,*) "R$ 0 9800 520", TRIM(ADJUSTL(TRIM(outstrb)))
    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
    WRITE(*,"(A)") "Z "
end subroutine

subroutine keytoexe(rowcol)
    integer :: rowcol
    logical :: gfisnumberentering
    logical :: gfnotexit
    character(len=1) :: gbinop
    character(len=24) :: gdisplaystr
    character(len=3) :: gkbdname(20)
    real :: gax
    real :: gbx
    common / globals / gfisnumberentering, gfnotexit, gbinop, gdisplaystr, gkbdname, gax, gbx

    character(len=4096) :: outstr
    character(len=4096) :: outstrb
    IF ( ( rowcol .EQ. 4) .OR. ( rowcol .EQ. 5) .OR. ( rowcol .EQ. 6) .OR. ( rowcol .EQ. 8) .OR. &
         ( rowcol .EQ. 9) .OR. ( rowcol .EQ. 10) .OR. ( rowcol .EQ. 12) .OR. ( rowcol .EQ. 13) .OR. &
         ( rowcol .EQ. 14) .OR. ( rowcol .EQ. 16) .OR. ( rowcol .EQ. 17 ) ) THEN
      IF ( gfisnumberentering ) THEN
          IF ( len( TRIM(ADJUSTL(TRIM(gdisplaystr))) ) .LT. ( MAXDISP - 1 ) ) THEN
              WRITE(outstr,*) TRIM(ADJUSTL(TRIM(gdisplaystr))), TRIM(ADJUSTL(TRIM(gkbdname(rowcol+1))))
              WRITE(gdisplaystr,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
          END IF
      ELSE
          WRITE(gdisplaystr,"(A)") TRIM(ADJUSTL(TRIM(gkbdname(rowcol+1))))
          gfisnumberentering = .TRUE.
      END IF
      call displaystr( gdisplaystr, 6052991 )
    ELSE IF ( rowcol .EQ. 0 ) THEN
      WRITE(outstr,*) "O 0 0 0"
        WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
      gfnotexit = .FALSE.
    ELSE IF ( rowcol .EQ. 1 ) THEN
      gdisplaystr="                   "
      call displaystr( "                       0", 6052991 )
      gfisnumberentering = .FALSE.
    ELSE IF ( rowcol .EQ. 2 ) THEN
      IF ( len( TRIM(gdisplaystr) ) .GT. 0 ) THEN
          IF ( len(TRIM(gdisplaystr)) .EQ. 1 ) THEN
              call displaystr( "0", 6052991 )
          END IF
          WRITE(gdisplaystr,*) gdisplaystr(:len(TRIM(gdisplaystr))-1)
          IF ( len( TRIM(gdisplaystr) ) .GT. 0 ) THEN
              call displaystr( gdisplaystr, 6052991 )
          END IF
      END IF
    ELSE IF ( rowcol .EQ. 18 ) THEN
       IF ( len( TRIM(gdisplaystr) ) .GT. 0 ) THEN
           IF ( gdisplaystr(1:1) .EQ. "-" ) THEN
              WRITE(outstr,*) TRIM(ADJUSTL(TRIM(gdisplaystr(2:))))
              WRITE(gdisplaystr,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
           ELSE IF ( len(TRIM(gdisplaystr)) .LT. ( MAXDISP - 1 ) ) THEN
              WRITE(outstr,*) TRIM(ADJUSTL(TRIM("-"))), TRIM(ADJUSTL(TRIM(gdisplaystr)))
              WRITE(gdisplaystr,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
           END IF
           call displaystr( gdisplaystr, 6052991 )
       END IF
    ELSE IF ( ( rowcol .EQ. 3) .OR. (rowcol .EQ. 7) .OR. ( rowcol .EQ. 11) .OR. ( rowcol .EQ. 15 ) ) THEN
       gbinop = TRIM(gkbdname(rowcol+1))
       READ( gdisplaystr, * ) gax
       gfisnumberentering = .FALSE.
    ELSE IF ( rowcol .EQ. 19 ) THEN
       IF ( gfisnumberentering ) THEN
           READ( gdisplaystr, * ) gbx
           gfisnumberentering = .FALSE.
       END IF
       IF ( gbinop .EQ. "*" ) THEN
           gax = gax * gbx
       ELSE IF ( gbinop .EQ. "/" ) THEN
           gax = gax / gbx
       ELSE IF ( gbinop .EQ. "+" ) THEN
           gax = gax + gbx
       ELSE IF ( gbinop .EQ. "-" ) THEN
           gax = gax - gbx
       END IF
       WRITE(outstr,*) gax
       WRITE(gdisplaystr,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
       call displaystr( gdisplaystr, 6052991 )
    END IF
end subroutine

program calc
    implicit none
    logical :: gfisnumberentering
    logical :: gfnotexit
    character(len=1) :: gbinop
    character(len=24) :: gdisplaystr
    character(len=3) :: gkbdname(20)
    real :: gax
    real :: gbx
    common / globals / gfisnumberentering, gfnotexit, gbinop, gdisplaystr, gkbdname, gax, gbx
    integer :: acolor(4)
    integer kbd_color(20)
    character(len=4096) :: outstr
    character(len=4096) :: outstrb
    character(len=64) :: line
    integer :: MAXDISP
    integer :: i
    integer :: row
    integer :: col
    integer :: x
    integer :: y
    integer :: button
    gfisnumberentering = .FALSE.
    gfnotexit = .TRUE.
    gdisplaystr = ""
    MAXDISP = 24
    acolor = (/ 2628095,1015567,986895,12632256 /)
    gkbdname = (/ "Off", "C  ", "<x]", "*  ", "7  ", "8  ", "9  ", "/  ", "4  ", "5  ", "6  ", "+  ", &
                "1  ", "2  ", "3  ", "-  ", "0  ", ".  ", "+/-", "=  " /)
    kbd_color = (/ 2628095, 2628095, 2628095, 1015567, 986895, 986895, 986895, 1015567, 986895, 986895, 986895, 986895, &
                 986895, 986895, 986895, 1015567, 986895, 986895, 986895, 1015567 /)
    DO WHILE ( gfnotexit )
        READ(*,"(A)") line
        line = ADJUSTL(TRIM(line))
        IF ( line .EQ. "drawapp" ) THEN
            WRITE(outstr,*) "Fo 0 611 3"
            WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) "Fo 2 140 3"
            WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) "F 0 16777215"
            WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) "FR 0 0 0 10000 10000"
            WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            call displaystr( "                       0", 6052991 )
            WRITE(outstr,*) "B 0 12632256"
            WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            DO i = 0, 19
                WRITE(outstr,*) "F 0 10526880"
                  WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
                WRITE(outstr,*) (int(i/4)*1200+2280)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (MOD(i,4)*2000+2080), TRIM(outstrb)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (int(i/4)*1200+1220), TRIM(outstrb)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (MOD(i,4)*2000+220), TRIM(outstrb)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) "FR 0 ", TRIM(ADJUSTL(TRIM(outstrb)))
                    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))

                WRITE(outstr,*) "F 0 986895"
                  WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))

                WRITE(outstr,*) (int(i/4)*1200+2300)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (MOD(i,4)*2000+2100), TRIM(outstrb)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (int(i/4)*1200+1200), TRIM(outstrb)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (MOD(i,4)*2000+200), TRIM(outstrb)
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) "R 0 ", TRIM(ADJUSTL(TRIM(outstrb)))
                    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))

                WRITE(outstr,*) kbd_color(i+1)
                WRITE(outstrb,*) "F 0 ", TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstrb)))

                WRITE(outstr,*) '"'//TRIM(ADJUSTL(TRIM(gkbdname(i+1))))//'"'
                  WRITE(outstrb,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (int(i/4)*1200+1700), ADJUSTL(TRIM(outstrb))
                  WRITE(outstrb," (A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) (MOD(i,4)*2000+1100), ADJUSTL(TRIM(outstrb))
                  WRITE(outstrb,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
                  WRITE(outstr,*) "C$ 0 ", TRIM(ADJUSTL(TRIM(outstrb)))
                    WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))

            END DO
            WRITE(outstr,*) 'F 0 1810468'
              WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) 'C$ 0 5000 800 "FORTRAN cloud app"'
              WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) 'F 2 255'
              WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) 'C$ 2 5000 7200"Corrie Zucker Technologies LLC."'
              WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) 'C$ 2 5000 7340"d/b/a CZ Technologies"'
              WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
            WRITE(outstr,*) 'Z '
              WRITE(*," (A)") TRIM(ADJUSTL(TRIM(outstr)))
        ELSE IF ( line .EQ. "QUERY_REMOTE" ) THEN
            WRITE(outstr,*) "Rz 1200 900"
              WRITE(*,"(A)") TRIM(ADJUSTL(TRIM(outstr)))
        ELSE
            READ(line,*) button
            line = ADJUSTL(TRIM(line))
            line = ADJUSTL(TRIM(line(INDEX(line," ")+1:)))
            READ(line,*) x
            line = ADJUSTL(TRIM(line))
            line = ADJUSTL(TRIM(line(INDEX(line," ")+1:)))
            READ(line,*) y
            IF ( x .EQ. -98 ) THEN
              call sleep(1)
            ELSE
            IF ( x .EQ. -2 ) THEN
             SELECT CASE (button)
              CASE (79)
               call keytoexe(0)
              CASE (111)
               call keytoexe(0)
              CASE (99)
               call keytoexe(1)
              CASE (67)
               call keytoexe(1)
              CASE (8)
               call keytoexe(2)
              CASE (42)
               call keytoexe(3)
              CASE (55)
               call keytoexe(4)
              CASE (56)
               call keytoexe(5)
              CASE (57)
               call keytoexe(6)
              CASE (47)
               call keytoexe(7)
              CASE (52)
               call keytoexe(8)
              CASE (53)
               call keytoexe(9)
              CASE (54)
               call keytoexe(10)
              CASE (43)
               call keytoexe(11)
              CASE (49)
               call keytoexe(12)
              CASE (50)
               call keytoexe(13)
              CASE (51)
               call keytoexe(14)
              CASE (45)
               call keytoexe(15)
              CASE (48)
               call keytoexe(16)
              CASE (46)
               call keytoexe(17)
              CASE (105)
               call keytoexe(18)
              CASE (73)
               call keytoexe(18)
              CASE (61)
               call keytoexe(19)
             END SELECT
            ELSE
            row = int((y-1200)/1200)
            col = int((x-200)/2000)
            IF ( ( x .GE. 0 ) .AND. ( y .GE. 0 ) ) THEN
            IF ( ( row .GE. 0 ) .AND. ( row .LT. 5 ) .AND. ( col .GE. 0 ) .AND. ( col .LT. 4 ) ) THEN
                call keytoexe( row*4+col )
            END IF
            END IF
            END IF
            END IF
        END IF
    END DO
end program calc