%%HP: T(3)A(D)F(.);
@
@ UCalc Big Digit RPN Calculator
@ By Stan Lui 6/29/08
@ do not use @@ at beginning of line
\<< 

@ main variables:
@  xn  -   number
@  xnl -   list of numbers entered
@  xd  -   number of digits entered
@  stk -   stack
@ global variable created:
@  calclst - list which stores the application's main data
@            { {stk} coloroption memnum fontoption }

@ digit grobs 0-9
 { GROB 9 22 FF10FF10FF103810381038103C103C103E103A103B103910B910B810F8107810781038103810FF10FF10FF10
   GROB 9 22 8300C300C300C300030003000300030003000300030003000300030003000300030003000300030003000300
   GROB 9 22 FF10FF10FF103810381008100810081008100810FF10FF10FF10300030003000300030003000FF10FF10FF10
   GROB 9 22 FF10FF10FF103810381008100810081008100810EF10EF10EF10081008100810081038103810FF10FF10FF10
   GROB 9 22 3600360036003600360036003600360036003600FF10FF10FF10060006000600060006000600060006000600
   GROB 9 22 FF10FF10FF103000300030003000300030003000FF10FF10FF10081008100810081038103810FF10FF10FF10
   GROB 9 22 FF10FF10FF103810381030003000300030003000FF10FF10FF10381038103810381038103810FF10FF10FF10
   GROB 9 22 FF10FF10FF103810381008100810081008100810081008100810081008100810081008100810081008100810
   GROB 9 22 FF10FF10FF103810381038103810381038103810FF10FF10FF10381038103810381038103810FF10FF10FF10
   GROB 9 22 FF10FF10FF103810381038103810381038103810FF10FF10FF10081008100810081038103810FF10FF10FF10
 }

 { GROB 9 22 EF00D710BB107C107C107C107C107C10381010100000101038107C107C107C107C107C103C10DB10E710FF00
   GROB 9 22 0400060007000700070007000700070007000600040000000600070007000700070007000700070006000400
   GROB 9 22 FF00E710CB100C100C100C100C100C100810C710EF00D7003000700070007000700070007000B700DF00EF10
   GROB 9 22 FF00E710CB100C100C100C100C100C100810C710EF00C71008100C100C100C100C100C100C10CB10E710FF00
   GROB 9 22 101038107C107C107C107C107C103C101810E710FF00E71008100C100C100C100C100C100C100C1008100010
   GROB 9 22 EF10DF00B700700070007000700070003000D700EF00C71008100C100C100C100C100C100C10CB10E710FF00
   GROB 9 22 EF10DF00B700700070007000700070003000D700EF00D71038107C107C107C107C107C103C10DB10E710FF00
   GROB 9 22 F710EB10CD100C100C100C100C100C100C1008100010000008100C100C100C100C100C100C100C1008100010
   GROB 9 22 EF00D710BB107C107C107C107C107C103810D710EF00D71038107C107C107C107C107C103C10DB10E710FF00
   GROB 9 22 EF00D710BB107C107C107C107C107C103810D710EF00C71008100C100C100C100C100C100C10CB10E710FF00
 } 
 
 GROB 2 4 30302010 GROB 2 2 3030 GROB 3 12 707070000000000000707070 GROB 5 2 F1F1
 0 0 {} 0 0 0 RCLF 0 {} 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 \-> 
 digits digits1 comma period colon minus processkey 
 xn xnl xd xp xgp fs k stk uu dspstk dspitem dspstkn clrstk 
 domath changesign dspsign doswap coloroption fontoption storemem dspmem dspleveln rclmem \<< 

  \<< \-> u \<<
     IF u u SIZE DUP SUB "." == THEN u 1 u SIZE 1 - SUB ELSE u END
  \>> \>> 'uu' STO

@ dspitem : display stack item in either level 1 or level 2
@ input: itmstr - number to display in string
@        li - either 1 or 2 (level number)
@    

  \<< 0 0 0 0 0 0 \-> itmstr li j y  xn1 xd1 xp1 xgp1 \<<

     itmstr uu EVAL 'itmstr' STO  
     # 39d IF li 2 == THEN DROP # 13d END 'y' STO

