home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / CALC_SRC.ZIP / FPCALC.S < prev    next >
Text File  |  1993-07-08  |  19KB  |  447 lines
  1. /*
  2.                           Thursday, 8 July 1993
  3. */
  4. /**************************************************************************/
  5. #INCLUDE 'fp_min.s'  // include minimum floating point lib (reduces mac size 350 bytes)
  6. /******************* Global Constants and Variables ***********************/
  7.    Constant
  8.       MaxField = 17,       // max size of input field
  9.       FieldX   = 6,        // horiz location of start of field
  10.       FieldY   = 2         // verticle location of field
  11.  
  12.    String
  13.       x[IEEE],                // entry = accumulator
  14.       y[IEEE],                // prev entry
  15.       Input[MaxField+3] = '', // keyboard input accumulator
  16.       GetStr[MaxField+3] = '' // Word under cursor
  17.  
  18.    Integer
  19.       UpLtCol  = 10,    // initial location for calc window
  20.       UpLtRow  = 10,    // initial location for calc window
  21.       BotRtCol = 34,    // initial location for calc window - UpLtCol+24
  22.       BotRtRow = 15,    // initial location for calc window - UpLtRow+5
  23.       Fixed    =  4,
  24. // Booleans
  25.       New      = True,  // Flags NEW input
  26.       InitFlag = False, // flag to initiate vars on firs load only
  27.       HelpFlag = False, // remember to trap keypress when back from help
  28. // Math flags
  29.       Add      = False,    // <----+
  30.       Subtract = False,    //      | flags to control DoMath()
  31.       Multiply = False,    //      | when "=" key is pressed
  32.       Divide   = False,    //      |
  33.       Percent  = False     // <----+
  34.  
  35.  
  36. /************************************************************************/
  37. /*                   Calculator helper functions                        */
  38. /************************************************************************/
  39. Proc InitRegs()      // initiate variable initial values
  40.    x = ZeroExtended  // type defined in fp.s (or fp_min.s)
  41.    y = ZeroExtended  // type defined in fp.s (or fp_min.s)
  42.    If GetGlobalInt('fpcalc')
  43.       Fixed = GetGlobalInt('fpcalc')   // changes default number of decimals
  44.    EndIf
  45.    InitFlag = true   // we're loaded...
  46. End InitRegs
  47. //-------------------------------------------------------------------------
  48. Proc ClrField()      // Used to clear numbers from field
  49.    Vgotoxy(FieldX,FieldY)  // on screen when being updated with new
  50.    PutLine(' ',MaxField-1) // data.
  51. End ClrField
  52. //-------------------------------------------------------------------------
  53. Proc UpdateField()   // update display
  54.    String Field[MaxField+3] = FStr(X,MaxField,Fixed) // convert to string
  55.  
  56.    ClrField()                       // clear the display
  57.    Vgotoxy(FieldX,FieldY)           // set up for output
  58.    PutLine(Field,Length(Field))     // display the number
  59. End UpdateField
  60. //-------------------------------------------------------------------------
  61. Proc Fix()     // fix number of _DISPLAYED_ decimal places
  62.    Integer key
  63.  
  64.    Vgotoxy(FieldX,FieldY)
  65.    PutLine('Fix [0..9]',MaxField)   // prompt for places
  66.    key = GetKey() & 0FFh            // get the key value
  67.    Case key
  68.       When 30h..39h                 // number 0..9
  69.          Vgotoxy(FieldX+MaxField-1,FieldY)
  70.          Fixed = Val(Chr(Key))      // set the new value
  71.          PutLine(Format(Fixed,1),1) // display it
  72.          Delay(4)                   // delay a bit
  73.          UpdateField()              // refresh the display field
  74.       When 01Bh         // When Esc
  75.          UpdateField()  //  update display and do nothing
  76.       Otherwise
  77.          Fix()          // recurse until 0..9 or Esc
  78.    EndCase
  79. End Fix
  80. //-------------------------------------------------------------------------
  81. Proc DoMath(Integer Chain)  // Do the math - chain indicates cumlative math
  82.  
  83.    String LastX[IEEE] = X
  84.  
  85.    If Add
  86.       If FSub(ZeroExtended,x) == Y  // if = 0 (-1 + 1) else FAdd returns error
  87.          X = ZeroExtended           //  just zero it out
  88.       Else
  89.          X = FAdd(y,x)  // call the add function
  90.       EndIf
  91.       Add = False       // done
  92.    ElseIf Subtract
  93.       If Y == X                     // if = 0 (1 - 1) else FSub returns error
  94.          X = ZeroExtended           //  just zero it out
  95.       Else
  96.          X = FSub(y,x)  // call the Subtract function
  97.       EndIf
  98.       Subtract = False  // done
  99.    ElseIf Multiply
  100.       If Y == ZeroExtended or X == ZeroExtended // if=0 (1*0,0*1) FMul returns
  101.          X = ZeroExtended                       //  an error so zero it out
  102.       Else
  103.          X = FMul(y,x)  // call the Multiply function
  104.       EndIf
  105.       Multiply = False  // done
  106.    ElseIf Divide
  107.       If Y == ZeroExtended // if legal 0/1 FDiv returns error (1/0 is error)
  108.          X = ZeroExtended  //  so avoid error
  109.       Else
  110.          X = FDiv(y,x)  // call the Divide function
  111.       EndIf
  112.       Divide = False    // done
  113.    ElseIf Percent
  114.       If Y == ZeroExtended // if legal 0/1 FDiv returns error (1/0 is error)
  115.          X = ZeroExtended  //  so avoid error
  116.       Else
  117.          X = FMul(y,FDiv(x,FVal('100')))  // do X percentage of Y
  118.       EndIf
  119.       Divide = False    // done
  120.    EndIf
  121.    If Not FMathError             // no errors
  122.       Y = X                      // update the accumulator
  123.       If NOT Chain               // if "=" pressed
  124.         UpdateField()              // refresh the display field
  125.       EndIf                      // if chaining don't update display!
  126.       New = True                 // any further entry is new
  127.    Else                          // announce error
  128.       Vgotoxy(FieldX,FieldY)     // locate for output
  129.       PutLine('ERROR',MaxField)  // Error Trap
  130.       Delay(18)                  // pause for a bit
  131.       X = LastX                  // assume 'X' destroyed recover value
  132.       UpdateField()              // restore display
  133.       New = True                 // ready for new input
  134.    EndIf
  135. End DoMath
  136. //-------------------------------------------------------------------------
  137. Proc BinHex(Integer MyBase)   // display X value as Hex or Binary
  138.  
  139.    String
  140.       Tmp[MaxField+3] = FStr(X,MaxField,0),  // fp.bin needs [+3] for results
  141.       Base[1]
  142.    Integer
  143.       Convert = Val(SubStr(Tmp,1,Pos('.',Tmp))) // integer portion only!
  144.  
  145.    HelpFlag = True   // make use of this flag to throw away next key
  146.    New = true
  147.    If MyBase == 16 Base = 'h' EndIf // set hex base indicator
  148.    If MyBase == 2  Base = 'b' EndIf // set binary base indicator
  149.    VGotoXY(FieldX,FieldY)
  150.    PutLine(format(Convert:MaxField-1:'0':MyBase,Base:1),MaxField) // display
  151.    Repeat until keypressed()           // keep waiting for a keypress
  152.    UpdateField()                       // update regs - completes partial ops
  153. End BinHex
  154. //-------------------------------------------------------------------------
  155. Proc ShadowBox(Integer SwitchOn)    // turn shadow under calc on or off
  156.    If SwitchOn
  157.       PopWinOpen(UpLtCol+1,UpLtRow+1,BotRtCol+1,BotRtRow+1,1,'',Color(Black on Black))
  158.    Else
  159.       PopWinClose()           // turn shadow off
  160.    EndIf
  161. End ShadowBox
  162. //-------------------------------------------------------------------------
  163. Proc CalcBox(Integer Open) // place the calculator display on the screen
  164.                            // or turn it off
  165.    Integer
  166.       OldAttr
  167.  
  168.    If Open
  169.       PopWinOpen(UpLtCol,UpLtRow,BotRtCol,BotRtRow,1,'Decimal Calculator',Query(MenuBorderAttr))
  170.       VgotoXY(1,1)                              // get video cursor in box
  171.       OldAttr = Set(Attr,Query(MenuTextAttr))   // set color to match menus
  172.       clrscr()                                  // clear box
  173.       VgotoXY(1,FieldY+2)                       // locate for help line
  174.       PutLine('Esc to Exit, H for help',23)     // short help
  175.       Set(Attr,Query(TextAttr))  // set the attribute to reg edit screen
  176.       ClrField()
  177.    Else
  178.       PopWinClose()  // all done, close window
  179.    EndIf
  180. End CalcBox
  181. //-------------------------------------------------------------------------
  182. Proc MoveBox(integer LtRt, integer UpDn)  // move the box around the screen
  183.  
  184.    /* if movement is legal (on screen) */
  185.    If (UpLtCol + LtRt > 0) AND (UpLtCol + LtRt + 24 < Query(ScreenCols))
  186.       UpLtCol = UpLtCol + LtRt
  187.       BotRtCol = UpLtCol+24
  188.    Else
  189.       Return()    // not a legal move so quit
  190.    EndIf
  191.    /* if movement is legal (on screen) */
  192.    If (UpLtRow + UpDn > 0) AND (UpLtRow + UpDn + 5 < Query(ScreenRows))
  193.       UpLtRow = UpLtRow + UpDn
  194.       BotRtRow = UpLtRow+5
  195.    Else
  196.       Return()    // not a legal move so quit
  197.    EndIf
  198.    CalcBox(Off)            // close the calc window
  199.    ShadowBox(Off)          // erase the shadow
  200.    ShadowBox(On)           // redraw the shadow in new position
  201.    CalcBox(On)             // redraw the window in new position
  202.    UpdateField()           // refill the fields
  203. End MoveBox
  204. /*********************** Temporary help display ***************************/
  205. Proc CalcHelp()      // minimum help.
  206.  
  207.    Integer
  208.       OldAttr = Set(Attr,Query(MenuTextAttr))
  209.  
  210.    HelpFlag = True   // let GetInput know to trap keys entered here.
  211.    PopWinOpen(1,1,42,21,1,'Help',Query(MenuBorderAttr))
  212.    VgotoXY(1,1)
  213.    ClrScr()
  214. /* Put help text in help box */
  215.    VgotoXY(1,2)
  216.    PutLine('Active function keys are hi-lighted.',40)
  217.    VgotoXY(1,5)
  218.    PutLine('Editing:',40)
  219.    VgotoXY(1,6)
  220.    PutLine('Backspace: Delete entry Rt to Lt.',40)
  221.    VgotoXY(1,7)
  222.    PutLine('Delete: Clear entry',40)
  223.    VgotoXY(1,10)
  224.    PutLine('Math:',40)
  225.    VgotoXY(1,11)
  226.    PutLine('+ Add  - Subtract  * Multiply  / Divide',40)
  227.    VgotoXY(1,12)
  228.    PutLine('% Percent  = or GreyEnter: Show result',40)
  229.    VgotoXY(1,15)
  230.    PutLine('Other:',40)
  231.    VgotoXY(1,16)
  232.    PutLine('Get number under cursor into Field',40)
  233.    VgotoXY(1,17)
  234.    PutLine('Paste Field into Current edit buffer',40)
  235.    VgotoXY(1,18)
  236.    PutLine('Fix number of displayed decimals',40)
  237. /* Highlight the hotkeys */
  238.    VGotoXY(1,6)
  239.    PutAttr(Query(MenuTextLtrAttr),9)   // backspace
  240.    VGotoXY(1,7)
  241.    PutAttr(Query(MenuTextLtrAttr),6)   // delete
  242.    VGotoXY(1,11)
  243.    PutAttr(Query(MenuTextLtrAttr),1)   // +
  244.    VGotoXY(8,11)
  245.    PutAttr(Query(MenuTextLtrAttr),1)   // -
  246.    VGotoXY(20,11)
  247.    PutAttr(Query(MenuTextLtrAttr),1)   // *
  248.    VGotoXY(1,12)
  249.    PutAttr(Query(MenuTextLtrAttr),1)   // '%'
  250.    VGotoXY(17,12)
  251.    PutAttr(Query(MenuTextLtrAttr),9)   // 'GreyEnter'
  252.    VGotoXY(12,12)
  253.    PutAttr(Query(MenuTextLtrAttr),1)   // '='
  254.    VGotoXY(32,11)
  255.    PutAttr(Query(MenuTextLtrAttr),1)   // '/'
  256.    VGotoXY(1,16)
  257.    PutAttr(Query(MenuTextLtrAttr),1)   // Get
  258.    VGotoXY(1,17)
  259.    PutAttr(Query(MenuTextLtrAttr),1)   // Paste
  260.    VGotoXY(1,18)
  261.    PutAttr(Query(MenuTextLtrAttr),1)   // Fix
  262. /* wait for key before exiting */
  263.    Repeat until keypressed()           // keep waiting for a keypress
  264.    Set(Attr,OldAttr)                   // restore previous attr
  265.    PopWinClose()                 // close up the box
  266. End CalcHelp
  267. /*********************** Get and display input ****************************/
  268. Proc ShowInput(String s) // ShowInput only used by GetInput()
  269.  
  270.    If New
  271.       ClrField()          // if NEW entry clear field
  272.       InPut = s            // set Input to first char
  273.       New = False          // after first key no longer 'New'
  274.    // check for string length and overflow
  275.    Else
  276.       if Length(Input) < MaxField   // as long as number isn't to long
  277.          Input = Input + s          // tack on next digit
  278.       EndIf                         //  otherwise key is ignored
  279.    EndIf
  280.    If Input[1] == '.' Input = '0'+Input EndIf   // tack on leading '0'
  281.    X = FVal(Input)   // accumulate Real Input
  282.    If FMathError     // traps error condition (see below)
  283.       FmathError = False   // reset error flag
  284.    EndIf
  285.    // The following line traps an error in the FP package that causes
  286.    // a value of 0 to be returned by FVal('0.25') or FVal('0.250')
  287.    If InPut == '0.25' or InPut == '0.250' X = FVal('0.2500') EndIf
  288.    Vgotoxy(FieldX,FieldY)
  289.    PutLine(Format(Input:MaxField),MaxField)  // write the entered data
  290. End ShowInput
  291. //---------------------------
  292. Proc SetOpFlags()
  293.   If (Add|Subtract|Multiply|Divide|Percent)  // if any math pending
  294.     DoMath(TRUE)                             // do the math (chain=true)
  295.   Else                                       // no pending operation
  296.     Y = X
  297.     New = True        // ready for next entry
  298.   EndIf
  299. End SetOpFlags
  300. //---------------------------
  301. Proc GetInput()      // get keyboard input and display it
  302.  
  303.    Integer
  304.       Key,                       // key character value
  305.       NumKey,                    // number value of key
  306.       i                          // scratch counter
  307.  
  308. Loop                 // you're in the loop now, only one way out...
  309.    Repeat until Keypressed()  // keep cycling while waiting for keys
  310.    Key = GetKey()             // get value
  311.    NumKey = Key & 0FFh  // character value of key (or 0 for numpad or 224 for greykeys)
  312.    If HelpFlag                // trap key used to exit help
  313.       Key = 255               // set key to unused value
  314.       NumKey = 0              // set key to unused value
  315.       HelpFlag = False        // ready to accept values or commands
  316.    EndIf
  317.  
  318.    case NumKey                /***** MAIN INPUT *****/
  319.       /***** NUMBER INPUT '0'..'9',A..F,a..f *****/
  320.       When 030h..039h                        // test if [0..9]
  321.          ShowInput(Chr(NumKey))     // display keyed number
  322.       When 2Eh                /***** DECIMAL POINT *****/
  323.          If Not Pos('.', Input) or New // if x doesn't have a decimal yet
  324.             ShowInput('.') // accept it...
  325.          endif             //  otherwise ignore it.
  326.       When 08h                /***** BACKSPACE *****/
  327.          If New InPut = '' EndIf
  328.          If Length(Input)        // as long as it has a length
  329.             Input = SubStr(Input,1,Length(Input)-1)   // remove last char.
  330.             X = FVal(Input)      //  still has a value, update accumulator.
  331.          Else
  332.             X = ZeroExtended     // otherwise zero the accumulator
  333.          EndIf
  334.          ClrField()              // clear the display
  335.          Vgotoxy(FieldX,FieldY)
  336.          PutLine(Format(Input:MaxField),MaxField)
  337.       When 02Bh               /****** ADD(+) *****/
  338.         SetOpFlags()
  339.         Add = True        // ready for '=' key
  340.       When 02Dh               /****** SUBTRACT(-) *****/
  341.         SetOpFlags()
  342.         Subtract = True   // ready for '=' key
  343.       When 02Ah               /***** MULTIPLY(*) *****/
  344.         SetOpFlags()
  345.         Multiply = True   // ready for '=' key
  346.       When 02Fh               /****** DIVIDE(/) *****/
  347.         SetOpFlags()
  348.         Divide = True     // ready for '=' key
  349.       When 025h               /****** Percentage(%) *****/
  350.         SetOpFlags()
  351.         Percent = True     // ready for '=' key
  352.       When 03Dh,0Dh  // '='or 'greyenter' key pressed
  353.          DoMath(FALSE)    //  go do the math - NOT chain calculation
  354.                        /****** SPECIAL KEYS *****/
  355.       When 0, 224             // when number pad arrows or grey arrows
  356.          Case Key shr 8       // test key for extended values
  357.             When 83           // del
  358.                X = ZeroExtended  // zero accumulator
  359.                New = True        // set for new input
  360.                UpdateField()  // clear current entry
  361.             When 115          // ctrl left
  362.                MoveBox(-1,0)  //    move box left
  363.             When 116          // ctrl right
  364.                MoveBox(1,0)   //    move box right
  365.             When 141          // ctrl up
  366.                MoveBox(0,-1)  //    move box up
  367.             When 145          // ctrl dn
  368.                MoveBox(0,1)   //    move box dn
  369.          EndCase
  370.                        /****** LETTER KEYS *****/
  371.       When 042h,062h          // B or b : display binary value
  372.          BinHex(2)
  373.       When 058h,078h          // X or x : display hex value
  374.          BinHex(16)
  375.       When 046h,066h          // F or f : set number displayed decimals
  376.          Fix()
  377.       When 048h, 068h         // 'H' or 'h' calls help
  378.          CalcHelp()
  379.       When 047h, 067h         // 'G' or 'g' get number
  380.          If GetStr == ''
  381.             // do nothing
  382.          Else
  383.          // First work around 'fp' bug...
  384.          If GetStr == '0.25' or GetStr == '0.250' GetStr = '0.2500' EndIf
  385.          FVal(GetStr)
  386.             If FMathError           // string is not a number
  387.                FMathError = False   // reset flag
  388.                // do nothing
  389.             Else
  390.                X = FVal(GetStr)     // it's a number, save it
  391.                UpDateField()        // and display it
  392.             EndIf
  393.          EndIf
  394.       When 050h, 070h         // 'P' or 'p' Paste X into buffer
  395.          i = 1
  396.          GetStr = FStr(X,MaxField,Fixed)
  397.          While GetStr[i] == chr(32) and i < MaxField // find first nonblank pos
  398.             i = i + 1
  399.          EndWhile
  400.          GetStr = SubStr(GetStr,i,Length(GetStr)) // trim leading spaces
  401.          InsertText(' '+GetStr+' ') // paste into text bracketed with spaces
  402.          New = True           // assure that next entry is NEW
  403.          Break
  404.                        /****** ESCAPE KEY *****/
  405.       When 01Bh               // Esc pressed, time to quit
  406.          Y = X                // update
  407.          New = True           // assure that next entry is NEW
  408.          Break                // exit loop return to edit
  409.    EndCase
  410. EndLoop              // End entry loop - back to start
  411. End GetInput
  412. /******************************** MAIN ************************************/
  413.  
  414. Proc Main()          // Startup code FPCalc.s
  415.  
  416.   String OldWordSet[32]
  417.  
  418.    If Not InitFlag         // if first use,
  419.       InitRegs()           // inititilize vars, otherwise retain previous values
  420.    EndIf
  421.    // Mark current word for import
  422.    If IsBlockMarked() PushBlock() EndIf   // save existing block marks
  423.    OldWordSet = Set(Wordset,ChrSet("0-9"+Chr(046))) // just '0..9' and '.'
  424.    If MarkWord()                          // a fp number was markable
  425.       GetStr = GetMarkedText()            // grab it
  426.       UnMarkBlock()                       // unmark word
  427.    Else
  428.       GetStr = ''                         // set string to nil on failure
  429.    EndIf
  430.    If GetStr <> '' PopBlock() EndIf       // restore previous marking
  431.    Set(Wordset,OldWordSet)                // restore wordset
  432.    // end get import string
  433.    UpDateDisplay()         // clean up any editor messages left onscreen
  434.    Set(Cursor,Off)         // turn off cursor since it intrudes if under box
  435.    ShadowBox(On)           // draw the shadow
  436.    CalcBox(On)             // draw the window
  437.    UpdateField()               // fill the fields
  438.    GetInput()              // enter Input loop
  439.    CalcBox(Off)            // close the calc window
  440.    ShadowBox(Off)          // erase the shadow
  441.    Set(Cursor,On)          // done - turn cursor back on
  442. End Main             // Acalc.s
  443.  
  444. /**************************** EOF 'FPcalc.s' *********************************/
  445.  
  446. // <Ctrl centercursor>     ExecMacro('fpcalc')   // my calc button
  447.