home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / CALC_PIC.PRG < prev    next >
Encoding:
Text File  |  1991-04-29  |  3.2 KB  |  105 lines
  1. /*
  2.     Program: CALC_PIC()
  3.     System:  GRUMPFISH LIBRARY
  4.     Author:  Greg Lief
  5.     Copyright (c) 1988-90, Greg Lief
  6.     Clipper 5.x Version
  7.     Compile instructions: clipper calcpic /n/w/a
  8.     Enables calculator-style numeric data entry
  9. */
  10.  
  11. //───── begin preprocessor directives
  12.  
  13. #include "inkey.ch"
  14. #include "grump.ch"
  15.  
  16. //───── end preprocessor directives
  17.  
  18. function calc_pic(number, pitcher)
  19. local decplace := 0, key := 0, tnum, maxdecimal, mrow := row(), mcol := col(), ;
  20.       commas := 0, xx
  21. GFSaveEnv()
  22. setcolor(substr(setcolor(), at(',', setcolor())+1))   // sneaky sneaky
  23.  
  24. //───── determine maximum # of decimals based on location of decimal point
  25. maxdecimal := if(at('.', pitcher) > 0, len(pitcher) - at('.', pitcher), 0)
  26.  
  27. /* determine if there are commas in the picture
  28.    clause -- if so, we must account for them
  29. */
  30. if ',' $ pitcher
  31.    //───── loop through picture clause and tally up # of commas
  32.    for xx = 1 to len(pitcher)
  33.       if substr(pitcher, xx, 1) = ','
  34.          commas++
  35.       endif
  36.    next
  37. endif
  38.  
  39. /*
  40.   begin main loop
  41.  
  42.   We simulate an actual read by allowing the following active keys:
  43.   enter,  esc,  ctrl-w,  uparrow, downarrow, pgup, and pgdn
  44.  
  45.   If you want to limit escape from this routine, it is a simple
  46.   matter to remove the desired key values from the next statement
  47. */
  48.  
  49. do while key != K_ENTER .and. key != K_ESC .and. key != K_CTRL_W .and. ;
  50.          key != K_UP .and. key != K_DOWN  .and. key != K_PGUP .and. ;
  51.          key != K_PGDN
  52.    @ mrow, mcol say number picture pitcher
  53.    key := ginkey(0)
  54.    do case
  55.       //───── user pressed a numeric key
  56.       case key > 47 .and. key < 58
  57.          tnum := val(chr(key))             // determine numeric value
  58.          do case
  59.             case number = 0 .and. decplace = 0
  60.                number := tnum
  61.             case number != 0 .and. decplace=0 .and. ;
  62.                           number < 10 ^ (len(pitcher) - maxdecimal - 2 - commas)
  63.                number = number * 10 + tnum
  64.             case decplace > 0 .and. decplace <= maxdecimal     // real number
  65.                number += (tnum / (10 ^ decplace))
  66.                decplace++
  67.          endcase
  68.  
  69.       //───── user pressed hyphen to toggle sign of number
  70.       case key == 45
  71.          number *= -1
  72.  
  73.       case key == K_BS .and. number != 0
  74.          do case
  75.             //───── if number is still an integer, kill least significant digit
  76.             case decplace = 0
  77.                number := int(number / 10)
  78.             *** if we are at one decimal place, change number to integer
  79.             case decplace = 2
  80.                decplace := 0
  81.                number := int(number)
  82.             otherwise
  83.                decplace--
  84.                number := ltrim(str(number, 16, decplace))
  85.                number := val(substr(number, 1, len(number) - 1))
  86.          endcase
  87.  
  88.       //───── user pressed period to set the decimal point
  89.       case key == 46 .and. decplace == 0 .and. maxdecimal > 0
  90.          decplace := 1
  91.  
  92.    endcase
  93. enddo
  94.  
  95. //───── must stuff last keypress into buffer so it will be acted upon properly
  96. keyboard chr(key)
  97.  
  98. GFRestEnv()
  99. return pitcher
  100.  
  101. * end function Calc_Pic()
  102. *--------------------------------------------------------------------*
  103.  
  104. * eof calc_pic.prg
  105.