@    save globals
     xn 'xn1' STO xd 'xd1' STO xp 'xp1' STO xgp 'xgp1' STO

     0 'xn' STO 0 'xd' STO 0 'xp' STO 0 'xgp' STO 3 CF

     1 itmstr SIZE FOR i
       itmstr i i SUB NUM 'j' STO
       IF j 46 == THEN
@        period
         10 y
       ELSE
         j 48 - y 
       END
       0 processkey EVAL 
     NEXT

     li itmstr dspsign EVAL

@    restore globals
     xn1 'xn' STO xd1 'xd' STO xp1 'xp' STO xgp1 'xgp' STO  3 CF

  \>>  \>>  'dspitem' STO

@ dspstk : display the stack in the 2-line display area
@ input:  li - either 1 or 2, display the stack starting at level 1 or level 2.
@         if li = 1, and stk only contain 1 item, level 2 will be blanked
@         if l2 = 2, level 1 will be blanked
@         if stk is {}, level 1 and level 2 will be blanked

  \<< 0 \-> li g \<<
    PICT {# 18d,# 39d} {# 130d,# 62d} SUB 'g' STO
    PICT {# 18d,# 13d} # 113d # 50d BLANK REPL
    IF stk {} \=/ THEN
       IF li 1 == THEN
          stk 1 GET \->STR 1 dspitem EVAL
          IF stk SIZE 1 > THEN
             stk 2 GET \->STR 2 dspitem EVAL
@          ELSE
@             PICT {# 18d,# 13d} # 113d # 24d BLANK REPL
          END
       ELSE
@          PICT {# 13d,# 39d} # 118d # 24d BLANK REPL
@          stk 1 GET \->STR 2 dspitem EVAL
           PICT {# 18d,# 13d} g REPL
       END
    END
  \>>  \>> 'dspstk' STO

@ dspstkn : display number of items in stack
@ input:  none

  \<<
    PICT {# 103d,# 2d} # 17d # 9d BLANK REPL
    IF stk SIZE 10 < THEN
       PICT {# 115d,# 2d} 
    ELSE
       IF stk SIZE 100 < THEN
          PICT {# 109d,# 2d}
       ELSE
          PICT {# 103d,# 2d}
       END
    END stk SIZE \->STR uu EVAL 3 \->GROB REPL
  \>>  'dspstkn' STO

@ processkey :  process the user key input for a number
@ input:  k -  input key value
@         #ty - top y coordinate (in binary value) of display
@         uf - user call flag: 1: called by user entering key, 0: not called by user entering key
@         expected value: 1 - 9, 0, 10 for ".", 11 for "<---", 12 for "ENTER", 13 for "+/-"
@         maximum # of digits in number = 8
@ output:
  \<< 0 0 0 0 \-> k ty uf    g tl np by \<< 

     ty #20d + 'by' STO

     IF k 0  \>=  k 10 < AND THEN
       IF xd 0 == uf AND THEN
          2 dspstk EVAL
       END
       IF xd 8 < THEN
@        need to shift the already entered digits to the left 1 digit
         IF xd 0 \=/ THEN
           IF 3 FC? THEN
@            remove any old comma(s)
             xd xgp -  'np' STO
             IF np 4 \>= THEN
                PICT 128 xgp 4 + 9 * - xgp 3 + 4 * - 10 + R\->B by 2 \->LIST GROB 2 4 00000000 REPL
                PICT 128 xgp 7 + 9 * - xgp 6 + 4 * - 10 + R\->B by 2 \->LIST GROB 2 4 00000000 REPL
             END
           END
           PICT 128 xd 9 * - xd 1 - 4 * - R\->B ty 2 \->LIST # 127d by # 3d + 2 \->LIST SUB 'g' STO
           PICT 128 xd 1 + 9 * - xd 4 * - R\->B ty 2 \->LIST g REPL
         END
@        display the latest right digit
         
         IF 4 FC? THEN
@ZRANDOMCOLOR 
           PICT # 119d ty 2 \->LIST IF 5 FC? THEN digits ELSE digits1 END k 1 + GET REPL
         ELSE
           PICT # 119d ty 2 \->LIST IF 5 FC? THEN digits ELSE digits1 END k 1 + GET REPL
         END

         xd 1 + 'xd' STO xnl xn + 'xnl' STO
         IF 3 FC? THEN
           xn 10 * k + 'xn' STO
         ELSE
           xn k xd xp - ALOG / + 'xn' STO 
@          update the period display if necessary
           PICT 128 xgp 9 * - xgp 1 - 4 * - 10 + R\->B by 2 \->LIST GROB 2 2 0000 REPL
           xgp 1 + 'xgp' STO
           PICT 128 xgp 9 * - xgp 1 - 4 * - 10 + R\->B by 2 \->LIST period REPL
         END
@        display , separator if necessary
         IF 3 FC? THEN
           xd xgp -  'np' STO
           IF np 4 \>= THEN
              PICT 128 xgp 4 + 9 * - xgp 3 + 4 * - 10 + R\->B by 2 \->LIST comma REPL
              IF np 7 \>= THEN
                PICT 128 xgp 7 + 9 * - xgp 6 + 4 * - 10 + R\->B by 2 \->LIST comma REPL
              END
           END
         END
       END
     ELSE
       IF k 11 == THEN
@        delete last key entered
         IF xd 0 > THEN
            IF 3 FC? THEN
@             remove , separator is neccessary
              xd xgp -  'np' STO
              IF np 4 \>= THEN
                 PICT 128 xgp 4 + 9 * - xgp 3 + 4 * - 10 + R\->B by 2 \->LIST GROB 2 4 00000000 REPL
                 PICT 128 xgp 7 + 9 * - xgp 6 + 4 * - 10 + R\->B by 2 \->LIST GROB 2 4 00000000 REPL
              END
            END
@           shift one digit to the right
            PICT 128 xd 9 * - xd 1 - 4 * - R\->B ty 2  \->LIST 'tl' STO tl # 114d by # 3d + 2 \->LIST SUB 'g' STO
            PICT tl  # 13d # 24d BLANK REPL
            xd 1 - 'xd' STO
            IF xd 0 \=/ THEN
              PICT 128 xd 9 * - xd 1 - 4 * - R\->B ty 2  \->LIST g REPL
            END
            IF xnl {} \=/ THEN
              xnl xnl SIZE GET 'xn' STO xnl 1 xnl SIZE 1 - SUB 'xnl' STO
            END
            IF 3 FS? THEN
              xgp 1 - 'xgp' STO
            ELSE
@             display , separator if necessary
              xd xgp -  'np' STO
              IF np 4 \>= THEN
                 PICT 128 xgp 4 + 9 * - xgp 3 + 4 * - 10 + R\->B by 2 \->LIST comma REPL
                 IF np 7 \>= THEN
                    PICT 128 xgp 7 + 9 * - xgp 6 + 4 * - 10 + R\->B by 2 \->LIST comma REPL
                 END
              END
            END
            IF xn FP 0 == THEN
               3 CF xd 'xp' STO 0 'xgp' STO
            END
            IF xd 0 == THEN
               0 'xn' STO 0 'xd' STO 0 'xp' STO 0 'xgp' STO
               1 dspstk EVAL
            END
         ELSE
            IF xd 0 == uf AND stk SIZE 0 > AND THEN
@              delete level 1 item
               stk 2 stk SIZE SUB 'stk' STO
               1 dspstk EVAL dspstkn EVAL
            END
         END
@         IF xn 0 == THEN
@            PICT # 119d ty 2 \->LIST # 9d # 22d BLANK REPL
@         END
       ELSE
         IF k 12 == THEN
@          ENTER key entered
           3 CF 0 'xp' STO

           IF xd 0 == uf AND stk SIZE 0 > AND THEN
@             no digit entered before enter key is entered (DUP)
              stk 1 GET  1 \->LIST stk + 'stk' STO
              1 dspstk EVAL
           ELSE
             IF xn 0 == THEN
               PICT # 119d ty 2 \->LIST IF 5 FC? THEN digits ELSE digits1 END 1 GET REPL
             END
@            save to level 1 of stack
             xn 1 \->LIST stk + 'stk' STO
           END

@          display # of items in stack
           dspstkn EVAL

           0 'xd' STO 0 'xgp' STO 0 'xn' STO  {} 'xnl' STO
         ELSE
            IF k 10 == THEN
@             . entered
              IF 3 FC? THEN
                 IF xd 0 == uf AND stk SIZE 0 > AND THEN
                      2 dspstk EVAL
                 END
                 3 SF PICT # 129d by 2 \->LIST period REPL xd 'xp' STO 1 'xgp' STO
                 IF xp 0 == THEN
                   PICT # 119d ty 2 \->LIST IF 5 FC? THEN digits ELSE digits1 END 1 GET REPL
                   xd 1 + 'xd' STO xd 'xp' STO
                 END
              END
            ELSE
            END  
         END
       END
     END 
  \>>  \>> 'processkey' STO
  
@ changesign:  process +/- function for the level 1 number
@ input:   none
@
  \<< "" 0 \-> s isz \<<
@   +/- key pressed
    IF xd 0 == stk SIZE AND THEN
      stk 1 GET  \->STR uu EVAL 's' STO
      s SIZE IF s "." POS THEN 1 - END 'isz' STO
      IF s "-" POS THEN
        PICT 128 isz 1 - 9 * - isz 2 - 4 * - 6 - R\->B 
        # 49d 2 \->LIST GROB 5 2 0000 REPL        
      ELSE
        PICT 128 isz 9 * - isz 1 - 4 * - 6 - R\->B 
        # 49d 2 \->LIST minus REPL
      END
@     change sign of number
      stk 1 stk 1 GET NEG PUT
      'stk' STO 
    END
  \>>  \>> 'changesign' STO

@ dspsign: display minus sign of a number in level 1 or level 2 if it is negative 
@ input:   li:  1 - level 1 number   2 - level 2 number
@          s:   number to display in string
  \<< 0 \-> li s  isz \<<
      s uu EVAL 's' STO
      s SIZE IF s "." POS THEN 1 - END 'isz' STO
      IF s "-" POS THEN
        PICT 128 isz 1 - 9 * - isz 2 - 4 * - 6 - R\->B 
        IF li 1 == THEN # 49d ELSE # 23d END 2 \->LIST minus REPL        
      END
  \>> \>> 'dspsign' STO


@ clrstk:  clear stack
@ input: none
  \<<
    {} 'stk' STO 1 dspstk EVAL dspstkn EVAL
  \>> 'clrstk' STO

@ doswap: swap the level 1 number with the level 2 number
@ input: none
  \<< 0 \-> itm \<<
    IF xd 0 \=/ THEN
       12 # 39d 0 processkey EVAL
    END 
    IF stk SIZE 2 \>= THEN
       stk 1 GET 'itm' STO
       stk 1 stk 2 GET PUT 2 itm PUT 'stk' STO
       1 dspstk EVAL
    END 
  \>> \>> 'doswap' STO

@ coloroption:  set option to display more/less colors
@ input: none
  \<< PICT {# 34d,# 26d} {# 96d,# 36d} SUB {# 34d,# 26d}  \-> g p \<<
    IF xd 0 == THEN
      IF 4 FC? THEN
        4 SF
        PICT p GROB 63 11 FFFFFFFFFFFFFFF7FFFFFFFFFFFFFFF7BF06C1FF17CE7C07BFEBBEEFEABEBBE6BFEBFEFFEBBEBBE6BF07C1FFEBBEBB07BFEFBFEFEBBEBBA7BFEBBEEFEABEBB673806C1FF17C06CE6FFFFFFFFFFFFFFF7FFFFFFFFFFFFFFF7
        REPL
      ELSE
        4 CF
        IF 1 THEN
@ZRANDOMCOLOR 
          PICT p GROB 63 11 FFFFFFFFFFFFFFF7FFFFFFFFFFFFFFF7BB13C0EF17CE7C0739EABEFFEABEBBE6BAEABEFFEBBEBBE6BAE2C0FFEBBEBB07BBEAEEFFEBBEBBA7BBEADEFFEABEBB67BB1BB0EF17C06CE6FFFFFFFFFFFFFFF7FFFFFFFFFFFFFFF7
          REPL 
        END
      END
      1 WAIT PICT p g REPL
      IF 6 FS? THEN
        1 dspstk EVAL
      END
    END
  \>> \>> 'coloroption' STO

@ fontoption: set the digits font option
@ input: none

  \<< PICT {# 46d,# 25d} {# 83d,# 37d} SUB {# 46d,# 25d}  \-> g p \<<
    IF xd 0 == THEN
      IF 5 FC? THEN
        5 SF
        PICT p GROB 38 13 FFFFFFFFF3FFFFFFFFF3381BB0EF83BFE2BBF773BFE2BBF773BFEAABFFB33CEAABFFD3BFEA9BFFE3BFEA9BF7F3BFEABBF7F3BF1BBBF703FFFFFFFFF3FFFFFFFFF3
        REPL
      ELSE
        5 CF
        IF 1 THEN
          PICT p GROB 38 13 FFFFFFFFF3FFFFFFFFF3381BB0EFB3BFE2BBFF93BFE2BBFFB3BFEAABFFB33CEAABFFB3BFEA9BFFB3BFEA9BFFB3BFEABBFFB3BF1BBBFF13FFFFFFFFF3FFFFFFFFF3
          REPL 
        END
      END
      1 WAIT PICT p g REPL
      IF 6 FS? THEN
        dspleveln EVAL
        1 dspstk EVAL
      END
    END
  \>> \>> 'fontoption' STO


@ dspmem: display memory content on top
@ input: none
  \<<
    PICT {# 52d,# 4d} # 40d # 5d BLANK REPL
    PICT IF calclst 3 GET 0 < THEN {# 52d,# 4d} ELSE {# 56d,# 4d} END
    calclst 3 GET \->STR 1 \->GROB REPL
  \>> 'dspmem' STO

@ storemem: store level 1 number to memory
@ input: none
  \<<
    IF stk {} \=/ THEN
       calclst 3 stk 1 GET PUT 'calclst' STO
       dspmem EVAL
    END
  \>> 'storemem' STO

@ rclmem: recall memory to level 1
@ input: none
  \<<
    calclst 3 GET 1 \->LIST stk + 'stk' STO
    1 dspstk EVAL dspstkn EVAL
  \>> 'rclmem' STO

@ dspleveln: display the level # labels
@ input: none
  \<<
       IF 1 THEN
         PICT {# 3d,# 13d} IF 5 FC? THEN digits ELSE digits1 END 3 GET REPL
         PICT {# 14d,# 18d} colon REPL
       END
       IF 1 THEN
         PICT {# 2d,# 39d} IF 5 FC? THEN digits ELSE digits1 END 2 GET REPL
         PICT {# 14d,# 44d} colon REPL
       END
  \>> 'dspleveln' STO

@ domath: perform basic math
@ input: 1 - add  2 - substract  3 - multiply  4 - divide
  \<< 0 0 "" \-> mi n p s \<<
    IF xd 0 \=/ THEN
       12 # 39d 0 processkey EVAL
    END 
    IF stk SIZE 2 \>= THEN
      CASE
       mi 1 ==  THEN stk 2 GET stk 1 GET + END
       mi 2 ==  THEN stk 2 GET stk 1 GET - END
       mi 3 ==  THEN stk 2 GET stk 1 GET * END
       mi 4 ==  THEN stk 2 GET stk 1 GET / END
      END 'n' STO
      IF n 99999999 > THEN
         99999999 
      ELSE
        IF n -99999999 < THEN
           -99999999
        ELSE
@         find the limit for the number
          n \->STR uu EVAL 's' STO
          s "." POS 'p' STO
          IF p 0 > THEN
             n 8 p - 1 + IF s "-" POS THEN 1 + END RND
          ELSE
             n 
          END
        END
      END
      1 \->LIST stk 3 stk SIZE SUB + 'stk' STO
      1 dspstk EVAL dspstkn EVAL 
    END
  \>> \>> 'domath' STO

    -3 SF -105 CF -120 SF
    { # 0h # 0h } PVIEW ERASE

    IF 1 THEN
@ZRANDOMCOLOR 
      PICT {# 3d,# 1d} 
      GROB 24 11 FFFFFFFFFFFF7CFCFFBDFDFFBFCD7EB7BDBFB7BDAFB5B1AD7C037EFFFFFFFFFFFF
      GOR
    END

    PICT {# 32d,# 2d}
    GROB 62 9 FFFFFFFFFFFFFFF310000000000000025471100000000002D61B5000000000025575100000000002541150000000000254711000000000021000000000000002FFFFFFFFFFFFFFF3
@ZGROBCOLORS -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16776961 -16776961 -16776961 -16776961 -16776961 -16777216 -16776961 -16776961 -16777216 -16777216 -16776961 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16776961 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16776961 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16776961 -16776961 -16776961 -16776961 -16776961 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16776961 -16776961 -16776961 -16776961 -16776961 -16777216 -16776961 -16776961 -16777216 -16776961 -16777216 -16776961 -16777216 -16776961 -16777216 -16776961 -16776961 -16777216 -16776961 -16777216 -16776961 -16777216 -16776961 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16776961 -16776961 -16776961 -16776961 -16776961 -16777216 -16776961 -16776961 -16777216 -16777216 -16776961 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16776961 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16776961 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16776961 -16776961 -16776961 -16776961 -16776961 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16776961 -16777216 -16776961 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 -16776961 
    GOR

    PICT {# 123d,# 2d}
    GROB 5 9 11F1F1F1F1F1F1F1F1
@ZGROBCOLORS -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16744448 -65536 -8388480 -256 -16776961 -16744448 -65536 -16777216 -16777216 -16744448 -65536 -8388480 -256 -16776961 -16744448 -65536 -16777216 -16777216 -16744448 -65536 -8388480 -256 -16776961 -16744448 -65536 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 -16777216 
    GOR



@ZKEYLABELS 56 5761835 -1 -16777216 25 1 "COLOR" 2 "CLEAR" 5 "FONT" 16 "DELETE" 18 "RCL" 19 "STO" 23 "+/-" 24 "Exit" 26 "/" 28 "7" 29 "8" 30 "9" 31 "x" 33 "4" 34 "5" 35 "6" 36 "-" 38 "1" 39 "2" 40 "3" 41 "+" 42 "0" 43 "." 45 "ENTER" 48 "SWAP" 

    4 CF 5 CF
    IF 'calclst' VTYPE -1 == THEN
       {{} 0 0 0 } 'calclst' STO
    ELSE
       6 CF 
       calclst 1 GET 'stk' STO
       4 IF calclst 2 GET THEN CF ELSE SF END coloroption EVAL
       4 IF calclst 2 GET THEN SF ELSE CF END
       5 IF calclst 4 GET THEN CF ELSE SF END fontoption EVAL
       5 IF calclst 4 GET THEN SF ELSE CF END
    END
    6 SF
    dspleveln EVAL
    1 dspstk EVAL
    dspmem EVAL
    dspstkn EVAL

    3 CF 1 CF WHILE 1 FC? REPEAT
@      1 WAIT
       2 CF
       IF KEY THEN 
         'k' STO
         IF k 63 == THEN 
           1 SF 
         ELSE
           CASE
              k 72 \>=  74 k \>= AND THEN k 65 - 2 SF END
              k 82 \>=  84 k \>= AND THEN k 78 - 2 SF END
              k 92 \>=  94 k \>= AND THEN k 91 - 2 SF END
              k 102 == THEN 0 2 SF END
              k 103 == THEN 10 2 SF END
              k 45 == THEN 11 2 SF END
              k 105 == THEN 12 2 SF END
              k 13 == THEN clrstk EVAL END
              k 95 == THEN 1 domath EVAL END
              k 85 == THEN 2 domath EVAL END
              k 75 == THEN 3 domath EVAL END
              k 65 == THEN 4 domath EVAL END
              k 62 == THEN changesign EVAL END
              k 36 == THEN doswap EVAL END
              k 12 == THEN coloroption EVAL END
              k 16 == THEN fontoption EVAL END
              k 53 == THEN storemem EVAL END
              k 52 == THEN rclmem EVAL END
           END
         END
       END
       IF 2 FS? THEN
         # 39d 1 processkey EVAL
       END
    END

@ZKEYLABELSOFF 

@ save data to list before exit
 calclst 1 stk  PUT
 2 IF 4 FC? THEN 0 ELSE 1 END PUT
 4 IF 5 FC? THEN 0 ELSE 1 END PUT 
 'calclst' STO
 fs STOF
 \>> 
\>> 
