home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a079 / 1.img / FPDG.LZH / VOL2NUM0 / CALC / CALC.PRG < prev    next >
Encoding:
Text File  |  1993-01-11  |  17.6 KB  |  556 lines
  1. *****************************************************************
  2. *     * 07/09/92              CALC.PRG                 06:19:39 *
  3. *****************************************************************
  4. *     * Author's Name: Jeb Long                                 *
  5. *     *                                                         *
  6. *     * Description:                                            *
  7. *     * This program simulates a simple scientific calculator.  *
  8. *     *                                                         *
  9. *****************************************************************
  10. PRIVATE  talkstat, compstat, snumlock
  11.  
  12. IF SET("TALK") = "ON"
  13.     SET TALK OFF
  14.     talkstat = "ON"
  15. ELSE
  16.     talkstat = "OFF"
  17. ENDIF
  18. snumlock = NUMLOCK(.T.)       && Set the NumLock mode ON
  19. compstat = SET("COMPATIBLE")
  20. SET COMPATIBLE FOXPLUS
  21. *
  22. *     Window definitions
  23. *
  24. IF NOT WEXIST("calc")
  25.     DEFINE WINDOW calc ;
  26.         FROM INT((SROW()-20)/2),INT((SCOL()-63)/2) ;
  27.         TO INT((SROW()-20)/2)+19,INT((SCOL()-63)/2)+62 ;
  28.         TITLE "Scientific Calculator" ;
  29.         FLOAT ;
  30.         NOCLOSE ;
  31.         MINIMIZE;
  32.         SHADOW ;
  33.         PANEL ;
  34.         COLOR SCHEME 1
  35. ENDIF
  36. *****************************************************************
  37. *     CALC Setup Code - SECTION 2 
  38. *
  39. acc=0
  40. =RAND(-1)
  41. memory  = 0
  42. results = 0
  43. oldOP = "+"
  44. Decimal = 0
  45. *******************************************************************
  46. *   CALC Screen Layout 
  47. *
  48. IF WVISIBLE("calc")
  49.     ACTIVATE WINDOW calc SAME
  50. ELSE
  51.     ACTIVATE WINDOW calc NOSHOW
  52. ENDIF
  53. *
  54. *****************************************************************
  55. *   Initialize variables
  56. *
  57. @ 1,18 SAY "X"
  58. @ 2,18 SAY "Y"
  59. @ 3,14 SAY "Memory"
  60. DO ShowCalc WITH " "
  61. @ 11,5 GET i0 ;
  62.     PICTURE "@*HN   \<0" ;
  63.     SIZE 1,5,1 ;
  64.     DEFAULT 1  ;
  65.     VALID VNUMBER( 0 )
  66. @ 9,5 GET i1 ;
  67.     PICTURE "@*HN   \<1" ;
  68.     SIZE 1,5,1 ;
  69.     DEFAULT 1  ;
  70.     VALID VNUMBER( 1 )
  71. @ 9,12 GET i2 ;
  72.     PICTURE "@*HN   \<2" ;
  73.     SIZE 1,5,1 ;
  74.     DEFAULT 1  ;
  75.     VALID VNUMBER( 2 )
  76. @ 9,19 GET i3 ;
  77.     PICTURE "@*HN   \<3" ;
  78.     SIZE 1,5,1 ;
  79.     DEFAULT 1  ;
  80.     VALID VNUMBER( 3 )
  81. @ 7,5 GET i4 ;
  82.     PICTURE "@*HN   \<4" ;
  83.     SIZE 1,6,1 ;
  84.     DEFAULT 1  ;
  85.     VALID VNUMBER( 4 )
  86. @ 7,12 GET i5 ;
  87.     PICTURE "@*HN   \<5" ;
  88.     SIZE 1,5,1 ;
  89.     DEFAULT 1  ;
  90.     VALID VNUMBER( 5 )
  91. @ 7,19 GET i6 ;
  92.     PICTURE "@*HN   \<6" ;
  93.     SIZE 1,5,1 ;
  94.     DEFAULT 1  ;
  95.     VALID VNUMBER( 6 )
  96. @ 5,5 GET i7 ;
  97.     PICTURE "@*HN   \<7" ;
  98.     SIZE 1,5,1 ;
  99.     DEFAULT 1  ;
  100.     VALID VNUMBER( 7 )
  101. @ 5,12 GET i8 ;
  102.     PICTURE "@*HN   \<8" ;
  103.     SIZE 1,5,1 ;
  104.     DEFAULT 1  ;
  105.     VALID VNUMBER( 8 )
  106. @ 5,19 GET i9 ;
  107.     PICTURE "@*HN   \<9" ;
  108.     SIZE 1,5,1 ;
  109.     DEFAULT 1  ;
  110.     VALID VNUMBER( 9 )
  111. @ 11,12 GET deci ;
  112.     PICTURE "@*HN   \<." ;
  113.     SIZE 1,5,1 ;
  114.     DEFAULT 1  ;
  115.     VALID VDECIMAL()
  116. @ 11,19 GET equals ;
  117.     PICTURE "@*HN   \<=" ;
  118.     SIZE 1,5,1 ;
  119.     DEFAULT 1  ;
  120.     VALID VEQUAL()
  121. @ 5,26 GET CLEAR ;
  122.     PICTURE "@*HN   \<C" ;
  123.     SIZE 1,5,1 ;
  124.     DEFAULT 1 ;
  125.     VALID VCLEAR()
  126. @ 5,33 GET ACLEAR ;
  127.     PICTURE "@*HN  \<AC" ;
  128.     SIZE 1,6,1 ;
  129.     DEFAULT 1 ;
  130.     VALID VACLEAR("AC")
  131. @ 7,26 GET PLUS ;
  132.     PICTURE "@*HN   \<+" ;
  133.     SIZE 1,5,1 ;
  134.     DEFAULT 1 ;
  135.     VALID VOP("+")
  136. @ 7,33 GET minus ;
  137.     PICTURE "@*HN   \<-" ;
  138.     SIZE 1,5,1 ;
  139.     DEFAULT 1 ;
  140.     VALID VOP("-")
  141. @ 9,26 GET Multiply ;
  142.     PICTURE "@*HN   \<*" ;
  143.     SIZE 1,5,1 ;
  144.     DEFAULT 1  ;
  145.     VALID VOP("*")
  146. @ 9,33 GET divide ;
  147.     PICTURE "@*HN   \</" ;
  148.     SIZE 1,5,1 ;
  149.     DEFAULT 1 ;
  150.     VALID VOP("/")
  151. @ 13,5 GET invert ;
  152.     PICTURE "@*HN   1/x" ;
  153.     SIZE 1,7,1 ;
  154.     DEFAULT 1 ;
  155.     VALID VINVERT()
  156. @ 13,16 GET plusminus ;
  157.     PICTURE "@*HN   +/-" ;
  158.     SIZE 1,7,1 ;
  159.     DEFAULT 1 ;
  160.     VALID VREVERSE()
  161. @ 7,41 GET xasin ;
  162.     PICTURE "@*HN X--Y" ;
  163.     SIZE 1,8,1 ;
  164.     DEFAULT 1 ;
  165.     VALID VXPOSE()
  166. @ 11,26 GET mc ;
  167.     PICTURE "@*HN   MC" ;
  168.     SIZE 1,6,1 ;
  169.     DEFAULT 1 ;
  170.     VALID VMC()
  171. @ 11,33 GET mr ;
  172.     PICTURE "@*HN   MR" ;
  173.     SIZE 1,6,1 ;
  174.     DEFAULT 1 ;
  175.     VALID VMR()
  176. @ 13,26 GET MPLUS ;
  177.     PICTURE "@*HN   M+" ;
  178.     SIZE 1,6,1 ;
  179.     DEFAULT 1 ;
  180.     VALID VMEM("+")
  181. @ 13,33 GET equals ;
  182.     PICTURE "@*HN   M-" ;
  183.     SIZE 1,6,1 ;
  184.     DEFAULT 1 ;
  185.     VALID VMEM("-")
  186. @ 15,32 GET xint ;
  187.     PICTURE "@*HN   Int" ;
  188.     SIZE 1,7,1 ;
  189.     DEFAULT 1 ;
  190.     VALID VFUNC("Int")
  191. @ 15,41 GET xfactor ;
  192.     PICTURE "@*HN   X!" ;
  193.     SIZE 1,6,1 ;
  194.     DEFAULT 1 ;
  195.     VALID VFACT()
  196. @ 5,41 GET sin ;
  197.     PICTURE "@*HN   Sin " ;
  198.     SIZE 1,8,1 ;
  199.     DEFAULT 1 ;
  200.     VALID VFUNC("Sin")
  201. @ 5,51 GET icos ;
  202.     PICTURE "@*HN   Cos " ;
  203.     SIZE 1,8,1 ;
  204.     DEFAULT 1 ;
  205.     VALID VFUNC("COS")
  206. @ 7,51 GET xacos ;
  207.     PICTURE "@*HN   Acos" ;
  208.     SIZE 1,8,1 ;
  209.     DEFAULT 1 ;
  210.     VALID VFUNC("Acos")
  211. @ 9,41 GET xtan ;
  212.     PICTURE "@*HN   Tan " ;
  213.     SIZE 1,8,1 ;
  214.     DEFAULT 1 ;
  215.     VALID VFUNC("Tan")
  216. @ 9,51 GET xatan ;
  217.     PICTURE "@*HN   Atan" ;
  218.     SIZE 1,8,1 ;
  219.     DEFAULT 1 ;
  220.     VALID VFUNC("Atan")
  221. @ 11,41 GET xpi ;
  222.     PICTURE "@*HN   PI " ;
  223.     SIZE 1,8,1 ;
  224.     DEFAULT 1 ;
  225.     VALID VPI()
  226. @ 11,51 GET xlog10 ;
  227.     PICTURE "@*HN  Log10" ;
  228.     SIZE 1,9,1 ;
  229.     DEFAULT 1 ;
  230.     VALID VFUNC("log10")
  231. @ 13,41 GET xexp ;
  232.     PICTURE "@*HN   Exp " ;
  233.     SIZE 1,7,1 ;
  234.     DEFAULT 1 ;
  235.     VALID VFUNC("Exp")
  236. @ 13,51 GET xlog ;
  237.     PICTURE "@*HN    ln " ;
  238.     SIZE 1,8,1 ;
  239.     DEFAULT 1 ;
  240.     VALID VFUNC("log")
  241. @ 15,51 GET xsqrt ;
  242.     PICTURE "@*HN   Sqrt" ;
  243.     SIZE 1,8,1 ;
  244.     DEFAULT 1 ;
  245.     VALID VFUNC("Sqrt")
  246. @ 15,5 GET xrand ;
  247.     PICTURE "@*HN   Rand" ;
  248.     SIZE 1,8,1 ;
  249.     DEFAULT 1 ;
  250.     VALID VRAND()
  251. @ 1,51 GET quit ;
  252.     PICTURE "@*HN   \<Quit" ;
  253.     SIZE 1,8,1 ;
  254.     DEFAULT 1 ;
  255.     VALID VQUIT()
  256.  
  257. IF NOT WVISIBLE("calc")
  258.     ACTIVATE WINDOW calc
  259. ENDIF
  260.  
  261. READ CYCLE
  262.  
  263. RELEASE WINDOW calc
  264.  
  265. IF talkstat = "ON"
  266.     SET TALK ON
  267. ENDIF
  268. IF compstat = "ON"
  269.     SET COMPATIBLE ON
  270. ENDIF
  271. = numlock(snumlock)
  272. RETURN
  273.  
  274. *****************************************************************
  275. *         VCLEAR               CLEAR VALID                      *
  276. *                                                               *
  277. *         Function Origin:                                      *
  278. *           Variable:          VCLEAR                           *
  279. *           Called By:         VALID Clause                     *
  280. *           Object Type:       Push Button                      *
  281. *                                                               *
  282. *****************************************************************
  283. *
  284. FUNCTION VCLEAR     &&  CLEAR VALID
  285. = VACLEAR("C") 
  286. Results = 0
  287. oldOP = "+"
  288. do ShowCalc with "Clear"
  289. return .t.
  290. *****************************************************************
  291. *         VACLEAR              CLEAR ACC VALID                  *
  292. *                                                               *
  293. *         Function Origin:                                      *
  294. *           Variable:          VACLEAR                          *
  295. *           Called By:         VALID Clause                     *
  296. *           Object Type:       Push Button                      *
  297. *                                                               *
  298. *****************************************************************
  299. *
  300. FUNCTION VACLEAR     &&  CLEAR ACC VALID
  301. PARAMETER Msg
  302. Acc = 0
  303. Decimal = 0
  304. do ShowCalc with Msg
  305. return .T.
  306.  
  307. *****************************************************************
  308. *         VNumber                # VALID                        *
  309. *         Function Origin:                                      *
  310. *           Variable:          I0-I9                            *
  311. *           Called By:         VALID Clause                     *
  312. *           Object Type:       Push Button                      *
  313. *         Purpose:  Adds digit to accumulator                   *
  314. *****************************************************************
  315. FUNCTION VNumber
  316. PARAMETER Number
  317. IF Decimal = 0
  318.     acc = acc*10 + Number
  319. ELSE
  320.     acc = acc + Decimal*Number
  321.     Decimal = Decimal/10.0
  322. ENDIF
  323. DO ShowCalc With ltrim(str(Number))
  324. RETURN .T.
  325. *****************************************************************
  326. *         VDECIMAL              .  VALID                        *
  327. *         Function Origin:                                      *
  328. *           Variable:          deci                             *
  329. *           Called By:         VALID Clause                     *
  330. *           Object Type:       Push Button                      *
  331. *         Purpose:  Processes decimal point                     *
  332. *****************************************************************
  333. FUNCTION VDECIMAL
  334. DO ShowCalc WITH "."
  335. IF Decimal = 0
  336.     Decimal = .1
  337. ELSE
  338.     ?? chr(7)  && Ring Bell    
  339. ENDIF
  340. RETURN .T.
  341.  
  342. *****************************************************************
  343. *         VXPOSE                 X <--> Y VALID                 *
  344. *         Function Origin:                                      *
  345. *           Variable:          xtoy                             *
  346. *           Called By:         VALID Clause                     *
  347. *           Object Type:       Push Button                      *
  348. *         Purpose:  transposes registers  X and Y               *
  349. *****************************************************************
  350. FUNCTION VXPOSE
  351. TEMP = Results
  352. Results = acc
  353.  
  354. acc = TEMP
  355. DO ShowCalc WITH "X--Y"
  356. RETURN .T.
  357. *****************************************************************
  358. *         VMEM                 +/- Memory VALID                 *
  359. *         Function Origin:                                      *
  360. *           Variable:          MPLUS/MMINUS                     *
  361. *           Called By:         VALID Clause                     *
  362. *           Object Type:       Push Button                      *
  363. *         Purpose:  Processes M+ and M- Keys                    *
  364. *****************************************************************
  365. FUNCTION VMEM
  366. PARAMETER MOP
  367. Memory = EVALUATE("Memory "+ MOP + "Results")
  368. DO ShowCalc WITH "M"+MOP
  369. RETURN .T.
  370. *****************************************************************
  371. *         VMR                  MR  VALID                        *
  372. *         Function Origin:                                      *
  373. *           Variable:          mr                               *
  374. *           Called By:         VALID Clause                     *
  375. *           Object Type:       Push Button                      *
  376. *         Purpose:  Retrieves Memory Register                   *
  377. *****************************************************************
  378. FUNCTION VMR
  379. acc = memory
  380. DO ShowCalc WITH "MR"
  381. RETURN .T.
  382. *****************************************************************
  383. *         VMC                  MC VALID                         *
  384. *         Function Origin:                                      *
  385. *           Variable:          mc                               *
  386. *           Called By:         VALID Clause                     *
  387. *           Object Type:       Push Button                      *
  388. *         Purpose:  Clears memory register                      *
  389. *****************************************************************
  390. FUNCTION VMC
  391. memory = 0
  392. DO ShowCalc WITH "MC"
  393. RETURN .T.
  394. *****************************************************************
  395. *         VReverse             Reverses sign                    *
  396. *         Function Origin:                                      *
  397. *           Variable:          plusminus                        *
  398. *           Called By:         VALID Clause                     *
  399. *           Object Type:       Push Button                      *
  400. *         Purpose:  Reverses sign                               *
  401. *****************************************************************
  402. FUNCTION VREVERSE
  403. acc = - acc
  404. DO ShowCalc WITH "+/-"
  405. RETURN .T.
  406. *****************************************************************
  407. *         VQUIT                Quit                             *
  408. *         Function Origin:                                      *
  409. *           Variable:          quit                             *
  410. *           Called By:         VALID Clause                     *
  411. *           Object Type:       Push Button                      *
  412. *         Purpose:  Exits from Calculator                       *
  413. *****************************************************************
  414. FUNCTION VQUIT
  415. CLEAR READ
  416. RETURN .T.
  417. *****************************************************************
  418. *                                                               *
  419. *         VFUNC               Function VALID                    *
  420. *                                                               *
  421. *         Function Origin:                                      *
  422. *           Variable:          Any functions (sin, cos, rand,...*
  423. *           Called By:         VALID Clause                     *
  424. *           Object Type:       Push Button                      *
  425. *         Purpose: Evaluates function                           *
  426. *****************************************************************
  427. FUNCTION VFUNC
  428. PARAMETER Function     && Name of function
  429. IF (Function = 'log' OR Function = 'log10') AND acc <= 0
  430.    WAIT "Zero accumulator is not allowed for log function" WINDOW
  431.    RETURN
  432. ENDIF 
  433. Results = EVAL( Function + "(ACC)")
  434. = VACLEAR( Function )    
  435. DO ShowCalc WITH Function
  436. RETURN .T.
  437. *****************************************************************
  438. *         VOP                  Operator VALID                   *
  439. *         Function Origin:                                      *
  440. *           Variable:          Operator: + - * / % of function  *
  441. *           Called By:         VALID Clause                     *
  442. *           Object Type:       Push Button                      *
  443. *         Purpose: Evaluates function                           *
  444. *****************************************************************
  445. FUNCTION VOP
  446. PARAMETER OP    && operation (+ - * / )
  447. Results = EVALUATE("Results " + oldOP + " acc")
  448. DO ShowCalc WITH OP
  449. =VACLEAR(OP)
  450. OldOp = OP
  451. RETURN .T.
  452. *****************************************************************
  453. *         VFACT                Factorial VALID                  *
  454. *         Function Origin:                                      *
  455. *           Variable:          xfactor                          *
  456. *           Called By:         VALID Clause                     *
  457. *           Object Type:       Push Button                      *
  458. *         Purpose: Computes factorial                           *
  459. *****************************************************************
  460. FUNCTION VFACT
  461. Message = "X!"
  462. IF acc = 0
  463.     Results = 1
  464. ELSE
  465.     IF INT(acc) != ACC   && ACC Register must be int
  466.         Message = "Error!"
  467.     ELSE
  468.         Results = ACC
  469.         IF acc > 2
  470.             FOR TEMP = ACC-1 TO 2 STEP -1
  471.                 Results = Results*TEMP
  472.             ENDFOR
  473.         ENDIF
  474.     ENDIF
  475. ENDIF
  476. =VACLEAR(Message)
  477. DO ShowCalc WITH Message
  478. RETURN .T.
  479. *****************************************************************
  480. *         VRAND                Rand VALID                       *
  481. *         Function Origin:                                      *
  482. *           Variable:          xrand                            *
  483. *           Called By:         VALID Clause                     *
  484. *           Object Type:       Push Button                      *
  485. *         Purpose: Computes factorial                           *
  486. *****************************************************************
  487. FUNCTION VRAND
  488. ACC = RAND()
  489. DO ShowCalc WITH "Rand"
  490. OldOP = "+"
  491. RETURN .T.
  492. *****************************************************************
  493. *         VPI                  PI        VALID                  *
  494. *         Function Origin:                                      *
  495. *           Variable:          xpi                              *
  496. *           Called By:         VALID Clause                     *
  497. *           Object Type:       Push Button                      *
  498. *         Purpose: Replaces acc register with PI                *
  499. *****************************************************************
  500. PROCEDURE VPI
  501. acc = PI()
  502. DO ShowCalc WITH "PI"
  503. OldOP = "+"
  504. RETURN .T.
  505. *****************************************************************
  506. *         VINVERT              VINVERT  VALID                   *
  507. *         Function Origin:                                      *
  508. *           Variable:          invert                           *
  509. *           Called By:         VALID Clause                     *
  510. *           Object Type:       Push Button                      *
  511. *         Purpose: Divides 1 by the accumulator                 *
  512. *****************************************************************
  513. FUNCTION VINVERT
  514. acc = 1/ACC
  515. DO ShowCalc WITH "1/X"
  516. RETURN .T.
  517. *****************************************************************
  518. *         VEQUAL               Factorial VALID                  *
  519. *         Function Origin:                                      *
  520. *           Variable:          EQUALS                           *
  521. *           Called By:         VALID Clause                     *
  522. *           Object Type:       Push Button                      *
  523. *         Purpose: Processes = operator                         *
  524. *****************************************************************
  525. FUNCTION VEQUAL
  526. Results = EVALUATE(" Results " + oldOP + "ACC" )
  527. =VACLEAR("=")
  528. DO ShowCalc WITH "="
  529. OldOP = "+"
  530. RETURN .T.
  531. *****************************************************************
  532. *                                                               *
  533. *         ShowCalc             Called to display registers      *
  534. *                                                               *
  535. *           Called By:         VCLEAR, VOP, VNUMBER, VACLEAR    *
  536. *                              VXPOSE, VMEM, VMR, VMC, VREVERSE *
  537. *                              VFUNC, VFACE, VRAND, VPI, VINVERT*
  538. *           Purpose:           Displays Calculator results      *
  539. *****************************************************************
  540. PROCEDURE ShowCalc
  541. PARAMETER Comment
  542. @ 1,21 CLEAR TO 3,37 COLOR W+/BG
  543. @ 1,21 SAY ACC ;
  544.     SIZE 1,20 ;
  545.     PICTURE "@Z 99999999999.9999" COLOR W+/BG
  546. @ 2,21 SAY Results;
  547.     SIZE 1,20 ;
  548.     PICTURE "@Z 99999999999.9999" COLOR W+/BG
  549.  
  550. @ 3,21 SAY Memory ;
  551.     SIZE 1,20 ;
  552.     PICTURE "@Z 99999999999.9999" COLOR W+/BG
  553. @ 0,0 CLEAR TO 0,10  
  554. @ 0,0 SAY Comment
  555. RETURN
  556.