###############################################################################
## Company      : 4J's Development Tools
## Program      : keycode.4gl
##
## Version      : 1.01
##
## Title        : list the keys definitions and create a termcap file
##
###############################################################################

DEFINE keys RECORD
              nb SMALLINT,
              val ARRAY[100] OF SMALLINT,
              lib ARRAY[100] OF CHAR(20)
            END RECORD
DEFINE open_report SMALLINT
DEFINE lastfn,
       nbvar       SMALLINT
DEFINE laststr     CHAR(80)

MAIN
 DEFINE end SMALLINT

 DEFER INTERRUPT
 CALL init()

 LET end = FALSE
 LET open_report = FALSE

 WHILE NOT end
   CLEAR SCREEN
   MENU "Test Key"
     COMMAND "Key"
        "Test of keys pressed"
        CALL hitkey()
        EXIT MENU
     COMMAND "Termcap"
        "Make the variable definition for a termcap file"
        CALL choice_termcap()
        EXIT MENU
     COMMAND "Exit"
        "Exit menu"
        LET end = TRUE
        EXIT MENU
     END MENU
  END WHILE

  IF open_report  THEN
    FINISH REPORT tcapkey
    DISPLAY "result in keys.tcap"
  END IF

END MAIN

FUNCTION choice_termcap()

  LET lastfn = 0
  LET laststr = ""
  LET nbvar = 0

  MENU "Termcap"
    COMMAND "All Keys"
      "Make all keys definitions of the termcap used by INFORMIX"
       CALL termcapfctkey()
      EXIT MENU
    COMMAND "Named variable"
      "Make given keys definitions of the termcap"
      CALL termcapvarkey()
      EXIT MENU
     COMMAND "Exit"
       "Exit menu"
       EXIT MENU
  END MENU

END FUNCTION

FUNCTION termcap_seq(val,with_keyval)

  DEFINE val         SMALLINT,
         asc         CHAR(20)
  DEFINE with_keyval SMALLINT

  DEFINE i SMALLINT


 CASE 
   WHEN val < 0
     IF with_keyval THEN
       LET asc = NULL
     ELSE
       LET asc = "<ERROR>"
     END IF
   WHEN val = 9
     IF with_keyval THEN
       LET asc = "\\t,<Tab>"
     ELSE
       LET asc = "\\t"
     END IF
   WHEN val = 13
     IF with_keyval THEN
       LET asc = "^M,<Return>"
     ELSE
       LET asc = "^M"
     END IF
   WHEN val = 27
     IF with_keyval THEN
       LET asc = "\\E,<Escape>"
     ELSE
       LET asc = "\\E"
     END IF
   WHEN val > 255 
     IF with_keyval THEN
       FOR i = 1 TO keys.nb
         IF val =  keys.val[i] THEN
           LET asc = "<",keys.lib[i] CLIPPED,">"
           EXIT FOR
         END IF
       END FOR
     ELSE
       LET asc = "<exist>"
     END IF
   WHEN val <= 26
     LET asc = "^"
     LET asc[2,2] = ASCII (64 + val)
   WHEN ( val > 27 AND val <=31 ) OR val >=127
     LET i = obase(val,8)
     LET asc = "\\",i using "&&&"
   OTHERWISE
     LET asc = ASCII val
 END CASE

 RETURN asc

END FUNCTION


FUNCTION obase(val,base)

  DEFINE val  INTEGER,
         base SMALLINT,
         tmp,
         bval INTEGER,
         bexp INTEGER

  LET bexp = 1
  LET bval = 0

  WHILE val != 0
    LET tmp = val / base
    LET bval= bval + (val - tmp*base) * bexp
    LET bexp = bexp * 10
    LET val = tmp
  END WHILE

  RETURN bval

END FUNCTION

