home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / POPCALC.PRG < prev    next >
Encoding:
Text File  |  1991-07-02  |  10.7 KB  |  335 lines
  1. /*
  2.     Program: POPCALC.PRG
  3.     System: GRUMPFISH LIBRARY
  4.     Author: Greg Lief
  5.     Copyright (c) 1988-90, Greg Lief
  6.     Clipper 5.x version
  7.     Compile instructions: clipper popcalc /n/w/a
  8.  
  9.     Procs & Fncts: MEMKEYS()
  10.                  : PASTE
  11.                  : PAPER_TAPE()
  12.                  : DRAWCALCBX()
  13.  
  14.             Calls: SHADOWBOX()   (function in $SHADOWB.PRG)
  15.                    CHECKMOVE()   (function in $MOVING.PRG)
  16.  
  17. */
  18.  
  19. //───── begin preprocessor directives
  20.  
  21. #include "grump.ch"
  22. #include "inkey.ch"
  23.  
  24. //───── end preprocessor directives
  25.  
  26. //───── begin global declarations
  27.  
  28. static num := 0, calctop := 5, calcleft := 28, ndecimals := 4
  29. static mpic := '###########.####'   // PICTURE string for displaying numbers
  30. #translate ShowMemKeys() => @ calctop+6, calcleft+2 SAY 'R + -' ;;
  31.                             @ calctop+7, calcleft+2 SAY 'C * /'
  32.  
  33. //───── end global declarations
  34.  
  35.  
  36. function popcalc(gfproc, line, var)
  37. local num1 := 0, mem := 0, decplace := 0, tnum, justcalced := .f., ;
  38.       oldscrn := savescreen(calctop, calcleft, calctop + 12, calcleft + 26), ;
  39.       op := 0, opstr := '+-*/^%', hotkey := 0, key := 0, papertape := .f., ;
  40.       olddecimals := set(_SET_DECIMALS, 4), ;
  41.       maincolor := ColorSet(C_CALCULATOR_BOX, .T.)
  42.  
  43. GFSaveEnv(, 0)         // shut off cursor
  44.  
  45. //───── determine whether this was called via hot-key; if so, disable it
  46. if (gfproc != NIL)
  47.    setkey(hotkey := lastkey(), NIL)
  48. endif
  49.  
  50. /*
  51.   Variables:
  52.  
  53.    NUM  = primary number to be manipulated
  54.    NUM1 = second number when operator has been introduced
  55.    MEM  = stored in memory
  56.    OP   = current operator: 1=add, 2=sub, 3=mult, 4=div, 5=exp
  57.    NDECIMALS= number of decimals to display
  58.    DECPLACE = decimal place counter - if decplace is 0, decimal point
  59.    has not been activated; otherwise indicates # of digits to the right of it
  60.  
  61.    User-configurable color/screen coordinates: Current hot-key to change
  62.    color is Alt-F10, although you can easily change this (see line 236
  63.    below).  Press any arrow key, Home, End, PgUp, PgDn to move window.
  64. */
  65.  
  66. DrawCalcBx()
  67.  
  68. //───── main loop
  69. do while key != K_ESC
  70.  
  71.    //───── display M if there is a number currently in memory
  72.    @ calctop+3, calcleft+21 ssay if(mem != 0, 'M', chr(32))
  73.    @ calctop+3, calcleft+4  say num picture mpic
  74.    setcolor(maincolor)
  75.  
  76.    //───── display 1st number if an operator has been introduced
  77.    if num1 != 0
  78.       @ calctop+1,calcleft+4  say num1 picture mpic
  79.       @ calctop+1,calcleft+21 ssay substr(opstr,op,1)
  80.    else
  81.       @ calctop+1,calcleft+4 ssay space(18)
  82.    endif
  83.  
  84.    key := ginkey(0)
  85.  
  86.    do case
  87.  
  88.       //───── numeric key was pressed
  89.       case key > 47 .and. key < 58
  90.          tnum := val(chr(key))        // determine numeric value
  91.          do case
  92.  
  93.             case (num=0 .or. justcalced) .and. decplace == 0
  94.                num := tnum
  95.                justcalced := .f.
  96.  
  97.             case num != 0 .and. decplace == 0 .and. num < 10000000000 //integer
  98.                num := num * 10 + tnum
  99.  
  100.             case decplace > 0 .and. decplace <= ndecimals    // real number
  101.                num += (tnum / (10 ^ decplace))
  102.                decplace++
  103.  
  104.             case justcalced .and. decplace <= ndecimals
  105.                num := (tnum / (10 ^ decplace))
  106.                justcalced := .f.
  107.  
  108.          endcase
  109.  
  110.          //───── backspace was pressed
  111.       case key == K_BS .and. (num != 0 .or. decplace > 0)
  112.          if decplace == 0              // if number is still an integer
  113.             num := int(num / 10)       // kill the least significant digit
  114.          else
  115.             decplace--
  116.             if decplace > 0
  117.                num := ltrim(str(num, 16, decplace))
  118.                num := val(substr(num, 1, len(num) - 1))
  119.             else
  120.                num := 0
  121.             endif
  122.          endif
  123.  
  124.          //───── decimal point (period) was pressed
  125.       case key == 46 .and. decplace == 0
  126.          decplace++
  127.  
  128.          //───── operator pressed (43='+' 45='-' 42='*' 47='/' 94='^', 37='%')
  129.          //───── with no pending operations
  130.       case (key == 43 .or. key == 45 .or. key == 42 .or.     ;
  131.               key == 47 .or. key == 94 .or. key == 37) .and. ;
  132.               op == 0 .and. num1 == 0
  133.          num1 := num
  134.          num := decplace := 0
  135.          op := at(chr(key), opstr)
  136.          justcalced := .f.
  137.          if papertape
  138.             Paper_Tape(str(num1) + ' ' + substr(opstr, op, 1))
  139.          endif
  140.  
  141.          //───── '=', return or operator was pressed -- perform calculation
  142.       case (key == 61 .or. key == 13 .or. key == 43 .or. key == 45 ;
  143.            .or. key == 42 .or. key == 47 .or. key == 94) .and. op > 0
  144.          if papertape
  145.             Paper_Tape(str(num) + ' ' + substr(opstr, op, 1))
  146.          endif
  147.          do case
  148.             case op == 1            // addition
  149.                num += num1
  150.             case op == 2            // subtraction
  151.                num = num1 - num
  152.             case op == 3            // multiplication
  153.                num *= num1
  154.             case op == 4 .and. num != 0   // division (don't allow by zero)
  155.                num = num1 / num
  156.             case op == 5            // exponent
  157.                num = num1 ^ num
  158.             case op == 6            // percentage
  159.                num = num1 / 100 * num
  160.          endcase
  161.          decplace := 0
  162.          op := at(chr(key), opstr)
  163.          justcalced := .t.
  164.          if op == 0
  165.             num1 := 0
  166.             if papertape
  167.                Paper_Tape(str(num) + ' =')
  168.                Paper_Tape()
  169.             endif
  170.          else
  171.             num1 := num
  172.             num := 0
  173.          endif
  174.  
  175.          //───── 'c' was pressed to clear number
  176.       case key == 67 .or. key == 99
  177.          num := num1 := decplace := op := 0
  178.  
  179.          //───── 'd' was pressed to change decimals
  180.       case key == 68 .or. key == 100
  181.          setcolor('+' + maincolor)
  182.          @ calctop+1, calcleft+2 ssay 'How many decimals?'
  183.          key := ginkey(0)
  184.          scroll(calctop+1, calcleft+2, calctop+1, calcleft+20, 0)
  185.          if key > 47 .and. key < 58
  186.             ndecimals := val(chr(key))
  187.             mpic := replicate('#', 15 - ndecimals) + '.' + ;
  188.                     if(ndecimals > 0, replicate('#', ndecimals), '')
  189.             set(_SET_DECIMALS, ndecimals)
  190.          endif
  191.  
  192.          //───── 'r' was pressed to round number (truncate some decimals)
  193.       case key == 82 .or. key == 114
  194.          setcolor('+' + maincolor)
  195.          @ calctop+1, calcleft+2 ssay 'Decimals to round to?'
  196.          key := ginkey(0)
  197.          scroll(calctop+1, calcleft+2, calctop+1, calcleft+23, 0)
  198.          if (key > 47 .and. key < 58)
  199.             key := val(chr(key))
  200.             if key <= ndecimals
  201.                num := round(num, key)
  202.             endif
  203.          endif
  204.  
  205.          //───── 'e' was pressed to clear entry
  206.       case key == 69 .or. key == 101
  207.          num := decplace := 0
  208.  
  209.          //───── 'p' was pressed for paper-tape function
  210.       case key == 80 .or. key == 112
  211.          papertape := (! papertape)
  212.          @ calctop+3, calcleft+23 ssay if(papertape, 'P', ' ')
  213.          if papertape
  214.             Paper_Tape()
  215.          endif
  216.  
  217.          //───── 'm' was pressed to access memory functions
  218.       case key == 77 .or. key == 109
  219.          setcolor('+*' + maincolor)
  220.          ShowMemKeys()
  221.          key := ginkey(0)  // we need to get another key before taking action
  222.          do case
  223.             case key == 43       // '+' -- add number to memory
  224.                mem += num
  225.             case key == 45       // '-' -- subtract number from memory
  226.                mem -= num
  227.             case key == 42       // '*' -- multiple memory by number
  228.                mem *= num
  229.             case key == 47       // '/' -- divide memory by number
  230.                mem /= num
  231.             case key == 82 .or. key == 114   // 'r' -- recall memory
  232.                num := mem
  233.             case key == 67 .or. key == 99    // 'c' -- clear memory
  234.                mem := 0
  235.          endcase
  236.          setcolor('+' + maincolor)
  237.          ShowMemKeys()
  238.  
  239.       case key == K_ALT_F10   // change color!
  240.          maincolor := ColorPal(maincolor, 16, IF(calcleft > 39, 0, 64))
  241.          //───── if color was changed, redraw calculator box
  242.          if lastkey() != 27
  243.             ColorSet(C_CALCULATOR_BOX, maincolor)
  244.             DrawCalcBx()
  245.          endif
  246.  
  247.       case key < SPACEBAR .and. key != K_ESC
  248.          checkmove(key, 12, 26, @calctop, @calcleft, @oldscrn)
  249.  
  250.    endcase
  251.    ColorSet(C_CALCULATOR_WINDOW)
  252. enddo
  253.  
  254. //───── restore hot-key
  255. if hotkey != 0
  256.    setkey( hotkey, {|p, l, v| popcalc(p, l, v)} )
  257. endif
  258.  
  259. //───── restore previous environment
  260. GFRestEnv()
  261. restscreen(calctop, calcleft, calctop+12, calcleft+26, oldscrn)
  262. set(_SET_DECIMALS, olddecimals)
  263. return NIL
  264.  
  265. * end function PopCalc()
  266. *--------------------------------------------------------------------*
  267.  
  268.  
  269. /*
  270.    Paste() -- paste current calculator value
  271. */
  272. function paste(a, b, c)   // internal Clipper parameters
  273. local get := getactive()
  274. if get != NIL
  275.    if get:type == "N"
  276.       get:varPut(num)
  277.    elseif get:type == "C"
  278.       get:varPut(str(num))
  279.    endif
  280. endif
  281. return NIL
  282.  
  283. * end function Paste()
  284. *--------------------------------------------------------------------*
  285.  
  286.  
  287. /*
  288.    Paper_Tape() -- send calculation to printer
  289. */
  290. static function Paper_Tape(mvar)
  291. default mvar to ''
  292. if isprinter()
  293.    set device to printer
  294.    @ prow()+1,1 say mvar picture mpic
  295.    set device to screen
  296. endif
  297. return NIL
  298.  
  299. * end static function Paper_Tape()
  300. *--------------------------------------------------------------------*
  301.  
  302.  
  303. /*
  304.    DrawCalcBx() -- draw calculator box
  305. */
  306. static function drawcalcbx
  307. ColorSet(C_CALCULATOR_BOX)
  308. shadowbox(calctop, calcleft, calctop+11, calcleft + 24, 3)
  309. SINGLEBOX(calctop+2, calcleft+2, calctop+4, calcleft+22)
  310. @ calctop+5,  calcleft+3 ssay 'emory│'
  311. @ row()+1,    calcleft+2 ssay 'R + - │'
  312. @ row()+1,    calcleft+2 ssay 'C * / │'
  313. @ row()+1,    calcleft+1 ssay replicate(chr(196), 7) + chr(217)
  314. @ row()+1,    calcleft+3 ssay 'lear   rint   c ntry'
  315. @ row()+1,    calcleft+3 ssay 'ound   ecimals'
  316. @ calctop+5,  calcleft+10 ssay '+  7  8  9  -'
  317. @ row()+1,    calcleft+10 ssay '*  4  5  6  /'
  318. @ row()+1,    calcleft+10 ssay '%  1  2  3  ^'
  319. @ row()+1,    calcleft+13 ssay '=  0  .'
  320. ColorSet(C_CALCULATOR_WINDOW)
  321. @ calctop+3,  calcleft+3 ssay space(19)
  322. @ row()+2,    calcleft+2 ssay 'M'
  323. @ row()+4,    calcleft+2 ssay 'C'
  324. @ row(),      col()+6 ssay 'P'
  325. @ row(),      col()+8 ssay 'E'
  326. @ row()+1,    calcleft+2 ssay 'R'
  327. @ row(),      col()+6 ssay 'D'
  328. @ row(),      col()+10 ssay 'Esc'
  329. return NIL
  330.  
  331. * end static function DrawCalcBx()
  332. *--------------------------------------------------------------------*
  333.  
  334. * eof popcalc.prg
  335.