home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST912.PRG < prev    next >
Encoding:
Text File  |  1989-08-08  |  12.9 KB  |  496 lines
  1. *******************
  2.  
  3. PROCEDURE Pop_calc
  4.  
  5.    PARAMETERS p, l, v
  6.  
  7.    IF EMPTY(PCOUNT())
  8.       p = ""
  9.       l = ""
  10.       v = ""
  11.    ENDIF
  12.    
  13.    IF TYPE("_invals") = "U"
  14.       PUBLIC _invals, _lastval, _lastop, _thisval, _thisop, _isnegative
  15.       PUBLIC _mode, _total, _qwert
  16.       IF MEMORY(0) >= 12
  17.          PUBLIC _ticker[50]
  18.          AFILL(_ticker, "")
  19.       ENDIF
  20.       STORE "" TO _invals
  21.       STORE 0 TO _lastval, _lastop, _thisval, _thisop
  22.       STORE .F. to _isnegative
  23.       STORE 1 TO _mode
  24.       IF !EMPTY(v)
  25.          _total = &v.
  26.       ELSE
  27.          _total = ""
  28.       ENDIF
  29.    ENDIF
  30.  
  31.    IF TYPE("scrcursor") = "U"
  32.       scrcursor = .T.
  33.    ENDIF
  34.  
  35.    PRIVATE _poprow, _popcol, _curcol, _temp, _ocolor, _jb, _putitback
  36.  
  37.    _temp = ""
  38.    _putitback = ""
  39.    _chandle  = FOPEN("\CALC.POS", 2)
  40.    IF _chandle > 0    && the file exists
  41.       _ccct = SPACE(4)
  42.       _ctemp = FREAD(_chandle, @_ccct, 4)
  43.       _poprow= VAL(SUBSTR(_ccct, 1, 2))
  44.       _popcol= VAL(SUBSTR(_ccct, 3))
  45.       FCLOSE(_chandle)
  46.    ELSE
  47.       _poprow = 1
  48.       _popcol = IF(COL() <= 35, 45, 1)
  49.    ENDIF
  50.  
  51.    IF TYPE("scrcursor") = "U"
  52.       scrcursor = .T.
  53.    ENDIF
  54.  
  55.    SET KEY ASC("=") TO _Force13
  56.  
  57.    _calcol = SETCOLOR()
  58.    SET CURSOR OFF
  59.    DO WHILE .T.
  60.       BEGIN SEQUENCE
  61.       Windowpush(_poprow,_popcol,_poprow+15, _popcol + 28,"","","","","","",.T.)
  62.       _jb = .F.
  63.       _ocolor = SETCOLOR()
  64.       POPCALC1()                                   && This is the display
  65.       _one13 = .F.
  66.       KEYBOARD "+"
  67.       POPIT()
  68.       EXIT
  69.       END
  70.       Windowpop()
  71.    ENDDO
  72.    Windowpop()
  73.    SET KEY ASC("=") TO 
  74.    SETCOLOR(_calcol)
  75.    SET CURSOR (scrcursor)
  76.  
  77. *******************
  78.  
  79. PROCEDURE _Force13
  80.  
  81.    KEYBOARD CHR(13)
  82.  
  83. *******************
  84.  
  85. PROCEDURE Popit
  86.  
  87.    DO WHILE .T.
  88.       _oldkey = LASTKEY()
  89.       _keypress = INKEY(0)
  90.       IF _keypress = 27
  91.          IF !EMPTY(_putitback)
  92.             KEYBOARD _putitback + CHR(1)
  93.          ENDIF
  94.          EXIT
  95.       ELSEIF _keypress = 28
  96.          Windowpush(WROW(1),WCOL(2),WROW(1)+12,WCOL(2)+23,"","","","","","",.T.)
  97.          Wsayget( 1,2,"INS - Dragging")
  98.          Wsayget( 2,2,"ENTER once for =")
  99.          Wsayget( 3,2,"      twice to store")
  100.          Wsayget( 4,2,"ESC - To Exit")
  101.          Wsayget( 6,2,"This does not support")
  102.          Wsayget( 7,2,"     HEX math.")
  103.          Wsayget( 9,2,"  T - Show Tape")
  104.          Wsayget(11,2,"<<any key to return>>")
  105.          INKEY(0)
  106.          Windowpop()
  107.  
  108.       ELSEIF _keypress = 22
  109.          POPCALDRAG()
  110.       ELSEIF _keypress = 13
  111.          IF _one13
  112.             IF TYPE(v) = "N"
  113.                _putitback = STRVALUE(_total)
  114.             ELSEIF TYPE(v) = "C"
  115.                _putitback = STRVALUE(_total)
  116.             ENDIF
  117.             * EXIT
  118.          ELSE
  119.             _one13 = .T.
  120.             KEYBOARD "="
  121.          ENDIF
  122.       ELSEIF _keypress = 19 .OR. _keypress = 8
  123.          _invals = SUBSTR(_invals, 1, LEN(_invals)-1)
  124.          WSAYGET( 2, 4, FILL_OUT(_invals, 20))
  125.  
  126.       ELSEIF CHR(_keypress)$"+=-/*"
  127.          IF CHR(_keypress) = "-"
  128.             IF CHR(_oldkey)$"0123456789."
  129.                POPCALC2()
  130.             ELSE
  131.                POPCALC3()
  132.                is_negative = .T.
  133.             ENDIF
  134.          ELSE
  135.             POPCALC2()
  136.          ENDIF
  137.          IF MEMORY(0) >= 12
  138.             IF !EMPTY(_lastval)
  139.                AINS(_ticker, 1)
  140.                _ticker[1] = TRANSFORM(_qwert, "99999999.99") + "  " + CHR(_keypress)
  141.                IF CHR(_keypress) = "="
  142.                   AINS(_ticker, 1)
  143.                   _ticker[1] = TRANSFORM(_lastval, "99999999.99") + "  TOTAL"
  144.                ENDIF
  145.             ENDIF
  146.          ENDIF
  147.    
  148.       ELSEIF CHR(_keypress)$"Cc"
  149.          WSAYGET( 2, 4, SPACE(20))
  150.          STORE "" TO _invals, _putitback
  151.          STORE 0 TO _lastval, _lastop, _thisval, _thisop, _total
  152.          IF !EMPTY(v)
  153.             _total = &v.
  154.          ENDIF
  155.          STORE .F. to _isnegative
  156.          KEYBOARD "+"
  157.          _one13 = .F.
  158.          IF MEMORY(0) >= 12
  159.             AINS(_ticker, 1)
  160.             _ticker[1] = "CLEARED"
  161.          ENDIF
  162.          _ttcol = SETCOLOR()
  163.          SETCOLOR(_ocolor)
  164.          WSAYGET(03,18, SPACE(6))
  165.          SETCOLOR(_ttcol)
  166.  
  167.       ELSEIF CHR(_keypress)$"Tt"
  168.          IF MEMORY(0) >= 12
  169.             POPTICK()
  170.             POPCALC1()
  171.          ENDIF
  172.    
  173.       ELSEIF CHR(_keypress)$"Ee"
  174.          _one13 = .F.
  175.          WSAYGET( 2, 4, SPACE(20))
  176.          STORE "" TO _invals
  177.    
  178.       ELSEIF CHR(_keypress)$"1234567890."
  179.          _one13 = .F.
  180.          POPCALC3()
  181.    
  182.       ELSEIF CHR(_keypress)$"DHdh"
  183.          POPCALC4()
  184.    
  185.       ELSEIF (_keypress <= -4 .AND. _keypress >= -9) .AND. _mode != 1
  186.          _one13 = .F.
  187. *         IF _lastval = 3
  188.             IF LEN(_invals) # 20
  189.               _invals = _invals + SUBSTR("ABCDEF", ABS(_keypress+3), 1)
  190.               WSAYGET( 2, 4, FILL_OUT(_invals, 20))
  191.             ENDIF
  192. *         ENDIF
  193.    
  194.       ENDIF
  195.    ENDDO
  196.  
  197. *******************
  198.  
  199. PROCEDURE Poptick
  200.  
  201.    _start = 1
  202.    _tend = WDEPTH()
  203.    _oldcol  = SET_COLOR(ATTRIBUTE(_poprow+1, _popcol+1))
  204.    _tickwait = .T.
  205.    Windowpush(_poprow,_popcol,_poprow+15, _popcol + 28,"BLUE","WHITE","","","","",.T.)
  206.    SETCOLOR(SET_COLOR(ATTRIBUTE(24,00)))
  207.    DO WHILE _tickwait
  208.       _panning = 1
  209.       CLEAR_AREA()
  210.       FOR _x = _start TO _start + 11
  211.          IF _x <= LEN(_ticker)
  212.             WSAYGET(_panning, 2, TRANSFORM(_x, "99. ") + _ticker[_x])
  213.             _panning = _panning + 1
  214.          ENDIF
  215.       NEXT
  216.       WSAYGET(14, 2, "Esc to Quit")
  217.       DO WHILE .T.
  218.          _tdummy = INKEY(0)
  219.          IF _tdummy = 27
  220.             _tickwait = .F.
  221.             EXIT
  222.          ELSEIF _tdummy = 28
  223.             Windowpush(WROW(1),WCOL(2),WROW(1)+12,WCOL(2)+23,"","","","","","",.T.)
  224.             WSAYGET( 1,2,"There are up to the")
  225.             WSAYGET( 2,2,"last 50 transactions")
  226.             WSAYGET( 3,2,"on the tape.  The")
  227.             WSAYGET( 4,2,"transactions are in")
  228.             WSAYGET( 5,2,"reverse order.")
  229.             WSAYGET( 6,2,"ESC, PgUp, PgDn are")
  230.             WSAYGET( 7,2,"valid keys.")
  231.             WSAYGET( 9,2,"Press Any key to")
  232.             WSAYGET(10,2,"continue.....")
  233.             INKEY(0)
  234.             Windowpop()
  235.  
  236.          ELSEIF _tdummy = 3
  237.             IF !(LEN(_ticker) < (_start + 11))
  238.                _start = _start + 11
  239.             ENDIF
  240.             EXIT
  241.  
  242.          ELSEIF _tdummy = 18
  243.             IF (_start - 12) > 0
  244.                _start = _start - 11
  245.             ENDIF
  246.             EXIT
  247.  
  248.          ENDIF
  249.       ENDDO
  250.    ENDDO
  251.    Windowpop()
  252.    SETCOLOR(_oldcol)
  253.  
  254. *******************
  255.  
  256. PROCEDURE Popcaldrag
  257.  
  258.    t_row = WROW()
  259.    t_col = WCOL()
  260.    b_row = WROW() + 15
  261.    b_col = WCOL() + 28
  262.    _tttscr = PUSHSCREEN()
  263.    _tts1 = VAL(SUBSTR(allwindows[_tttscr], 1, 2))
  264.    _tts2 = VAL(SUBSTR(allwindows[_tttscr], 4, 2))
  265.    _tts3 = VAL(SUBSTR(allwindows[_tttscr], 7, 2))
  266.    _tts4 = VAL(SUBSTR(allwindows[_tttscr], 10,2))
  267.    DO WHILE .T.
  268.       RESTSCREEN(_tts1, _tts2, _tts3, _tts4, allscreens[_tttscr])
  269.       @ t_row,t_col,b_row,b_col BOX REPLICATE(CHR(177), 8)
  270.       @ t_row,t_col SAY ""
  271.       _whatkey = INKEY(0)
  272.       DO CASE
  273.       CASE _whatkey = 27
  274.          EXIT
  275.       CASE _whatkey = 5
  276.          IF t_row - 1 > - 1
  277.             t_row = t_row - 1
  278.             b_row = b_row - 1
  279.          ENDIF
  280.       CASE _whatkey = 24
  281.          IF b_row + 1 < 25
  282.             t_row = t_row + 1
  283.             b_row = b_row + 1
  284.          ENDIF
  285.       CASE _whatkey = 19
  286.          IF t_col - 1 > 1
  287.             t_col = t_col - 1
  288.             b_col = b_col - 1 
  289.          ENDIF
  290.       CASE _whatkey = 4
  291.          IF b_col + 1 < 79
  292.             b_col = b_col + 1
  293.             t_col = t_col + 1
  294.          ENDIF
  295.       CASE _whatkey = 13
  296.          _poprow      = t_row
  297.          _popcol      = t_col
  298.          _chandle  = FCREATE("\CALC.POS")
  299.          FWRITE(_chandle, TRANSFORM(_poprow, "99")+TRANSFORM(_popcol, "99"), 4)
  300.          FCLOSE(_chandle)
  301.          EXIT
  302.       ENDCASE
  303.    ENDDO
  304.    POPSCREEN()
  305.    BREAK
  306.    
  307. *******************
  308.  
  309. PROCEDURE Popcalc1
  310.  
  311.    SETCOLOR(IF((ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))), "W/B", SETCOLOR()))
  312.    WSAYGET(00, 0, "╔═══════════════════════════╗")
  313.    WSAYGET(01, 0, "║ ╔═══════════════════════╗ ║")
  314.    WSAYGET(02, 0, "║ ║               0.0000  ║ ║")
  315.    WSAYGET(03, 0, "║ ║ Dec                   ║ ║")
  316.    WSAYGET(04, 0, "║ ╚═══════════════════════╝ ║")
  317.    WSAYGET(05, 0, "║─ Hex ─┬─Modes─┬─ Numeric ─║")
  318.    WSAYGET(06, 0, "║       │       │ = 7 8 9 - ║")
  319.    WSAYGET(07, 0, "║ A  B  │  Dec  │           ║")
  320.    WSAYGET(08, 0, "║ F5 F6 │       │ / 4 5 6   ║")
  321.    WSAYGET(09, 0, "║ C  D  │  Hex  │           ║")
  322.    WSAYGET(10, 0, "║ F7 F8 │       │ * 1 2 3 + ║")
  323.    WSAYGET(11, 0, "║ E  F  │  Tpe  │           ║")
  324.    WSAYGET(12, 0, "║ F9 F10│       │  0   .    ║")
  325.    WSAYGET(13, 0, "║───────┴───────┼───────────║")
  326.    WSAYGET(14, 0, "║     CALCIT    │  C  CE   ║")
  327.    WSAYGET(15, 0, "╚═══════════════════════════╝")
  328.  
  329.    IF MEMORY(0) < 12
  330.       WSAYGET(11,12, "   ")
  331.    ENDIF
  332.  
  333.  
  334.    SETCOLOR(IF((ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))), "W/Y", "W+/N"))
  335.  
  336.    WSAYGET( 6,18, "=")
  337.    WSAYGET( 6,26, "-")
  338.  
  339.    WSAYGET( 8, 2, "F5")
  340.    WSAYGET( 8, 5, "F6")
  341.  
  342.    WSAYGET( 8,18, "/")
  343.    
  344.    WSAYGET(10, 2, "F7")
  345.    WSAYGET(10, 5, "F8")
  346.    WSAYGET(10,18, "*")
  347.    WSAYGET(10,26, "+")
  348.  
  349.    WSAYGET(7,11, "D")
  350.    WSAYGET(9,11, "H")
  351.  
  352.    IF MEMORY(0) >= 12
  353.       WSAYGET(11,11, "T")
  354.    ENDIF
  355.  
  356.    WSAYGET(12, 2, "F9")
  357.    WSAYGET(12, 5, "F10")
  358.  
  359.    WSAYGET(14,19, "C")
  360.    WSAYGET(14,23, "E")
  361.    WSAYGET(14,26, "")
  362.    WSAYGET( 3, 4, IF(_mode = 1, "Dec", "Hex"))
  363.  
  364.    SETCOLOR(IF((ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))), "W/RB", REVERSE(SETCOLOR())))
  365.  
  366.    WSAYGET( 2, 4, SPACE(20))
  367.    
  368. *******************
  369.  
  370. PROCEDURE Popcalc2
  371.  
  372.    IF TYPE("_isnegative") = "U"
  373.       _isnegative = .F.
  374.    ENDIF
  375.    _thisval = IF(_isnegative, -1 * VAL(_invals), VAL(_invals))
  376.    IF CHR(_keypress)="+"
  377.       _ttcol = SETCOLOR()
  378.       SETCOLOR(_ocolor)
  379.       WSAYGET(03,18, "Add   ")
  380.       SETCOLOR(_ttcol)
  381.       _thisop = 1
  382.    ELSEIF CHR(_keypress)="-"
  383.       _ttcol = SETCOLOR()
  384.       SETCOLOR(_ocolor)
  385.       WSAYGET(03,18, "Minus ")
  386.       SETCOLOR(_ttcol)
  387.       _thisop = 2
  388.    ELSEIF CHR(_keypress)="/"
  389.       _ttcol = SETCOLOR()
  390.       SETCOLOR(_ocolor)
  391.       WSAYGET(03,18, "Divide")
  392.       SETCOLOR(_ttcol)
  393.       _thisop = 3
  394.    ELSEIF CHR(_keypress)="*"
  395.       _ttcol = SETCOLOR()
  396.       SETCOLOR(_ocolor)
  397.       WSAYGET(03,18, "Multi.")
  398.       SETCOLOR(_ttcol)
  399.       _thisop = 4
  400.    ENDIF
  401.    _LASTFUNC()
  402.  
  403.    IF CHR(_keypress)="="
  404.       _ttcol = SETCOLOR()
  405.       SETCOLOR(_ocolor)
  406.       WSAYGET(03,18, "Equals")
  407.       SETCOLOR(_ttcol)
  408.       _total = _lastval
  409.       WSAYGET( 2, 4, FILL_OUT(LTRIM(TRIM(STR(_lastval))), 20))
  410.       STORE "" TO _invals
  411. *      STORE 0 TO _lastval, _lastop, _thisval, _thisop
  412. *      STORE .F. to _isnegative
  413. *      KEYBOARD "+"
  414.    ELSE
  415.       STORE "" TO _invals
  416.       _jb = .T.
  417.    ENDIF
  418.    
  419. *******************
  420.  
  421. PROCEDURE _Lastfunc
  422.  
  423.    IF !EMPTY(_lastop) .AND. !EMPTY(_thisval)
  424.       DO CASE
  425.       CASE _lastop = 1
  426.          _temp = _lastval + _thisval
  427.       CASE _lastop = 2
  428.          _temp = _lastval - _thisval
  429.       CASE _lastop = 3
  430.          _temp = _lastval / _thisval
  431.       CASE _lastop = 4
  432.          _temp = _lastval * _thisval
  433.       ENDCASE
  434.       _qwert = _thisval
  435.       _lastval = _temp
  436.       _thisval = 0
  437.       * perform last operation on _lastval and _thisval,
  438.       * move results to _lastval, clear _thisval, and move _thisop 
  439.       * to _lastop
  440.    ELSEIF !EMPTY(_lastop)
  441.       _lastval = _thisval
  442.    ENDIF
  443.    _lastop = _thisop
  444.    _thisop = 0
  445.    
  446. *******************
  447.  
  448. PROCEDURE Popcalc3
  449.  
  450.    IF _mode = 1 .OR. _mode = 3
  451.       IF _mode = 3 .AND. CHR(_keypress) = "."
  452.          RETURN
  453.       ENDIF
  454.       IF _jb
  455.          _jb = .F.
  456.          WSAYGET( 2, 4, SPACE(20))
  457.       ENDIF
  458.       IF LEN(_invals) # 20
  459.          _invals = _invals + CHR(_keypress)
  460.          WSAYGET( 2, 4, FILL_OUT(_invals, 20))
  461.       ENDIF
  462.    ENDIF
  463.    
  464. *******************
  465.    
  466. PROCEDURE Popcalc4
  467.    
  468.    IF CHR(_keypress)$"Dd"
  469.       _amode = 1
  470.    ELSEIF CHR(_keypress)$"Hh"
  471.       _amode = 3
  472.    ENDIF
  473.  
  474.    IF _mode = 1      && Decimal mode
  475.       IF _amode = 3
  476.          _invals = DECIHEXI( _invals ) 
  477.          _invals = IF(_invals = "0", "", _invals)
  478.       ENDIF
  479.    ELSE                && Hex mode
  480.       IF _amode = 1
  481.          _invals = HEXIDECI(_invals)
  482.       ENDIF
  483.    ENDIF
  484.    _mode = _amode
  485.    _memocolor = SETCOLOR()
  486.    SETCOLOR(IF((ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))), "W/Y", REVERSE(SETCOLOR())))
  487.  
  488.    WSAYGET( 3, 4, IF(_mode = 1, "Dec", IF(_mode = 2, "Bin", "Hex")))
  489.  
  490.    SETCOLOR(_memocolor)
  491.    _invals = IF(TYPE("_invals")="N", IF(EMPTY(_invals), "", LTRIM(STR(_invals))), _invals)
  492.    WSAYGET( 2, 4, FILL_OUT(_invals, 20))
  493.   
  494. * End of File
  495.  
  496.