FUNCTION init()

  DEFINE i SMALLINT
 
  LET keys.lib[1] = "up"
  LET keys.lib[2] = "down"
  LET keys.lib[3] = "left"
  LET keys.lib[4] = "right"
  LET keys.lib[5] = "nextpage"
  LET keys.lib[6] = "prevpage"
  LET keys.lib[7] = "help"
  LET keys.lib[8] = "interrupt"
  LET keys.lib[9] = "insert"
  LET keys.lib[10] = "delete"
  LET keys.lib[11] = "accept"
  LET keys.lib[12] = "f1"
  LET keys.lib[13] = "f2"
  LET keys.lib[14] = "f3"
  LET keys.lib[15] = "f4"
  LET keys.lib[16] = "f5"
  LET keys.lib[17] = "f6"
  LET keys.lib[18] = "f7"
  LET keys.lib[19] = "f8"
  LET keys.lib[20] = "f9"
  LET keys.lib[21] = "f10"
  LET keys.lib[22] = "f11"
  LET keys.lib[23] = "f12"
  LET keys.lib[24] = "f13"
  LET keys.lib[25] = "f14"
  LET keys.lib[26] = "f15"
  LET keys.lib[27] = "f16"
  LET keys.lib[28] = "f17"
  LET keys.lib[29] = "f18"
  LET keys.lib[30] = "f19"
  LET keys.lib[31] = "f20"
  LET keys.lib[32] = "f21"
  LET keys.lib[33] = "f22"
  LET keys.lib[34] = "f23"
  LET keys.lib[35] = "f24"
  LET keys.lib[36] = "f25"
  LET keys.lib[37] = "f26"
  LET keys.lib[38] = "f27"
  LET keys.lib[39] = "f28"
  LET keys.lib[40] = "f29"
  LET keys.lib[41] = "f30"
  LET keys.lib[42] = "f31"
  LET keys.lib[43] = "f32"
  LET keys.lib[44] = "f33"
  LET keys.lib[45] = "f34"
  LET keys.lib[46] = "f35"
  LET keys.lib[47] = "f36"

  FOR i = 1 TO 47
    LET keys.val[i] = fgl_keyval(keys.lib[i])
  END FOR

  LET keys.lib[48] = "nextOption"
  LET keys.val[48] = 4000
  LET keys.lib[49] = "nextField"
  LET keys.val[49] = 4001
  LET keys.lib[50] = "menuEnter"
  LET keys.val[50] = 4002
  LET keys.lib[51] = "delchar"
  LET keys.val[51] = 4003
  LET keys.lib[52] = "arrayGoto"
  LET keys.val[52] = 4004
  LET keys.lib[53] = "remoteSource"
  LET keys.val[53] = 4005
  LET keys.lib[54] = "fglOK"
  LET keys.val[54] = 4006
  LET keys.lib[55] = "buffer"
  LET keys.val[55] = 4007
  LET keys.lib[56] = "backspace"
  LET keys.val[56] = 2017
  LET keys.lib[57] = "autonext"
  LET keys.val[57] = 2018
  LET keys.lib[58] = "taskFocusIn"
  LET keys.val[58] = 2019
  LET keys.lib[59] = "abort"
  LET keys.val[59] = 2004
 
  LET keys.nb = 59
   
END FUNCTION

FUNCTION hitkey()

  DEFINE x,
         val      SMALLINT,
         asc      CHAR(20),
         firsttab SMALLINT
 
  CLEAR SCREEN
  DISPLAY "Give value of keys pressed. <tab><tab> to exit" AT 1,1
  LET x = 1
  LET firsttab = 0
 
  WHILE firsttab != 2
    LET val = fgl_getkey()
    LET x = x + 1
    IF x = 25 THEN
      FOR x = 2 TO 24
        DISPLAY "" AT x,1
      END FOR
      LET x = 2
    END IF
    LET asc = termcap_seq(val,1)
    DISPLAY "key=(",val using "###&",",",asc CLIPPED,")" AT x,1
    IF val = 9 THEN
      LET firsttab = firsttab + 1
    ELSE
      LET firsttab = 0
    END IF
  END WHILE
 
  CLEAR SCREEN

END FUNCTION

FUNCTION termcapvar(tname,code,len)

 DEFINE x,val  SMALLINT ,
        len    SMALLINT,
        tname  CHAR(20),
        code   ARRAY[20] OF SMALLINT,
        res    CHAR(20)
 
  LET res = tname CLIPPED,"="
 
  FOR x = 1 TO len
    LET res = res CLIPPED, termcap_seq(code[x],0)
  END FOR
 
  LET res = res CLIPPED, ":"
 
  RETURN res
 
END FUNCTION

