home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / utilsr / rpn3a / RPNCALC.OPL < prev    next >
Text File  |  1994-10-11  |  16KB  |  831 lines
  1. rem*************************************************************************
  2. rem
  3. rem    RPN Calculator for the Psion Series 3a
  4. rem    Version 1.0
  5. rem    Copyright (c) 1992  Jaime Pereira
  6. rem
  7. rem    This program is free software; you can redistribute it and/or modify
  8. rem    it under the terms of the GNU General Public License as published by
  9. rem    the Free Software Foundation; either version 1, or (at your option)
  10. rem    any later version.
  11. rem
  12. rem    This program is distributed in the hope that it will be useful,
  13. rem    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. rem    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. rem    GNU General Public License for more details.
  16. rem
  17. rem    You should have received a copy of the GNU General Public License
  18. rem    along with this program; if not, write to the Free Software
  19. rem    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. rem
  21. rem    Revision: $Id: rpncalc.opl 1.3 92/12/10 00:32:02 jaime Exp Locker: jaime $
  22. rem    Ported to the Series 3A by Victor Alvarado 10/10/94
  23. rem
  24. rem*************************************************************************
  25.  
  26. app RPNcalc
  27.     type $1000
  28.     icon "\opl\rpncalc.pic"
  29. enda
  30.  
  31. proc rpncalc:
  32.     global stack(20), tos%, wid%
  33.     global memory(10)
  34.     global editstr$(30), editpos%, udpos%
  35.  
  36.     global frmtype%, frmprec&, frmtrig%
  37.  
  38.     local k%, c$(1), inedit%
  39.  
  40.     rem
  41.     rem    Relocate the base window so we can see the
  42.     rem    status window.
  43.     rem
  44.     screen 35,9
  45.     gsetwin 416, 160
  46.     statuswin on
  47.  
  48.     gupdate off
  49.  
  50.     rem
  51.     rem    Create the display window
  52.     rem
  53.     wid% = gcreate(0, 0, 416, 160, 1)
  54.     guse wid%
  55.     gstyle 16
  56.  
  57.     rem
  58.     rem    Add the adornments
  59.     rem
  60.     gborder $200
  61.     k% = 0
  62.     gat 0, 140
  63.     while (k% < 416)
  64.         glineby 2, 0
  65.         gmove 2,0
  66.         k% = k% + 4
  67.     endwh    
  68.  
  69.  
  70.     rem
  71.     rem    Initialize asorted stuff
  72.     rem
  73.     tos% = 1
  74.     editpos% = 1
  75.     editstr$ = ""
  76.     frmtype% = 1
  77.     frmtrig% = 1
  78.     frmprec& = 12
  79.     udpos% = 0
  80.     showstk:
  81.  
  82.     rem
  83.     rem    The Loop!
  84.     rem
  85.     do
  86.         rem
  87.         rem    Read from the keyboard
  88.         rem
  89.         guse wid%
  90.  
  91.         k% = get
  92.         c$ = upper$(chr$(k%))
  93.  
  94.         rem
  95.         rem    Decode keystroke
  96.         rem
  97.  
  98.         if k% = 632        rem Psion-X
  99.             break
  100.     
  101.         elseif k% = 13        rem CR
  102.             rem
  103.             rem CR doubles as DUP if editstr is empty
  104.             rem
  105.             if len(editstr$) = 0 and tos% > 1
  106.                 push:(stack(tos%-1))
  107.             else
  108.                 pushstr: 
  109.             endif
  110.             showstk:
  111.  
  112.                     rem Drop 
  113.         elseif k% = 8 and len(editstr$) = 0   
  114.             pop:
  115.             showstk:
  116.  
  117.         elseif k% = 27        rem Escape key
  118.             inedit% = 0
  119.             editstr$ = ""
  120.             editpos% = 1
  121.                                     
  122.         elseif k% = 290        rem Menu
  123.             menuop:
  124.  
  125.         elseif k% = 291        rem Help
  126.             helpfunc:
  127.         
  128.  
  129.         elseif loc("+-/*X", c$)    rem Math operation
  130.                 binop:(c$)
  131.                 showstk:
  132.  
  133.         elseif k% > 512        rem Special Psion operation    
  134.             psionop:(k%)
  135.             showstk:
  136.  
  137.                     rem Change sign
  138.         elseif c$ = "C"    and len(editstr$)
  139.             chsop:
  140.             showcmd:
  141.             
  142.         elseif loc("CSRIOP", c$) rem General manupulation
  143.             stkop:(c$)
  144.             showstk:
  145.  
  146.                     rem Up and Down arrows
  147.         elseif (k% = 257 or k% = 256) and tos% > 1
  148.             if len(editstr$) and inedit%
  149.                 continue
  150.             endif
  151.             inedit% = 0
  152.             if (k% = 256)
  153.                 udpos% = udpos% + 1
  154.                 if udpos% >= tos%  : udpos% = 0: endif
  155.             else     
  156.                 udpos% = udpos% - 1
  157.                 if udpos% < 0 : udpos% = tos% - 1: endif
  158.             endif
  159.  
  160.             if udpos% = 0
  161.                 editstr$ = ""
  162.                 editpos% = 1
  163.             else
  164.                 editstr$ = gen$(stack(tos% - udpos%), 25)
  165.                 editpos% = len(editstr$)+1
  166.             endif
  167.             showcmd:
  168.  
  169.         else            rem Otherwise to the edit box
  170.             inedit% = 1
  171.             myedit:(k%)
  172.             showcmd:
  173.         endif
  174.         
  175.     until 0
  176. endp
  177.  
  178. rem*******************************************
  179. rem
  180. rem    My own field editor routine
  181. rem
  182. rem*******************************************
  183.  
  184. proc myedit:(k%)
  185.     local hstr$(40), tstr$(40)
  186.     local length%
  187.     
  188.     length% = len(editstr$)
  189.     hstr$ = mid$(editstr$, 1, editpos%-1)
  190.     tstr$ = mid$(editstr$, editpos%, length%)
  191.  
  192.     if k%=8
  193.         length% = len(hstr$)
  194.         if length% > 0
  195.             editstr$ = left$(hstr$, length%-1) + tstr$
  196.             editpos% = editpos% - 1
  197.         endif
  198.  
  199.     elseif k% = 259
  200.         editpos% = editpos% - 1
  201.         if editpos% < 1
  202.             editpos% = 1
  203.         endif
  204.  
  205.     elseif k% = 258
  206.         editpos% = editpos% + 1
  207.         if editpos% > length%+1
  208.             editpos% = length%+1
  209.         endif
  210.  
  211.     elseif (length% > 22)
  212.         return
  213.         
  214.     elseif (k% >= 48 and k% <= 57) or k% = 69 or k% = 101 or k% = 46
  215.         editstr$ = hstr$ + chr$(k%) + tstr$
  216.         editpos% = editpos% + 1
  217.     endif
  218. endp
  219.  
  220.  
  221. rem************************************************
  222. rem
  223. rem    Show the stack display
  224. rem
  225. rem************************************************
  226.  
  227. proc showstk:
  228.     local i%, k%
  229.     local numstr$(25)
  230.     local xo%, yo%
  231.  
  232.     cursor off  
  233.  
  234.     xo% = 5: yo% = 3
  235.  
  236.     gat xo%, yo%
  237.     gfill 356, 136, 1
  238.  
  239.     if tos% = 1
  240.         gat 220, yo% + 130
  241.         gprint " ** Empty **"
  242.     endif
  243.     i% = 10
  244.     k% = tos% - 1
  245.     while i% > 0 and k% > 0
  246.         gat xo%, i% * 13 + yo%
  247.         gprint fix$(tos% - k%, 0, -2);":"
  248.         if frmtype% = 1
  249.             numstr$ = gen$(stack(k%), 25)
  250.         elseif frmtype% = 2
  251.             numstr$ = fix$(stack(k%), frmprec&, 25)
  252.         elseif frmtype% = 3
  253.             numstr$ = sci$(stack(k%), frmprec&, 25)
  254.         endif
  255.         gprintb numstr$, 320, 1
  256.         i% = i% - 1
  257.         k% = k% - 1
  258.         
  259.     endwh
  260.     showcmd:
  261. endp
  262.  
  263. rem*******************************************
  264. rem
  265. rem    Show the edit box
  266. rem
  267. rem*******************************************
  268.  
  269. proc showcmd:
  270.     local x%, cwidth%
  271.     local xo%, yo%
  272.  
  273.     cwidth% = gtwidth("A")
  274.     
  275.     xo% = 7: yo% = 145
  276.  
  277.     cursor off  
  278.  
  279.     gat xo%, yo% - 1
  280.     gfill 356, 12, 1
  281.  
  282.     gtmode 3
  283.     gat xo%, yo% + 10
  284.     gprint "Rpn:"
  285.     x% = gx + 3
  286.     gat x%, gy
  287.     gprint editstr$
  288.     gat x% + cwidth% * (editpos%-1), gy
  289.     cursor wid%
  290.     gupdate
  291. endp
  292.  
  293. rem*******************************************
  294. rem
  295. rem    Format window
  296. rem
  297. rem*******************************************
  298.  
  299. proc formatop:
  300.     dinit "Set RPN Calculator format"
  301.     dchoice frmtype%, "Format:", "General,Fixed,Scientific"
  302.     dlong   frmprec&, "Decimal places:",  0, 12
  303.     dchoice frmtrig%, "Trigonometry units:", "Degrees,Radians"
  304.     if dialog
  305.         showstk:
  306.     endif
  307. endp
  308.  
  309. rem*******************************************
  310. rem
  311. rem    Push the edit box string into the
  312. rem    stack.
  313. rem
  314. rem*******************************************
  315.  
  316. proc pushstr:
  317.     onerr errhand
  318.     if len(editstr$)
  319.         push:(eval(editstr$))
  320.     endif
  321.     onerr off
  322.     
  323.     editstr$ = ""
  324.     editpos% = 1
  325.     return 0
  326.     
  327.     errhand::
  328.     onerr off
  329.     problem:(err$(err))
  330.     return 1
  331. endp
  332.  
  333. rem*******************************************
  334. rem
  335. rem    Push a number in the stack
  336. rem
  337. rem*******************************************
  338.  
  339. proc push:(data)
  340.     udpos% = 0
  341.     if tos% > 19
  342.         problem:("Stack Full")
  343.     else
  344.         stack(tos%) = data
  345.         tos% = tos% + 1
  346.     endif
  347. endp
  348.  
  349. rem*******************************************
  350. rem
  351. rem    Pop a number from the stack
  352. rem
  353. rem*******************************************
  354.  
  355. proc pop:
  356.     udpos% = 0
  357.  
  358.     if tos% = 1
  359.         problem:("Stack empty")
  360.         return 0
  361.     endif
  362.     tos% = tos% - 1
  363.     return     stack(tos%)
  364. endp
  365.  
  366. rem*******************************************
  367. rem
  368. rem    Clear the stack
  369. rem
  370. rem*******************************************
  371.  
  372. proc clrstk:
  373.     tos% = 1
  374.     showstk:
  375. endp
  376.  
  377. rem*******************************************
  378. rem
  379. rem    Stack operations
  380. rem
  381. rem*******************************************
  382.  
  383. proc stkop:(op$)
  384.     local mem, value
  385.  
  386.     rem
  387.     rem        Put the edit box in the stack
  388.     rem
  389.     if pushstr:
  390.         return
  391.     endif
  392.  
  393.     if op$ = "S" and tos% > 2    rem Swap
  394.         stack(tos%) = stack(tos%-1)        
  395.         stack(tos%-1) = stack(tos%-2)        
  396.         stack(tos%-2) = stack(tos%)        
  397.  
  398.     elseif op$ = "R"  and tos% > 3    rem Rot
  399.         stack(tos%) = stack(tos%-1)        
  400.         stack(tos%-1) = stack(tos%-2)        
  401.         stack(tos%-2) = stack(tos%-3)        
  402.         stack(tos%-3) = stack(tos%)
  403.  
  404.     elseif op$ = "I" and tos% > 2        rem Into memory
  405.         mem = pop:
  406.         if (mem >= 1 and mem <= 10)
  407.             value = stack(tos%-1)
  408.             memory(mem) = value
  409.         else
  410.             problem:("Illegal memory number")
  411.         endif
  412.  
  413.     elseif op$ = "O" and tos% > 1        rem Out from memory
  414.         mem = pop:
  415.         if (mem >= 1 and mem <= 10)
  416.             push:(memory(mem))
  417.         else
  418.             problem:("Illegal memory number")
  419.         endif
  420.  
  421.     elseif op$ = "C" and tos% > 1        rem Change sign
  422.         stack(tos%-1) = -stack(tos%-1)        
  423.  
  424.     elseif op$ = "P"            rem Pi