home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / JBCALC10.ZIP / JBKEY.PRG < prev    next >
Encoding:
Text File  |  1988-01-17  |  9.6 KB  |  234 lines
  1. ********************************************************************************
  2. * JBKEY.PRG
  3. * Author : John A. Bristor
  4. * Program Purpose :  Wait for Keystroke and Take appropriate Action
  5. ********************************************************************************
  6. STORE " " TO JBEXIT,JBFLAG
  7. STORE SPACE(1) TO JBSYMBOL
  8. STORE 999 TO JBT,JBL
  9. STORE " DEC " TO JBTYPE
  10. DO WHILE JBEXIT <> "X"
  11.      SET COLOR TO W*/N
  12.      @ JABTOP+1,JABLEFT+25 SAY "F1"
  13.      SET COLOR TO N/W
  14.      @ JABTOP+2,JABLEFT+12 SAY JBTYPE
  15.      SET COLOR TO W/N
  16.      IF JBANGLE = "DEG"
  17.           @  JABTOP+1,JABLEFT+2 SAY "DEG"
  18.           SET COLOR TO N/W
  19.           @  JABTOP+1,JABLEFT+5 SAY "/Rad"
  20.           SET COLOR TO W/N
  21.      ELSE
  22.           SET COLOR TO N/W
  23.           @  JABTOP+1,JABLEFT+2 SAY "Deg/"
  24.           SET COLOR TO W/N
  25.           @  JABTOP+1,JABLEFT+6 SAY "RAD"
  26.      ENDIF
  27.      IF JBMEM1 <> " "
  28.           SET COLOR TO N/W
  29.           @ JABTOP+3,JABLEFT+3 SAY "M"
  30.           SET COLOR TO W/N
  31.      ELSE
  32.           @ JABTOP+3,JABLEFT+3 SAY " "
  33.      ENDIF
  34.      INKEY(0)                                           &&  WAIT FOR KEYSTROKE
  35.      SET COLOR TO W/N
  36.      @ JABTOP+3,JABLEFT+2 SAY " "
  37.      IF JBFLAGGER = .F.
  38.           @ JABTOP+3,JABLEFT+27 SAY JBOPER
  39.      ELSE
  40.           STORE .F. TO JBFLAGGER
  41.      ENDIF
  42.      IF JBOPER$'='
  43.           @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  44.      ENDIF
  45.      DO CASE
  46.           CASE LASTKEY() = 37
  47.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,13,"%"
  48.           CASE LASTKEY() = 77 .OR. LASTKEY() = 109
  49.                DO JBREDO WITH JBSYMBOL,JBT,JBL
  50.                @ JABTOP+13,JABLEFT+13 SAY "M"
  51.                STORE JBCURR TO JBMEM1
  52.                STORE "M" TO JBSYMBOL
  53.                STORE 13 TO JBT
  54.                STORE 13 TO JBL
  55.                STORE .T. TO JBFLAGGER
  56.           CASE LASTKEY() = 82 .OR. LASTKEY() = 114
  57.                DO JBREDO WITH JBSYMBOL,JBT,JBL
  58.                @ JABTOP+16,JABLEFT+13 SAY "R"
  59.                STORE JBMEM1 TO JBCURR
  60.                @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  61.                STORE "R" TO JBSYMBOL
  62.                STORE 16 TO JBT
  63.                STORE 13 TO JBL
  64.                STORE .T. TO JBFLAGGER
  65.           CASE LASTKEY() = 42
  66.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,25,"*"
  67.           CASE LASTKEY() = 43
  68.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,25,"+"
  69.           CASE LASTKEY() = 45
  70.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,13,25,"-"
  71.           CASE LASTKEY() = 46
  72.                IF AT('.',JBCURR) = 0
  73.                     DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,19,"."
  74.                ELSE
  75.                     IF JBOPER = " "
  76.                          DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,19,"."
  77.                     ENDIF
  78.                     STORE .T. TO JBFLAGGER
  79.                ENDIF
  80.           CASE LASTKEY() = 47
  81.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,07,25,"/"
  82.           CASE LASTKEY() = 94
  83.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,07,25,"^"
  84.           CASE LASTKEY() = 48
  85.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,16,"0"
  86.           CASE LASTKEY() = 49
  87.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,13,16,"1"
  88.           CASE LASTKEY() = 50
  89.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,13,19,"2"
  90.           CASE LASTKEY() = 51
  91.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,13,22,"3"
  92.           CASE LASTKEY() = 52
  93.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,16,"4"
  94.           CASE LASTKEY() = 53
  95.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,19,"5"
  96.           CASE LASTKEY() = 54
  97.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,22,"6"
  98.           CASE LASTKEY() = 55
  99.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,07,16,"7"
  100.           CASE LASTKEY() = 56
  101.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,07,19,"8"
  102.           CASE LASTKEY() = 57
  103.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,07,22,"9"
  104.           CASE LASTKEY() =  8                           && BACKSPACE
  105.                call ascroll with chr(2),chr(1),chr(15),chr(JABTOP+3),chr(JABLEFT+5),chr(JABTOP+3),chr(JABLEFT+24)
  106.                STORE IF(LEN(JBCURR) > 1,SUBSTR(JBCURR,1,(LEN(JBCURR)-1)),"0") TO JBCURR
  107.                IF JBCURR = "0"
  108.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  109.                ENDIF
  110.                STORE .T. TO JBFLAGGER
  111.           CASE LASTKEY() = 61
  112.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,22,"="
  113.           CASE LASTKEY() = -1
  114.                DO JBREDO WITH JBSYMBOL,JBT,JBL
  115.                @ JABTOP+5,JABLEFT+15 SAY "F2"
  116.                STORE " " TO JBMEM1
  117.                STORE "F2" TO JBSYMBOL
  118.                STORE  5 TO JBT
  119.                STORE 15 TO JBL
  120.                STORE .T. TO JBFLAGGER
  121.           CASE LASTKEY() = -2
  122.                DO JBREDO WITH JBSYMBOL,JBT,JBL
  123.                @ JABTOP+7,JABLEFT+3 SAY "ARC"
  124.                STORE "Arc" TO JBSYMBOL
  125.                STORE  7 TO JBT
  126.                STORE  3 TO JBL
  127.                STORE .T. TO JBFLAGGER
  128.           CASE LASTKEY() = -3
  129.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,07,08,"Log"
  130.           CASE LASTKEY() = -4
  131.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,03,"Sin"
  132.           CASE LASTKEY() = -5
  133.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,10,08,"Exp"
  134.           CASE LASTKEY() = -6
  135.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,13,03,"Cos"
  136.           CASE LASTKEY() = -7
  137.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,13,08," π "
  138.           CASE LASTKEY() = -8
  139.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,03,"Tan"
  140.           CASE LASTKEY() = -9
  141.                DO JBDOIT WITH JBSYMBOL,JBT,JBL,16,08," √x"
  142.           CASE LASTKEY() = 9 .OR. LASTKEY() = 271       && tab key or shift tab
  143.                DO JBREDO WITH JBSYMBOL,JBT,JBL
  144.                @ JABTOP+7,JABLEFT+13 SAY ""
  145.                STORE "0" TO JBCURR,JBCURRA
  146.                @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  147.                STORE "" TO JBSYMBOL
  148.                STORE " " TO JBOPER
  149.                SET COLOR TO W/N
  150.                @ JABTOP+3,JABLEFT+27 SAY JBOPER
  151.                STORE  7 TO JBT
  152.                STORE 13 TO JBL
  153.           CASE LASTKEY() = 78 .OR. LASTKEY() = 110      && N,n '±' N,n NEGATE
  154.                DO CASE
  155.                     CASE VAL(JBCURR) = 0
  156.                     CASE VAL(JBCURR) < 0
  157.                          STORE SUBSTR(JBCURR,2) TO JBCURR
  158.                     CASE VAL(JBCURR) > 0
  159.                          STORE "-"+JBCURR TO JBCURR
  160.                ENDCASE
  161.                @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  162.                STORE .T. TO JBFLAGGER
  163.           CASE LASTKEY() = 88 .OR. LASTKEY() = 120      && X,x '1/x' INVERSE
  164.                IF VAL(JBCURR)=0
  165.                     SET COLOR TO N*/W
  166.                     @ JABTOP+3,JABLEFT+2 SAY "E"
  167.                     SET COLOR TO W/N
  168.                     STORE "0" TO JBCURR,JBCURRA
  169.                ELSE
  170.                     STORE JBCURR TO JBCURRA
  171.                     STORE 1/VAL(JBCURR) TO JBCURR
  172.                     DO JBRIP0 WITH JBCURR
  173.                ENDIF
  174.                @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  175.                STORE .T. TO JBFLAGGER
  176.           CASE LASTKEY() = 19                           &&  LEFT ARROW
  177.                IF JBANGLE <> "DEG"
  178.                     STORE (VAL(JBCURR) * 57.2958) TO JBCURR
  179.                     DO JBRIP0 WITH JBCURR
  180.                     STORE "DEG" TO JBANGLE
  181.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  182.                ENDIF
  183.                STORE .T. TO JBFLAGGER
  184.           CASE LASTKEY() = 4                            &&  RIGHT ARROW
  185.                IF JBANGLE <> "RAD"
  186.                     STORE (VAL(JBCURR) * 0.017453) TO JBCURR
  187.                     DO JBRIP0 WITH JBCURR
  188.                     STORE "RAD" TO JBANGLE
  189.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  190.                ENDIF
  191.                STORE .T. TO JBFLAGGER
  192.           CASE LASTKEY() = 5
  193.                DO CASE
  194.                     CASE JBTYPE = " DEC "
  195.                          STORE " HEX " TO JBTYPE
  196.                     CASE JBTYPE = " HEX "
  197.                          STORE " OCT " TO JBTYPE
  198.                     CASE JBTYPE = " OCT "
  199.                          STORE " BIN " TO JBTYPE
  200.                     CASE JBTYPE = " BIN "
  201.                          STORE " DEC " TO JBTYPE
  202.                     OTHERWISE
  203.                          STORE " DEC " TO JBTYPE
  204.                ENDCASE
  205.                STORE .T. TO JBFLAGGER
  206.           CASE LASTKEY() = 24                           &&  DOWN ARROW
  207.                DO CASE
  208.                     CASE JBTYPE = " DEC "
  209.                          STORE " BIN " TO JBTYPE
  210.                     CASE JBTYPE = " BIN "
  211.                          STORE " OCT " TO JBTYPE
  212.                     CASE JBTYPE = " OCT "
  213.                          STORE " HEX " TO JBTYPE
  214.                     CASE JBTYPE = " HEX "
  215.                          STORE " DEC " TO JBTYPE
  216.                     OTHERWISE
  217.                          STORE " DEC " TO JBTYPE
  218.                ENDCASE
  219.                STORE .T. TO JBFLAGGER
  220.           CASE LASTKEY() = 28   &&                      &&  ? HELP 63
  221.                DO JBHELP
  222.                STORE .T. TO JBFLAGGER
  223.           CASE LASTKEY() = 13                           &&  CARRIAGE RETURN
  224.                STORE "X" TO JBEXIT                      &&  Return New Date
  225.                STORE VAL(JBCURR) TO JABRESULT
  226.           CASE LASTKEY() = 27                           &&  ESCAPE KEY
  227.                STORE "X" TO JBEXIT                      &&  Returns Original
  228.           OTHERWISE
  229.                STORE .T. TO JBFLAGGER
  230.      ENDCASE
  231.      SET COLOR TO N/W
  232. ENDDO
  233. RETURN
  234.