home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / CALC_SRC.ZIP / CALC.INC < prev    next >
Text File  |  1993-08-10  |  10KB  |  283 lines
  1. // Monday, 9 August 1993
  2. /************************************************************************/
  3. /*                   Calculator helper functions                        */
  4. /************************************************************************/
  5. Proc InitRegs()
  6.  
  7.    x = ZeroExtended        //<-----+
  8.    y = ZeroExtended        //      |
  9.    z = ZeroExtended        //      |
  10.    t = ZeroExtended        //      |-- Init vars
  11.    Xa = ZeroExtended       //      |
  12.    LastX = ZeroExtended    //      |
  13.    Temp = ZeroExtended     //<-----+
  14.    If NOT InitFlag   // when called to clear stack, don't change 'fixed' value.
  15.       If GetGlobalInt('hpcalc') Fixed = GetGlobalInt('hpcalc') EndIf
  16.    EndIf
  17.    InitFlag = true      // we're loaded...
  18. End InitRegs
  19. //-------------------------------------------------------------------------
  20. Proc ClrXYZT(Integer y)       // Used to clear info from register fields
  21.    Vgotoxy(XX-MaxField,y)     // on screen when being updated with new
  22.    PutLine('',MaxField)       // data.
  23. End ClrXYZT
  24. //-------------------------------------------------------------------------
  25. String Proc FixIt(Integer switch)   // get pretty format for output
  26.    String tmp[MaxField+3]
  27.  
  28.    Case Switch
  29.       When 1 tmp = FStr(X,MaxField,Fixed)
  30.       When 2 tmp = FStr(Y,MaxField,Fixed)
  31.       When 3 tmp = FStr(Z,MaxField,Fixed)
  32.       When 4 tmp = FStr(T,MaxField,Fixed)
  33.    EndCase
  34.    Return(tmp)
  35. End FixIt
  36. //-------------------------------------------------------------------------
  37. Proc UpDateRegs()    // update display to new values of registers
  38.  
  39.    String Field[MaxField+3]
  40.  
  41.    ClrXYZT(Xy)                // update x
  42.    Field = FixIt(1)
  43.    Vgotoxy(XX-Length(Field),xy)
  44.    PutLine(Field,Length(Field))
  45.    ClrXYZT(Yy)                // update y
  46.    Field = FixIt(2)
  47.    Vgotoxy(XX-Length(Field),Yy)
  48.    PutLine(Field,Length(Field))
  49.    ClrXYZT(Zy)                // update z
  50.    Field = FixIt(3)
  51.    Vgotoxy(XX-Length(Field),Zy)
  52.    PutLine(Field,Length(Field))
  53.    ClrXYZT(Ty)                // update t
  54.    Field = FixIt(4)
  55.    Vgotoxy(XX-Length(Field),Ty)
  56.    PutLine(Field,Length(Field))
  57. End UpdateRegs
  58. //-------------------------------------------------------------------------
  59. Proc Fix()     // fix number of _DISPLAYED_ decimal places
  60.    Integer key
  61.  
  62.    If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  63.    OpFlag = True
  64.    New = True
  65.    Vgotoxy(XX-MaxField,xy)
  66.    PutLine('Fix [0..9]',MaxField)
  67.    key = GetKey() & 0FFh
  68.    Case key
  69.       When 30h..39h     // number 0..9
  70.          Vgotoxy(XX-1,xy)
  71.          Fixed = Val(Chr(Key))
  72.          PutLine(Format(Fixed,1),1)
  73.          Delay(4)
  74.          UpdateRegs()
  75.       When 01Bh         // When Esc do nothing
  76.          UpdateRegs()
  77.       Otherwise
  78.          Fix()          // recurse until 0..9 or Esc
  79.    EndCase
  80. End Fix
  81. //-------------------------------------------------------------------------
  82. Proc Math(Integer Op)
  83.  
  84.    If Not EnterFlag X = Xa EndIf // number not <Enter>ed
  85.    LastX = X   // always update Last X
  86.  
  87.    Case Op
  88.       When 1
  89.          If FSub(ZeroExtended,x) == Y
  90.             X = ZeroExtended
  91.          Else
  92.             X = FAdd(y,x) // call the add function
  93.          EndIf
  94.       When 2
  95.          If Y == X
  96.             X = ZeroExtended
  97.          Else
  98.             X = FSub(y,x) // call the Subtract function
  99.          EndIf
  100.       When 3
  101.          If Y == ZeroExtended or X == ZeroExtended
  102.             X = ZeroExtended
  103.          Else
  104.             X = FMul(y,x) // call the Multiply function
  105.          EndIf
  106.       When 4
  107.          If Y == ZeroExtended
  108.             X = ZeroExtended
  109.          Else
  110.             X = FDiv(y,x) // call the Divide function
  111.          EndIf
  112.    EndCase
  113.    If Not FMathError             // no errors
  114.       Xa = X                     // force accumulator and X to match
  115.       Y = Z                      // swap
  116.       Z = T                      //   the
  117.       UpdateRegs()               // redisplay registers
  118.       EnterFlag = True           // Enter/Op
  119.       New = True                 // any further entry is new
  120.       OpFlag = True
  121.    Else                          // announce error
  122.       Vgotoxy(XX-MaxField,xy)    // locate for output
  123.       PutLine('ERROR',MaxField)  // Error Trap
  124.       Delay(18)                  // pause for a bit
  125.       X = LastX                  // assume 'X' destroyed
  126.       UpdateRegs()               // recover from LastX reg
  127.       EnterFlag = True           // recover to a stable status
  128.       New = True                 // ready for new input
  129.    EndIf
  130. End Math
  131. //-------------------------------------------------------------------------
  132. Proc ShiftStat()
  133.    Xa = X            // force accumulator to match X
  134.    New = True        // ready for new input
  135.    OpFlag = True     // last function was an operation
  136. End ShiftStat
  137. //-------------------------------------------------------------------------
  138. Proc  ShiftUp()      // swap regs up
  139.    Temp  =  T
  140.    T     =  Z
  141.    Z     =  Y
  142.    Y     =  X
  143.    X     =  Temp
  144.    UpdateRegs()
  145.    ShiftStat()
  146. End ShiftUp
  147. //-------------------------------------------------------------------------
  148. Proc  ShiftDn()      // swap regs down
  149.    Temp  =  X
  150.    X     =  Y
  151.    Y     =  Z
  152.    Z     =  T
  153.    T     =  Temp
  154.    UpdateRegs()
  155.    ShiftStat()
  156. End ShiftDn
  157. //-------------------------------------------------------------------------
  158. Proc  SwapXY()       // swap x and y registers
  159.    Temp  =  X
  160.    X     =  Y
  161.    Y     =  Temp
  162.    UpdateRegs()
  163.    ShiftStat()
  164. End SwapXY
  165. //-------------------------------------------------------------------------
  166. Proc LstX()          // recall last X entry
  167.    EnterFlag = True
  168.    New = True
  169.    ShiftUp()
  170.    X  =  LastX
  171.    UpdateRegs()
  172. End LstX
  173. //-------------------------------------------------------------------------
  174. Proc Clx()           // clear X value, ready for new entry
  175.    X = ZeroExtended
  176.    UpdateRegs()
  177.    Input = ''
  178.    Xa = X
  179.    New = True
  180.    OpFlag = False
  181. End Clx
  182. //-------------------------------------------------------------------------
  183. Proc OpTest()     // test for last action = operation, handle accordingly
  184.  
  185.    If OpFlag
  186.       ShiftUp()
  187.       OpFlag = False
  188.    EndIf
  189. End OpTest
  190. //-------------------------------------------------------------------------
  191. Proc BinHex(Integer MyBase)   // display X value as Hex or Binary
  192.  
  193.    String
  194.       Tmp[MaxField+3] = FStr(X,MaxField,0),
  195.       Base[1]
  196.    Integer
  197.       Convert = Val(SubStr(Tmp,1,Pos('.',Tmp)))
  198.  
  199.    HelpFlag = True
  200.    OpFlag = True
  201.    New = true
  202.    If MyBase == 16 Base = 'h' EndIf
  203.    If MyBase == 2  Base = 'b' EndIf
  204.    VGotoXY(XX-MaxField,Xy)
  205.    PutLine(format(Convert:MaxField-1:'0':MyBase,Base:1),MaxField)
  206.    Repeat until keypressed()           // keep waiting for a keypress
  207.    UpdateRegs()                  // update regs - completes partial ops
  208. End BinHex
  209.  
  210. /**************************** Help Screen *******************************/
  211.  
  212. Proc CalcHelp()      // minimum help.
  213.  
  214.    Integer
  215.       OldAttr = Set(Attr,Query(MenuTextAttr))
  216.  
  217.    HelpFlag = True   // let GetInput know to trap keys entered here.
  218.    PopWinOpen(1,1,42,20,1,'Calculator Help',Query(MenuBorderAttr))
  219.    VgotoXY(1,1)
  220.    ClrScr()
  221.    /* Put help text in help box */
  222.    VgotoXY(1,2)                              // get video cursor in box
  223.    PutLine('    Active functions are highlighted    ',40)
  224.    VgotoXY(1,4)
  225.    PutLine('Last X  XY   RollUp   RollDn  Fix',40)
  226.    VgotoXY(1,6)
  227.    PutLine('Hex or Binary display of X Register',40)
  228.    VgotoXY(1,8)
  229.    PutLine('Backspace: Clear X register, Rt to Lt.',40)
  230.    VgotoXY(1,10)
  231.    PutLine('Delete: Clear X, Clear Stack, % Percent',40)
  232.    VgotoXY(1,12)
  233.    PutLine('+ Add  - Subtract  * Multiply  / Divide',40)
  234.    VgotoXY(1,14)
  235.    PutLine('Enter: Adjust stack and place X in Y',40)
  236.    VgotoXY(1,16)
  237.    PutLine('Paste X into Current edit buffer',40)
  238.    VgotoXY(1,18)
  239.    PutLine('Get number under cursor into X register',40)
  240.    /* Highlight the hotkeys */
  241.    VGotoXY(1,4)
  242.    PutAttr(Query(MenuTextLtrAttr),1)   //LastX
  243.    VGotoXY(10,4)
  244.    PutAttr(Query(MenuTextLtrAttr),2)   // x<>y
  245.    VGotoXY(15,4)
  246.    PutAttr(Query(MenuTextLtrAttr),1)   // rollup
  247.    VGotoXY(25,4)
  248.    PutAttr(Query(MenuTextLtrAttr),1)   // rolldn
  249.    VGotoXY(35,4)
  250.    PutAttr(Query(MenuTextLtrAttr),1)   // fix decimals
  251.    VGotoXY(3,6)
  252.    PutAttr(Query(MenuTextLtrAttr),1)   // hex
  253.    VGotoXY(8,6)
  254.    PutAttr(Query(MenuTextLtrAttr),1)   // binary
  255.    VGotoXY(1,8)
  256.    PutAttr(Query(MenuTextLtrAttr),9)   // backspace
  257.    VGotoXY(1,10)
  258.    PutAttr(Query(MenuTextLtrAttr),6)   // delete
  259.    VGotoXY(24,10)
  260.    PutAttr(Query(MenuTextLtrAttr),1)   // Clear stack
  261.    VGotoXY(31,10)
  262.    PutAttr(Query(MenuTextLtrAttr),1)   // %
  263.    VGotoXY(1,12)
  264.    PutAttr(Query(MenuTextLtrAttr),1)   // +
  265.    VGotoXY(8,12)
  266.    PutAttr(Query(MenuTextLtrAttr),1)   // -
  267.    VGotoXY(20,12)
  268.    PutAttr(Query(MenuTextLtrAttr),1)   // *
  269.    VGotoXY(32,12)
  270.    PutAttr(Query(MenuTextLtrAttr),1)   // '/'
  271.    VGotoXY(1,14)
  272.    PutAttr(Query(MenuTextLtrAttr),5)   // Enter
  273.    VGotoXY(1,16)
  274.    PutAttr(Query(MenuTextLtrAttr),1)   // Enter
  275.    VGotoXY(1,18)
  276.    PutAttr(Query(MenuTextLtrAttr),1)   // Enter
  277.    Repeat until keypressed()           // keep waiting for a keypress
  278.    Set(Attr,OldAttr)                   // restore previous attr
  279.    PopWinClose()                 // close up the box
  280.    UpdateRegs()                  // update regs - completes partial ops
  281. End CalcHelp
  282.  
  283. /*************************** EOF 'calc.inc' *****************************/