FUNCTION termcapfctkey()

  DEFINE x,i,val SMALLINT ,
         len     SMALLINT,
         tname   CHAR(20),
         str     CHAR(20),
         ftab    SMALLINT,
         fequal  SMALLINT,
         fquit   SMALLINT,
         fn      SMALLINT,
         end     SMALLINT,
         new     SMALLINT,
         code    ARRAY[20] OF SMALLINT,
         commvar ARRAY[70] OF RECORD
                  tname CHAR(10),
                  name  CHAR(10)
         END RECORD,
         nbtcap  SMALLINT
  
  LET commvar[1].tname="kl"
  LET commvar[1].name ="Left"
  LET commvar[2].tname="kr"
  LET commvar[2].name ="Right"
  LET commvar[3].tname="ku"
  LET commvar[3].name ="Up"
  LET commvar[4].tname="kd"
  LET commvar[4].name ="Down"
  LET commvar[5].tname="kf"
  LET commvar[5].name ="NextPg"
  LET commvar[6].tname="kg"
  LET commvar[6].name ="PrevPg"
  LET commvar[7].tname="ki"
  LET commvar[7].name ="Insert"
  LET commvar[8].tname="kj"
  LET commvar[8].name ="Delete"
  
  FOR i = 9 TO 44
    IF i <= 18 THEN
      LET x = i - 9
      LET commvar[i].tname="k",x using "&"
    ELSE
      LET str = ascii(65+i-19)
      LET commvar[i].tname="k",str CLIPPED
    END IF
    LET x = i - 8
    LET commvar[i].name ="F",x USING "<&"
  END FOR
  
  LET nbtcap = 44
  
  CLEAR SCREEN
  
  DISPLAY "Give values for termcap file. Result on screen + report keys.tcap" AT 1,1
  DISPLAY "Press the key   Fxx     : <Tab><Tab> Valide, <==> try again, <qq> Exit" AT 2,1
  
  LET x   = 2
  LET open_report = TRUE
  START REPORT tcapkey TO "keys.tcap"
  LET fn  = 1
  LET new = TRUE
 
  WHILE NOT end
    IF new THEN
      DISPLAY commvar[fn].name[1,6]  AT 2,17 ATTRIBUTE(REVERSE)
      LET ftab   = FALSE
      LET fequal = FALSE
      LET fquit  = FALSE
      LET new    = FALSE
      LET len    = 0
    END IF
    LET val = fgl_getkey()

    CASE val
      WHEN 9 # tab 
        IF ftab THEN
          LET len = len -1
          LET str = termcapvar(commvar[fn].tname,code,len)
          LET fn = fn + 1
          IF fn = nbtcap + 1 THEN
            LET end = TRUE
          ELSE
            LET new = TRUE
          END IF
          LET x = x + 1
          IF x = 25 THEN
            FOR x = 3 TO 24
              DISPLAY "" AT x,1
            END FOR
            LET x = 3
          END IF
          DISPLAY str CLIPPED AT x,1
          OUTPUT TO REPORT tcapkey(fn,str)
        ELSE
          LET ftab   =1 
          LET fequal =0
          LET fquit  =0
        END IF
      WHEN 61 # "=" key
        IF fequal THEN
          LET fn = fn - 1
          LET new = TRUE
        ELSE
          LET ftab   =0 
          LET fequal =1 
          LET fquit  =0
        END IF
      WHEN 113 # "q" key
        IF fquit THEN
          LET end = TRUE
        ELSE
          LET ftab   =0 
          LET fequal =0 
          LET fquit  =1
        END IF
    END CASE
    LET len = len + 1
    LET code[len]=val
  END WHILE
 
END FUNCTION

FUNCTION termcapvarkey()

  DEFINE x,i,val SMALLINT ,
         len     SMALLINT,
         tname   CHAR(20),
         str     CHAR(20),
         ftab    SMALLINT,
         fquit   SMALLINT,
         end     SMALLINT,
         new     SMALLINT,
         code    ARRAY[20] OF SMALLINT
 
  CLEAR SCREEN
 
  DISPLAY "Give values for termcap file. Result on screen + report keys.tcap" AT 1,1
 
  LET x   = 2
  LET open_report = TRUE
 
  START REPORT tcapkey TO "keys.tcap"
 
  LET new = TRUE
 
  OPTIONS PROMPT LINE 2
 
  WHILE NOT end
    IF new THEN
      PROMPT "Give the name of termcap variables (<RETURN> for end): " FOR tname
      IF tname IS NULL THEN
        EXIT WHILE
      END IF
      DISPLAY "Press the key        :<Tab><Tab> Valide, <qq> Exit" AT 2,1
      DISPLAY tname CLIPPED AT 2,17 ATTRIBUTE(REVERSE)
      LET ftab   = FALSE
      LET fquit  = FALSE
      LET new    = FALSE
      LET len    = 0
    END IF
    LET val = fgl_getkey()
    CASE val
      WHEN 9 # tab 
        IF ftab THEN
          LET len = len -1
          LET str = termcapvar(tname,code,len)
          LET new = TRUE
          LET x = x + 1
 
          IF x = 25 THEN
            FOR x = 3 TO 24
              DISPLAY "" AT x,1
            END FOR
            LET x = 3
          END IF
          DISPLAY str CLIPPED AT x,1
          OUTPUT TO REPORT tcapkey(0,str)
        ELSE
          LET ftab   =1 
          LET fquit  =0
        END IF
      WHEN 113 # "q" key
        IF fquit THEN
          LET end = TRUE
        ELSE
          LET ftab   =0 
          LET fquit  =1
        END IF
    END CASE
    LET len = len + 1
    LET code[len]=val
  END WHILE
 
END FUNCTION

REPORT tcapkey(fn,c)

  DEFINE c  CHAR(80),
         fn SMALLINT

  OUTPUT
    TOP MARGIN 0
    BOTTOM MARGIN 0
    LEFT MARGIN 0
    PAGE LENGTH 1


  FORMAT
    ON EVERY ROW
      IF NOT fn OR lastfn != fn THEN
        IF laststr IS NOT NULL THEN
          IF nbvar AND  nbvar MOD 5 = 0 THEN
            PRINT "\\"
          END IF
          IF nbvar MOD 5 = 0 THEN
            PRINT "\t:";
          END IF
          LET nbvar = nbvar + 1
          LET lastfn = fn
          PRINT laststr CLIPPED;
        END IF
      END IF
      LET laststr = c
  
    ON LAST ROW
      PRINT laststr CLIPPED

END REPORT