home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / CALC_SRC.ZIP / CALC.S < prev    next >
Text File  |  1993-08-10  |  14KB  |  311 lines
  1. /*
  2.    RPN calculator begun: Saturday, 6 March 1993
  3.            Last Revised: Monday, 9 August 1993
  4.  
  5. Functions to Implement:
  6.  
  7. [x] Enter
  8. [X] UpdateRegs - update display to current values
  9. [X] Fix   - number of trailing decimals
  10. [X] Add
  11. [X] Sub
  12. [X] Mul
  13. [X] Div
  14. [X] RollUp     // up arrow
  15. [X] RollDn     // dn arrow
  16. [X] x<>y       // lt/rt arrows
  17. [X] Binary  - View Int value 'X' only
  18. [X] Hex     - View Int value 'X' only
  19. [x] move calculator via ctrl direction keys
  20. [ ] Binary math - (integer)
  21. [ ] Octal math - (integer)
  22. [ ] Hex math - (integer)
  23. */
  24. /**************************************************************************/
  25. #INCLUDE 'fp_min.s'  // include minimum floating point lib
  26.                      // (reduces mac size 350 bytes)
  27. /******************* Global Constants and Variables ***********************/
  28.  
  29.    Constant
  30.       MaxField = 17,          // max size of input field
  31.       XX = 23,                // horiz location of right end of field
  32.       Xy = 8,                 // verticle location of x register
  33.       Yy = 6,                 // verticle location of y register
  34.       Zy = 4,                 // verticle location of z register
  35.       Ty = 2                  // verticle location of t register
  36.  
  37.    String
  38.       x[IEEE],                //<---+
  39.       y[IEEE],                //    |
  40.       z[IEEE],                //    |-- Stack registers
  41.       t[IEEE],                //    |
  42.       LastX[IEEE],            //<---+
  43.       Temp[IEEE],             // temp storage used for reg manipulation
  44.       Xa[IEEE],               // X Real input accumulator
  45.       Input[MaxField+3]  = '',// keyboard input accumulator
  46.       GetStr[MaxField+3] = '' // Word under cursor
  47.  
  48.    Integer
  49.       UpLtCol   = 10,     // location for calc window
  50.       UpLtRow   = 10,     // location for calc window
  51.       BotRtCol  = 34,     // location for calc window - UpLtCol+24
  52.       BotRtRow  = 21,     // location for calc window - UpLtRow+11
  53.       Fixed     = 4,      // defaut number of displayed decimals
  54.       New       = True,   // Flags NEW input
  55.       InitFlag  = False,  // flag to initiate vars on firs load only
  56.       EnterFlag = false,  // allows operations with 'X' not <Enter>ed
  57.       OpFlag    = false,  // indicates last operation was a math op
  58.       HelpFlag  = False   // remember to trap keypress when back from help
  59.  
  60. /**************************************************************************/
  61. #INCLUDE 'calc.inc'           /***** contains needed helper functions *****/
  62. /**************************************************************************/
  63.  
  64. Proc CalcBox()          // place the calculator display on the screen
  65.  
  66.    Integer
  67.       OldAttr
  68.  
  69.    PopWinOpen(UpLtCol,UpLtRow,BotRtCol,BotRtRow,1,'Calculator',Query(MenuBorderAttr))
  70.    VgotoXY(1,1)                              // get video cursor in box
  71.    OldAttr = Set(Attr,Query(MenuTextAttr))   // set color to match menus
  72.    clrscr()                                  // clear box
  73.    Vgotoxy(4,2)                              // <-----+
  74.    PutLine('T',1)                            //       |
  75.    Vgotoxy(4,4)                              //       |
  76.    PutLine('Z',1)                            //       |- add labels
  77.    Vgotoxy(4,6)                              //       |
  78.    PutLine('Y',1)                            //       |
  79.    Vgotoxy(4,8)                              //       |
  80.    PutLine('X',1)                            // <-----+
  81.    VgotoXY(1,10)
  82.    PutLine('Esc to Exit, H for help',23)
  83.    Set(Attr,Query(TextAttr))  // set the attribute to reg edit screen
  84.    ClrXYZT(Ty) // <-----+
  85.    ClrXYZT(Zy) //       |- display blank fields
  86.    ClrXYZT(Yy) //       |
  87.    ClrXYZT(Xy) // <-----+
  88. End CalcBox
  89. /************************* Move box Location ******************************/
  90. Proc MoveBox(integer LtRt, integer UpDn)
  91.  
  92.    If (UpLtCol + LtRt > 0) AND (UpLtCol + LtRt + 24 < Query(ScreenCols))
  93.       UpLtCol = UpLtCol + LtRt
  94.       BotRtCol = UpLtCol+24
  95.    Else
  96.       Return()             // illegal move - do nothing
  97.    EndIf
  98.    If (UpLtRow + UpDn > 0) AND (UpLtRow + UpDn + 11 < Query(ScreenRows))
  99.       UpLtRow = UpLtRow + UpDn
  100.       BotRtRow = UpLtRow+11
  101.    Else
  102.       Return()             // illegal move - do nothing
  103.    EndIf
  104.    PopWinClose()           // close the calc window
  105.    CalcBox()               // redraw the window
  106.    UpDateRegs()            // refill the fields
  107. End MoveBox
  108. /*********************** Get and display input ****************************/
  109.  
  110. Proc ShowInput(String s)// ShowInput only used by GetInput()
  111.  
  112.    If New
  113.       ClrXYZT(Xy)          // if NEW entry clear field
  114.       InPut = s            // set Input to first char
  115.       New = False          // after first key no longer 'New'
  116.    Else
  117.       if Length(Input) < MaxField   // as long as field length not exceeded
  118.          Input = Input + s          // accumulate Ascii Input
  119.       EndIf
  120.    EndIf
  121.    If Input[1] == '.' Input = '0'+Input EndIf   // tack on leading '0'
  122.    Xa = FVal(Input)              // accumulate Real Input
  123.    If FMathError
  124.       FmathError = False
  125.    EndIf
  126.    // The following line corrects an error in the FP package that causes
  127.    // a value of 0 to be returned by FVal('0.25') or FVal('0.250')
  128.    If InPut == '0.25' or InPut == '0.250' Xa = FVal('0.2500') EndIf
  129.    Vgotoxy(XX-MaxField,xy)                   // goto 'X' field
  130.    PutLine(Format(Input:MaxField),MaxField)  // write the entered data
  131. End ShowInput
  132.  
  133. //---------------------------
  134.  
  135. Proc GetInput()         // get keyboard input and display it
  136.  
  137.    Integer
  138.       Key,                       // key character value
  139.       i                          // scratch counter
  140.    String
  141.       PasteStr[MaxField+3]
  142.  
  143. Loop                          // you're in the loop now, only one way out...
  144.    Repeat until Keypressed()  // keep cycling while waiting for keys
  145.    Key = GetKey()             // get value
  146.    If HelpFlag                // trap key used to exit help
  147.       Key = 0                 // set key to unused value
  148.       HelpFlag = False        // be sure to turn the flag off
  149.    EndIf
  150.    If EnterFlag               // if last function was <Enter> or an operation
  151.       Case Key & 0FFh         // choose based on ascii value
  152.          When 030h..039h, 02Eh, 08h // nums, decimal, backspace
  153.             EnterFlag = False // indicator of last operation
  154.          Otherwise            // don't loose entries not terminated with <Enter>
  155.             EnterFlag = True  // otherwise last function was an operation
  156.       EndCase
  157.    EndIf
  158.    case Key & 0FFh            /***** MAIN INPUT *****/
  159.       When 030h..039h         /***** NUMBER INPUT '0'..'9' *****/
  160.          OpTest()
  161.          ShowInput(Chr(Key & 0FFh))
  162.       When 2Eh                /***** DECIMAL POINT *****/
  163.          If Not Pos('.', Input) or New // if x doesn't have a decimal yet
  164.             OpTest()          // special work if last action was an operation
  165.             ShowInput('.')    //  accept it...
  166.          endif                //   otherwise ignore it.
  167.       When 08h                /***** BACKSPACE *****/
  168.          Input = SubStr(Input,1,Length(Input)-1)   // remove last char.
  169.          If Length(Input) > 0 // as long as it has a length, 'Input'
  170.             Xa = FVal(Input)  //  still has a value, update accumulator.
  171.          Else
  172.             Xa = ZeroExtended // otherwise zero the accumulator
  173.          EndIf
  174.          ClrXYZT(Xy)                   // clear the 'X' register
  175.          Vgotoxy(XX-Length(Input),xy)
  176.          PutLine(Input,Length(Input))  // show the value
  177.       When 0Dh                /***** ENTER *****/
  178.          X = Xa   // stuff the accumulator into the Real 'X' register
  179.          T = Z    // enter
  180.          Z = Y    //    only
  181.          Y = X    //       stack handling
  182.          UpDateRegs()   // update the register display
  183.          Xa = X         // force match of X and input accumulator
  184.          New = True     // assure that next entry is NEW
  185.          EnterFlag = True  // value was entered - no special handling
  186.       When 02Bh               /****** ADD *****/
  187.          Math(1)  // 1=Add, 1=Subtract, 3=Multiply, 4=Divide
  188.       When 02Dh               /****** SUBTRACT *****/
  189.          Math(2)  // 1=Add, 1=Subtract, 3=Multiply, 4=Divide
  190.       When 02Ah               /***** MULTIPLY *****/
  191.          Math(3)  // 1=Add, 1=Subtract, 3=Multiply, 4=Divide
  192.       When 02Fh           /****** DIVIDE *****/
  193.          Math(4)  // 1=Add, 1=Subtract, 3=Multiply, 4=Divide
  194.       When 0, 224       // when number pad arrows or grey arrows
  195.          Case Key Shr 8 // get key value
  196.             When 72, 75, 77, 80, 115, 116, 141, 145  // if any key matches
  197.                If Not EnterFlag  // number not <Enter>ed but need to
  198.                   X = Xa         // update x with accumulator
  199.                   EnterFlag = True  // toggle flag
  200.                   New = True        // flags
  201.                   OpFlag = True     // on
  202.                EndIf
  203.          EndCase
  204.          Case Key shr 8       // test key again for extended values
  205.             When 72           // cursor up
  206.                ShiftUp()      // shift registers up
  207.             When 80           // cursor dn
  208.                ShiftDn()      // shift registers down
  209.             When 75, 77       // Lt/Rt Cursor
  210.                If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  211.                SwapXY()       // swap x and y values
  212.             When 83           // del
  213.                Clx()
  214.                     /***** MOVE BOX COMMANDS *****/
  215.             When 115          // Lt cursor
  216.                MoveBox(-1,0)
  217.             When 116          // Rt cursor
  218.                MoveBox(1,0)
  219.             When 141          // Up cursor
  220.                MoveBox(0,-1)
  221.             When 145          // Dn cursor
  222.                MoveBox(0,1)
  223.          EndCase
  224.                        /****** LETTER KEYS *****/
  225.       When 062h, 042h         // 'B','b' = binary
  226.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  227.          BinHex(2)
  228.       When 058h, 078h         // 'x','X' = Hex
  229.          If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  230.          BinHex(16)
  231.       When 46h,66h            // 'F' or 'f' call fix()
  232.          Fix()
  233.       When 06Ch, 4Ch          // 'l' or 'L' gets Last X
  234.          LstX()
  235.       When 048h, 068h         // 'H' or 'h' calls help
  236.          If Not EnterFlag X = Xa EndIf // update x with accumulator
  237.          CalcHelp()
  238.       When 047h, 067h         // 'G' or 'g' get number
  239.          If GetStr == ''
  240.             // do nothing
  241.          Else
  242.             // First work around 'fp' bug...
  243.             If GetStr == '0.25' or GetStr == '0.250' GetStr = '0.2500' EndIf
  244.             FVal(GetStr)      // see if it's a number
  245.             If FMathError     //  it's not
  246.                FMathError = False   // clear the error
  247.                // do nothing
  248.             Else
  249.                ShiftUp()            // adjust stack
  250.                X = FVal(GetStr)     // save the value
  251.                Xa = X               // update the accumulator
  252.                UpDateRegs()         // update the display
  253.                OpFlag = True        // flag a successful operation
  254.             EndIf
  255.          EndIf
  256.       When 050h, 070h         // 'P' or 'p' Paste X into buffer
  257.          i = 1
  258.          PasteStr = Fixit(1)  // pretty up the string
  259.          While PasteStr[i] == chr(32) and i < MaxField// find first non space
  260.             i = i + 1
  261.          EndWhile
  262.          PasteStr = SubStr(PasteStr,i,Length(PasteStr))  // trim leading spaces
  263.          InsertText(' '+PasteStr+' ')  // bracket with spaces
  264.          New = True           // assure that next entry is NEW
  265.          EnterFlag = True
  266.          Break
  267.       When 053h, 073h         // 'S' or 's' Clears the stack
  268.          InitRegs()           // zero all values
  269.          UpdateRegs()         // redisplay
  270.       When 01Bh               // Esc pressed, time to quit
  271.          If Not EnterFlag X = Xa EndIf // save current x
  272.          New = True           // assure that next entry is NEW
  273.          EnterFlag = True
  274.          Break          // exit loop. (only way out)
  275.    EndCase
  276. EndLoop                 // end keyboard input
  277.    PopWinClose()        // close the calc window
  278. End
  279.  
  280. /******************************** MAIN ************************************/
  281.  
  282. Proc Main()             // to start will not return any values
  283.  
  284. String OldWordSet[32]
  285.  
  286.    If Not InitFlag      // if vars not previously initiated
  287.       InitRegs()        // init first time in only, regs can retain data
  288.    EndIf
  289.    // Mark current word for import
  290.    If IsBlockMarked() PushBlock() EndIf
  291.    OldWordSet = Set(Wordset,ChrSet("0-9"+Chr(046)))
  292.    If MarkWord()
  293.       GetStr = GetMarkedText()
  294.       UnMarkBlock()
  295.    Else
  296.       GetStr = ''          // if no 'word' marked make string a nul
  297.    EndIf
  298.    PopBlock()              // restore prev marked block
  299.    Set(Wordset,OldWordSet)
  300.    // end get import string
  301.    UpDateDisplay()         // clean up any editor messages left onscreen
  302.    Set(Cursor,Off)         // turn off cursor since it intrudes if under box
  303.    CalcBox()               // draw the window
  304.    UpDateRegs()            // fill the fields
  305.    GetInput()              // enter Input loop
  306.    Set(Cursor,On)          // done - turn cursor back on
  307. End Main
  308.  
  309. /**************************** EOF 'calc.s'*********************************/
  310.  
  311. // <Ctrl centercursor>     ExecMacro('calc')   // my calc button