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