home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / CALC_SRC.ZIP / ICALC.S < prev   
Text File  |  1993-06-22  |  27KB  |  650 lines
  1. /*
  2.    RPN integer calculator begun: Wednesday, 17 March 1993
  3.            Last Revised: Thursday, 10 June 1993 (prettied up)
  4.  
  5. Functions to Implement:
  6.  
  7. [x] Enter
  8. [x] LastX
  9. [X] UpdateRegs - update display to current values
  10. [x] Alternate Base math
  11. [X] Add
  12. [X] Sub
  13. [X] Mul
  14. [X] Div
  15. [x] Mod
  16. [x] And
  17. [x] Or
  18. [x] Xor
  19. [x] Not
  20. [x] Shr
  21. [x] Shl
  22. [X] RollUp
  23. [X] RollDn
  24. [X] x<>y
  25. [x] Trap overflows of MaxInt [x] add, [x] sub, [x] Mul
  26. [x] Set a word size for [x] NOT, [x] AND, [x] OR, [x] XOR.
  27. [x] Move calculator box via ctrl direction keys...
  28.  
  29. */
  30. /******************* Global Constants and Variables ***********************/
  31.  
  32.    Constant
  33.       MaxField = 17,          // max size of input field
  34.       XX = 6,                 // horiz location of start of field
  35.       Xy = 8,                 // verticle location of x register
  36.       Yy = 6,                 // verticle location of y register
  37.       Zy = 4,                 // verticle location of z register
  38.       Ty = 2                  // verticle location of t register
  39.  
  40.    String
  41.       Input[MaxField] = '', // keyboard input accumulator
  42.       GetStr[MaxField] = '',// Word under cursor
  43.       BaseLtr[1] = 'd'
  44.  
  45.    Integer
  46.       UpLtCol =  10,          // location for calc window
  47.       UpLtRow =  10,          // location for calc window
  48.       BotRtCol = 34,          // location for calc window - UpLtCol+24
  49.       BotRtRow = 21,          // location for calc window - UpLtRow+11
  50.       X,                // <--+
  51.       Y,                //    |
  52.       Z,                //    |
  53.       T,                //    |- Stack registers
  54.       LastX,            //    |
  55.       Temp,             //    |
  56.       Xa,               // <--+
  57.       Base,             // number base
  58.       WordSize=16,      // width of word to flip, affects Not, And, Or, Xor
  59.       New   = True,     // Flags NEW input
  60.       InitFlag = False, // flag to initiate vars on firs load only
  61.       EnterFlag = false,// allows operations with 'X' not <Enter>ed
  62.       OpFlag = false,   // indicates last operation was a math op
  63.       HelpFlag = False  // remember to trap keypress when back from help
  64.  
  65. /************************************************************************/
  66. /*                   Calculator helper functions                        */
  67. /************************************************************************/
  68. Proc InitRegs()   // initiate variable initial values
  69.  
  70.    x = 0        //<-----+
  71.    y = 0        //      |
  72.    z = 0        //      |
  73.    t = 0        //      |-- Init vars
  74.    Xa = 0       //      |
  75.    LastX = 0    //      |
  76.    Temp = 0     //<-----+
  77.    Base = 10    // default to decimal (set via global var???)
  78.    InitFlag = true      // we're loaded...
  79. End InitRegs
  80. //-------------------------------------------------------------------------
  81. Proc ClrXYZT(Integer y) // Used to clear info from register fields
  82.    Vgotoxy(XX,y)              // on screen when being updated with new
  83.    PutLine(' ',MaxField-1)    // data.
  84. End ClrXYZT
  85. //-------------------------------------------------------------------------
  86. Proc UpDateRegs() // update display to new values of registers
  87.  
  88.    String Filler[1]=Iif(Base == 2, '0', ' ') // fill field with 0s for binary
  89.  
  90.    ClrXYZT(Xy)                // update x
  91.    Vgotoxy(XX,xy)
  92.    PutLine(Format(X:MaxField-1:Filler:Base,BaseLtr:1),MaxField)
  93.    ClrXYZT(Yy)                // update y
  94.    Vgotoxy(XX,Yy)
  95.    PutLine(Format(Y:MaxField-1:Filler:Base,BaseLtr:1),MaxField)
  96.    ClrXYZT(Zy)                // update z
  97.    Vgotoxy(XX,Zy)
  98.    PutLine(Format(Z:MaxField-1:Filler:Base,BaseLtr:1),MaxField)
  99.    ClrXYZT(Ty)                // update t
  100.    Vgotoxy(XX,Ty)
  101.    PutLine(Format(T:MaxField-1:Filler:Base,BaseLtr:1),MaxField)
  102. End UpDateRegs
  103. //-------------------------------------------------------------------------
  104. #INCLUDE 'icalc.hlp'           /***** contains help display *****/
  105. //-------------------------------------------------------------------------
  106. Proc SetWordSize()// set number of bits to toggle with AND/OR/XOR/NOT
  107.    Integer  key,
  108.             OldAttr
  109.  
  110.    If Not EnterFlag X = Xa EndIf             // number not <Enter>ed
  111.    OpFlag = True
  112.    New = True
  113.    Vgotoxy(XX,xy)                            // locate
  114.    PutLine('WordSize?',MaxField)             // and place prompt
  115.    OldAttr = Set(Attr,Query(MenuTextAttr))   // set color to match menus
  116.    VgotoXy(XX,Xy+1)                          // locate
  117.    PutLine('0FEDCBA987654321',MaxField-1)    // and add wordsize indicators
  118.    VgotoXY(XX+(MaxField-(1+WordSize)),Xy+1)  // locate on current size
  119.    PutAttr(Query(MenuTextLtrAttr),1)         // highlight it
  120.    Set(Attr,OldAttr)                         // reset color
  121.    key = GetKey() & 0FFh                     // get keys char value
  122.    Case key
  123.       When 30h..39h,41h..46h,61h..66h        // number 0..16
  124.          Vgotoxy(XX+Maxfield-3,xy)           // locate to show choice
  125.          If Val(Chr(Key),16)                 // if not 0
  126.             WordSize = Val(Chr(Key),16)
  127.          Else                                // if 0 force to 10h
  128.             WordSize = 16
  129.          EndIf
  130.          PutLine(Format(WordSize:2:'0':16,'h'),3)  // display value for
  131.          Delay(4)                                  // only short time
  132.          UpdateRegs()                              // redisplay registers
  133.       When 01Bh         // When Esc do nothing
  134.          UpdateRegs()   // redisplay registers
  135.       Otherwise
  136.          SetWordSize()  // recurse until 0..F or Esc
  137.    EndCase
  138.    Set(Attr,Query(MenuTextAttr))                   // set color to match menus
  139.    VgotoXY(XX,Xy+1)                 // locate and replace tic marks
  140.    PutLine('    '+chr(249)+'   '+chr(249)+'   '+Chr(249),MaxField)
  141.    VgotoXY(XX+(MaxField-(1+WordSize)),Xy+1)        // locate wordsize point
  142.    PutLine(Chr(24),1)                              // place arrow indicator
  143.    VgotoXY(XX+(MaxField-(1+WordSize)),Xy+1)        // back to arrow location
  144.    PutAttr(Query(MenuTextLtrAttr),1)               // highlight it
  145.    Set(Attr,OldAttr)                               // reset color
  146. End SetWordSize
  147. //-------------------------------------------------------------------------
  148. Proc Math(Integer Op)
  149.  
  150.  Integer i = 1
  151.  
  152.    String XStr[MaxField-1] = '',   // holds binary string representaion of X
  153.           YStr[MaxField-1] = '',   // holds binary string representaion of Y
  154.           NewStr[MaxField-1] = '', // holds binary string representaion
  155.           AddZeros[MaxField-1] = ''    // accumulates 0's for SHL
  156.  
  157.    If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  158.    LastX = X   // always update Last X
  159.    Case Op
  160.       When 1 X = y + x  // Add function
  161.       When 2 X = y - x  // Subtract function
  162.       When 3 X = y * x  // Multiply function
  163.       When 4 X = y / x  // Divide function
  164.       When 5 X = y MOD x// Modulus function
  165.       When 6            // AND
  166.          XStr = Format(X:MaxField-1:'0':2)
  167.          YStr = Format(Y:MaxField-1:'0':2)
  168.          NewStr = SubStr(YStr,1,(MaxField-WordSize)-1)
  169.          i = MaxField - WordSize
  170.          Repeat
  171.             NewStr = NewStr + Str(Val(Ystr[i]) & Val(XStr[i]))
  172.             i = i + 1
  173.          Until i > Length(YStr)
  174.          X = Val(NewStr,2)
  175.       When 7            // OR
  176.          XStr = Format(X:MaxField-1:'0':2)
  177.          YStr = Format(Y:MaxField-1:'0':2)
  178.          NewStr = SubStr(YStr,1,(MaxField-WordSize)-1)
  179.          i = MaxField - WordSize
  180.          Repeat
  181.             NewStr = NewStr + Str(Val(Ystr[i]) | Val(XStr[i]))
  182.             i = i + 1
  183.          Until i > Length(YStr)
  184.          X = Val(NewStr,2)
  185.       When 8            // XOR
  186.          XStr = Format(X:MaxField-1:'0':2)
  187.          YStr = Format(Y:MaxField-1:'0':2)
  188.          NewStr = SubStr(YStr,1,(MaxField-WordSize)-1)
  189.          i = MaxField - WordSize
  190.          Repeat
  191.             NewStr = NewStr + Str(Val(Ystr[i]) ^ Val(XStr[i]))
  192.             i = i + 1
  193.          Until i > Length(YStr)
  194.          X = Val(NewStr,2)
  195.       // Special ops
  196.       When 9 //X = ~x     // NOT X <--+ operate only on X no stack shift
  197.          XStr = Format(X:MaxField-1:'0':2)
  198.          i = MaxField - WordSize
  199.          Repeat
  200.             if XStr[i] == '0'   // if 0 toggle to 1
  201.                XStr = (SubStr(XStr,1,i-1)+'1'+SubStr(XStr,i+1,Length(XStr)))
  202.             Else                    // if 1 toggle to 0
  203.                XStr = (SubStr(XStr,1,i-1)+'0'+SubStr(XStr,i+1,Length(XStr)))
  204.             EndIf
  205.             i = i + 1
  206.          Until i > Length(XStr) // done
  207.          X = Val(XStr,2)        // get bitwise NOT value in X
  208.       When 10           // Shr
  209.          XStr = Format(Y:MaxField-1:'0':2)
  210.          X = Val(SubStr(XStr,1,Length(XStr)-x),2)   //clip off X digits
  211.       When 11           // Shl
  212.          XStr = Format(Y:MaxField-1:'0':2)
  213.          Repeat
  214.             AddZeros = AddZeros + '0'  // add X trailing 0s to Y
  215.             i = i + 1
  216.          Until i > x
  217.          X = Val(SubStr(XStr,1+x,Length(XStr))+AddZeros,2) //place Val in X
  218.    EndCase
  219.    Xa = X                     // force accumulator and X to match
  220.    If Op <> 9                 // adjust stack EXCEPT for NOT operation
  221.       Y = Z
  222.       Z = T
  223.    EndIf
  224.    EnterFlag = True           // Enter/Op
  225.    New = True                 // any further entry is new
  226.    OpFlag = True              // operation completed
  227.    UpdateRegs()               // redisplay registers
  228. End Math
  229. //-------------------------------------------------------------------------
  230. Proc ShiftStat()  // common operations to all register manipulations
  231.    Xa = X         // force accumulator to match X
  232.    New = True     // ready for new input
  233.    OpFlag = True  // last function was an operation
  234. End ShiftStat
  235. //-------------------------------------------------------------------------
  236. Proc ShiftUp()    // swap regs up
  237.    Temp  =  T
  238.    T     =  Z
  239.    Z     =  Y
  240.    Y     =  X
  241.    X     =  Temp
  242.    UpdateRegs()
  243.    ShiftStat()
  244. End ShiftUp
  245. //-------------------------------------------------------------------------
  246. Proc ShiftDn()    // swap regs down
  247.    Temp  =  X
  248.    X     =  Y
  249.    Y     =  Z
  250.    Z     =  T
  251.    T     =  Temp
  252.    UpdateRegs()
  253.    ShiftStat()
  254. End ShiftDn
  255. //-------------------------------------------------------------------------
  256. Proc SwapXY()     // swap x and y registers
  257.    Temp  =  X
  258.    X     =  Y
  259.    Y     =  Temp
  260.    UpdateRegs()
  261.    ShiftStat()
  262. End SwapXY
  263. //-------------------------------------------------------------------------
  264. Proc LstX()       // recall last X entry
  265.    New = True
  266.    ShiftUp()
  267.    X  =  LastX
  268.    UpdateRegs()
  269.    ShiftStat()
  270. End LstX
  271. //-------------------------------------------------------------------------
  272. Proc Clx()        // clear X value, ready for new entry
  273.    X = 0
  274.    UpdateRegs()
  275.    Input = ''
  276.    Xa = X
  277.    New = True
  278.    OpFlag = False
  279. End Clx
  280. //-------------------------------------------------------------------------
  281. Proc OpTest()     // test for last action = operation, handle accordingly
  282.  
  283.    If OpFlag
  284.       ShiftUp()
  285.       OpFlag = False
  286.    EndIf
  287. End OpTest
  288. //-------------------------------------------------------------------------
  289. Proc Overflow()   // display warning of pending overflow condition
  290.       Vgotoxy(XX,xy)                // locate for output
  291.       PutLine('OVERFLOW',MaxField)  // Error Msg
  292.       Delay(9)                      // pause for a bit
  293. End Overflow
  294. //-------------------------------------------------------------------------
  295. Proc BinHexDecOct(Integer MyBase)// Dec Hex or Binary Oct mode toggles
  296.  
  297.    OpFlag = True
  298.    New = true
  299.    If MyBase == 16
  300.       BaseLtr = 'h'
  301.       Base = 16
  302.    EndIf
  303.    If MyBase == 10
  304.       BaseLtr = 'd'
  305.       Base = 10
  306.    EndIf
  307.    If MyBase == 8
  308.       BaseLtr = 'o'
  309.       Base = 8
  310.    EndIf
  311.    If MyBase == 2
  312.       BaseLtr = 'b'
  313.       Base = 2
  314.    EndIf
  315.    UpdateRegs()                  // update regs - completes partial ops
  316. End BinHexDecOct
  317.  
  318. /**************************************************************************/
  319.  
  320. Proc ShadowBox(Integer OnOff) // turn shadow under calc on or off
  321.    If OnOff
  322.       PopWinOpen(UpLtCol+1,UpLtRow+1,BotRtCol+1,BotRtRow+1,1,'',Color(Black on Black))
  323.    Else
  324.       PopWinClose()           // turn shadow off
  325.    EndIf
  326. End ShadowBox
  327.  
  328. /**************************************************************************/
  329.  
  330. Proc CalcBox(Integer OnOff)   // place the calculator display on the screen
  331.                               // or turn it off
  332.    Integer
  333.       OldAttr
  334.    String
  335.       Tic[13] = '    '+chr(249)+'   '+chr(249)+'   '+Chr(249)
  336.  
  337.    If OnOff
  338.       PopWinOpen(UpLtCol,UpLtRow,BotRtCol,BotRtRow,1,'Integer Calculator',Query(MenuBorderAttr))
  339.       VgotoXY(1,1)                              // get video cursor in box
  340.       OldAttr = Set(Attr,Query(MenuTextAttr))   // set color to match menus
  341.       clrscr()                                  // clear box
  342.       Vgotoxy(4,2)                              // <-----+
  343.       PutLine('T',1)                            //       |
  344.       Vgotoxy(4,4)                              //       |
  345.       PutLine('Z',1)                            //       |- add labels
  346.       Vgotoxy(4,6)                              //       |
  347.       PutLine('Y',1)                            //       |
  348.       Vgotoxy(4,8)                              //       |
  349.       PutLine('X',1)                            // <-----+
  350.       VgotoXY(XX,Xy+1)
  351.       PutLine(Tic,MaxField)                     // nibble tic marks
  352.       VgotoXY(XX+(MaxField-(1+WordSize)),Xy+1)
  353.       PutLine(Chr(24),1)                        // wordsize indicator
  354.       VgotoXY(XX+(MaxField-(1+WordSize)),Xy+1)
  355.       PutAttr(Query(MenuTextLtrAttr),1)
  356.       VgotoXY(1,Xy+2)
  357.       PutLine('Esc to Exit, H for help',23)     // short help
  358.       Set(Attr,Query(TextAttr))  // set the attribute to reg edit screen
  359.       ClrXYZT(Ty) // <-----+
  360.       ClrXYZT(Zy) //       |- display blank fields
  361.       ClrXYZT(Yy) //       |
  362.       ClrXYZT(Xy) // <-----+
  363.    Else
  364.       PopWinClose()  // all done, turn shadow off
  365.    EndIf
  366. End CalcBox
  367. /************************* Move box Location ****************************/
  368. Proc MoveBox(integer LtRt, integer UpDn)
  369.  
  370.    If (UpLtCol + LtRt > 0) AND (UpLtCol + LtRt + 24 < Query(ScreenCols))
  371.       UpLtCol = UpLtCol + LtRt
  372.       BotRtCol = UpLtCol+24
  373.    Else
  374.       Return()
  375.    EndIf
  376.    If (UpLtRow + UpDn > 0) AND (UpLtRow + UpDn + 11 < Query(ScreenRows))
  377.       UpLtRow = UpLtRow + UpDn
  378.       BotRtRow = UpLtRow+11
  379.    Else
  380.       Return()
  381.    EndIf
  382.    CalcBox(Off)            // close the calc window
  383.    ShadowBox(Off)          // erase the shadow
  384.    ShadowBox(On)           // redraw the shadow
  385.    CalcBox(On)             // redraw the window
  386.    UpDateRegs()            // refill the fields
  387. End MoveBox
  388. /*********************** Get and display input ****************************/
  389.  
  390. Proc ShowInput(String tmp) // ShowInput only used by GetInput()
  391.  
  392.    String   InputTest[MaxField]  = '', // copy of input string
  393.             s[1] = UpCase(tmp)   // force a..f upper case for overflow compare
  394.  
  395.    If New
  396.       ClrXYZT(Xy)          // if NEW entry clear field
  397.       InPut = s            // set Input to first char
  398.       New = False          // after first key no longer 'New'
  399.    // check for string length and overflow
  400.    Elseif Length(Input) <= Length(Str(MaxInt,Base)) and Length(Input) < MaxField-1
  401.       InputTest = Input + s// string for compare
  402.       While InputTest[1] == '0' and Length(InputTest) > 1  // no leading zeros
  403.          InputTest = SubStr(InputTest,2,Length(InputTest)) // strip leading 0s
  404.       EndWhile
  405.       If InputTest <> Str(Val(Input+s,base),base)  // if overflow strings won't match
  406.          Overflow()        // show error message
  407.       Else
  408.          Input = Input+s   // all is well add new digit on tail
  409.       EndIf
  410.    EndIf
  411.    Xa = Val(Input,Base)    // accumulate Real Input
  412.    Vgotoxy(XX,xy)          // goto 'X' field
  413.    PutLine(Format(Input:MaxField-1),MaxField-1)  // write the entered data
  414. End ShowInput
  415.  
  416. //---------------------------
  417.  
  418. Proc GetInput()   // get keyboard input and display it
  419.  
  420.    Integer
  421.       Key,                    // key character value
  422.       NumKey,                 // number value of key
  423.       i                       // scratch counter
  424.  
  425. Loop              // you're in the loop now, only one way out...
  426.    Repeat until Keypressed()  // keep cycling while waiting for keys
  427.    Key = GetKey()             // get value
  428.    NumKey = Key & 0FFh  // character value of key (or 0 for numpad or 224 for greykeys)
  429.    If HelpFlag                // trap key used to exit help
  430.       Key = 255               // set key to unused value
  431.       NumKey = 0              // set key to unused value
  432.       HelpFlag = False        // ready to accept values or commands
  433.    EndIf
  434.    If EnterFlag               // if last function was <Enter> or an operation
  435.       Case Key & 0FFh         // choose based on ascii value
  436.          When 030h..039h,041h..046h,061h..066h, 02Eh, 08h // nums, decimal, backspace
  437.             EnterFlag = False // indicator of last operation
  438.          Otherwise            // don't loose entries not terminated with <Enter>
  439.             EnterFlag = True  // otherwise last function was an operation
  440.       EndCase
  441.    EndIf
  442.    case NumKey                /***** MAIN INPUT *****/
  443.       /***** NUMBER INPUT '0'..'9',A..F,a..f *****/
  444.       When 030h..039h,041h..046h,061h..066h  // test if in 'all numbers set'
  445.          If Base == 16                       // HEX accepts [0..9,a..f,A..F]
  446.             OpTest()                         // action based on last operation
  447.             ShowInput(Chr(NumKey))           // display keyed number
  448.          ElseIf Base == 10                   // DEC accepts [0..9]
  449.             Case NumKey
  450.                When 030h..039h
  451.                   OpTest()                   // action based on last operation
  452.                   ShowInput(Chr(NumKey))     // display keyed number
  453.             EndCase                          // fall through if not 0..9
  454.          ElseIf Base == 8                    // OCT accepts [0..7]
  455.             Case NumKey
  456.                When 030h..037h
  457.                   OpTest()                   // action based on last operation
  458.                   ShowInput(Chr(NumKey))     // display keyed number
  459.             EndCase                          // fall through if not 0..7
  460.          ElseIf Base == 2                    // BIN accepts [0,1]
  461.             Case NumKey
  462.                When 030h..031h
  463.                   OpTest()                   // action based on last operation
  464.                   ShowInput(Chr(NumKey))     // display keyed number
  465.             EndCase                          // fall through if not 0..7
  466.          EndIf
  467.       When 08h                /***** BACKSPACE *****/
  468.          If EnterFlag InPut = '' EndIf
  469.          Input = SubStr(Input,1,Length(Input)-1)   // remove last char.
  470.          If Length(Input) > 0    // as long as it has a length, 'Input'
  471.             Xa = Val(Input,Base) //  still has a value, update accumulator.
  472.          Else
  473.             Xa = 0               // otherwise zero the accumulator
  474.          EndIf
  475.          ClrXYZT(Xy)             // clear the 'X' register
  476.          Vgotoxy(XX,xy)
  477.          PutLine(Format(Xa:MaxField-1:' ':Base,BaseLtr:1),MaxField)  // display
  478.       When 0Dh                /***** ENTER *****/
  479.          X = Xa         // stuff the accumulator into the Real 'X' register
  480.          T = Z          // enter
  481.          Z = Y          //    only
  482.          Y = X          //       stack handling
  483.          UpDateRegs()   // update the register display
  484.          Xa = X         // force match of X and input accumulator
  485.          New = True     // assure that next entry is NEW
  486.          EnterFlag = True  // value was entered - no special handling
  487.       When 02Bh               /****** ADD *****/
  488.          /*check for overflow*/
  489.          If MaxInt - Iif(Y<0,-y,y) >= Iif((Xa<0 and Y<0),-Xa,Xa)
  490.             Math(1)     // 1=Add, 2=Subtract, 3=Multiply, 4=Divide...
  491.          Else
  492.             OverFlow()
  493.             X = Xa
  494.             UpDateRegs()
  495.          EndIf
  496.       When 02Dh               /****** SUBTRACT *****/
  497.          /*check for overflow*/
  498.          If X > 0 and Y > 0   // if both positive ok to subtract
  499.             Math(2)     // 1=Add, 2=Subtract, 3=Multiply, 4=Divide...
  500.          // test for underflow (over -MaxInt)
  501.          ElseIf MaxInt - Iif(Y<0,-y,y) >= Iif((Xa<0 and Y<0),-Xa,Xa)
  502.             Math(2)     // 1=Add, 2=Subtract, 3=Multiply, 4=Divide...
  503.          Else
  504.             OverFlow()
  505.             X = Xa
  506.             UpDateRegs()
  507.          EndIf
  508.       When 02Ah               /***** MULTIPLY *****/
  509.          /*check for overflow*/
  510.          If MaxInt/Iif(Xa<0 ,-Xa,Xa) > Iif(Y<0,-Y,Y) or Xa == 0
  511.             Math(3)     // 1=Add, 2=Subtract, 3=Multiply, 4=Divide...
  512.          Else
  513.             OverFlow()
  514.             X = Xa
  515.             UpDateRegs()
  516.          EndIf
  517.       When 02Fh           /****** DIVIDE *****/
  518.          Math(4)  // 1=Add, 2=Subtract, 3=Multiply, 4=Divide...
  519.       When 05Ch         /****** MODULO *****/
  520.          Math(5)  // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  521.       When 026h         /****** Bitwise AND *****/
  522.          Math(6)  // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  523.       When 07Ch         /****** Bitwise OR *****/
  524.          Math(7)  // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  525.       When 05Eh         /****** Bitwise XOR *****/
  526.          Math(8)  // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  527.       When 06Eh, 04Eh   /****** Bitwise NOT *****/
  528.          Math(9)  // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  529.       When 03Eh, 02Eh   /****** SHR *****/
  530.          Math(10) // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  531.       When 03Ch, 02Ch   /****** SHL *****/
  532.          Math(11) // 5=Modulo, 6=And, 7=Or, 8=Xor, 9=Not, 10=Shr, 11=Shl
  533.                        /****** CURSOR KEYS *****/
  534.       When 0, 224       // when number pad arrows or grey arrows
  535.          Case Key Shr 8 // get key value
  536.             When 72, 75, 77, 80, 115, 116, 141, 145  // if any key matches
  537.                If Not EnterFlag  // number not <Enter>ed but need to
  538.                   X = Xa         // update x with accumulator
  539.                   EnterFlag = True  // toggle flag
  540.                   New = True        // flags
  541.                   OpFlag = True     // on
  542.                EndIf
  543.          EndCase
  544.          Case Key shr 8       // test key again for extended values
  545.             When 72           // cursor up
  546.                ShiftUp()      // shift registers up
  547.             When 80           // cursor dn
  548.                ShiftDn()      // shift registers down
  549.             When 75, 77       // Lt/Rt Cursor
  550.                If Not EnterFlag X = Xa EndIf // number not <Enter>ed force value into X
  551.                SwapXY()       // swap x and y values
  552.             When 83           // del
  553.                Clx()
  554.             When 115
  555.                MoveBox(-1,0)
  556.             When 116
  557.                MoveBox(1,0)
  558.             When 141
  559.                MoveBox(0,-1)
  560.             When 145
  561.                MoveBox(0,1)
  562.          EndCase
  563.                        /****** LETTER KEYS *****/
  564.       When 057h, 077h         // 'W','w' = binary
  565.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  566.          BinHexDecOct(2)
  567.       When 04Fh, 06Fh         // 'O','o' = Octal
  568.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  569.          BinHexDecOct(8)
  570.       When 054h, 074h         // 'T','t' = Decimal
  571.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  572.          BinHexDecOct(10)
  573.       When 058h, 078h         // 'x','X' = HexiDecimal
  574.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  575.          BinHexDecOct(16)
  576.       When 06Ch, 4Ch          // 'l' or 'L' gets Last X
  577.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  578.          LstX()
  579.       When 048h, 068h         // 'H' or 'h' calls help
  580.          CalcHelp()
  581.       When 047h, 067h         // 'G' or 'g' get number
  582.          If GetStr == ''
  583.             // do nothing
  584.          Else
  585.                ShiftUp()            // adjust the stack
  586.                X = Val(GetStr,base) // save the value
  587.                Xa = X               // update the accumulator
  588.                UpDateRegs()         // update the display
  589.                EnterFlag = False    // reset the flag
  590.          EndIf
  591.       When 050h, 070h         // 'P' or 'p' Paste X into buffer
  592.          i = 1
  593.          GetStr = Format(x:MaxField-1:' ':Base)
  594.          While GetStr[i] == chr(32) and i < MaxField
  595.             i = i + 1
  596.          EndWhile
  597.          GetStr = SubStr(GetStr,i,Length(GetStr)) // trim leading spaces
  598.          InsertText(GetStr)   // paste into text
  599.          New = True           // assure that next entry is NEW
  600.          EnterFlag = True     // forced entry
  601.          Break                // exit loop and drop back to edit session
  602.       When 72h,52h            // set wordsize
  603.          SetWordSize()
  604.       When 053h, 073h         // 'S' or 's' Clears the stack
  605.          i = base             // save current base
  606.          key = LastX          // use Key var to save LastX
  607.          InitRegs()           // reset all variables
  608.          LastX = Key          // restore LastX
  609.          Key = 255            // set key to unused value
  610.          BinHexDecOct(i)      // restore base
  611.                        /****** ESCAPE KEY *****/
  612.       When 01Bh               // Esc pressed, time to quit
  613.          If Not EnterFlag X = Xa EndIf // save current x
  614.          New = True           // assure that next entry is NEW
  615.          EnterFlag = True     // forced entry
  616.          Break                // exit loop return to edit
  617.    EndCase
  618. EndLoop           // end key entry loop
  619. End GetInput
  620.  
  621. /******************************** MAIN ************************************/
  622.  
  623. Proc Main()       // Setup
  624.    If Not InitFlag         // if first use,
  625.       InitRegs()           // inititilize vars, otherwise retain previous values
  626.    EndIf
  627.    // Mark current word for import
  628.    If IsBlockMarked() PushBlock() EndIf   // save existing block marks
  629.    If MarkWord()                          // a word was markable
  630.       GetStr = GetMarkedText()            // grab it
  631.       UnMarkBlock()                       // unmark word
  632.    Else
  633.       GetStr = ''                         // set string to nil on failure
  634.    EndIf
  635.    PopBlock()                             // restore previous marking
  636.    // end get import string
  637.    UpDateDisplay()         // clean up any editor messages left onscreen
  638.    Set(Cursor,Off)         // turn off cursor since it intrudes if under box
  639.    ShadowBox(On)           // draw the shadow
  640.    CalcBox(On)             // draw the window
  641.    UpDateRegs()            // fill the fields
  642.    GetInput()              // enter Input loop
  643.    CalcBox(Off)            // close the calc window
  644.    ShadowBox(Off)          // erase the shadow
  645.    Set(Cursor,On)          // done - turn cursor back on
  646. End Main
  647.  
  648. /**************************** EOF 'calc.s'*********************************/
  649.  
  650. // <Ctrl centercursor>     ExecMacro('icalc')   // my calc button