home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / UTILS / RPN3A / RPNCALC.OPL < prev    next >
Encoding:
Text File  |  1994-10-11  |  15.2 KB  |  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 constant
  425.         push:(pi)
  426.     else
  427.         problem:("Stack empty")
  428.     endif
  429. endp
  430.  
  431. rem*******************************************
  432. rem
  433. rem    Psion key operations
  434. rem
  435. rem*******************************************
  436.  
  437. proc psionop:(ki%)
  438.     local result, val1, tval, k%
  439.     local op$(1)
  440.     local temp$(30)
  441.  
  442.     rem
  443.     rem    Put the edit box in the stack
  444.     rem
  445.     temp$ = editstr$
  446.     if pushstr:
  447.         return
  448.     endif
  449.  
  450.     rem    
  451.     rem     Get the character withoud the Psion key
  452.     rem 
  453.     k% = ki% and 511
  454.     op$ = upper$(chr$(k%))
  455.     
  456.     rem
  457.     rem Process the menu keys
  458.     rem
  459.     if op$ = "I"
  460.         about:
  461.         return
  462.     elseif op$ = "F"
  463.         formatop:
  464.         return
  465.     elseif op$ = "N"
  466.         clrstk:
  467.         return
  468.     endif
  469.  
  470.     rem
  471.     rem    All this operations require at least 
  472.     rem    one element
  473.     rem
  474.     if tos% < 2
  475.         problem:("Stack empty")
  476.         return
  477.     endif
  478.  
  479.     rem
  480.     rem    Get the element and keep an exta copy just
  481.     rem     in case the operation goes sour
  482.     rem
  483.     val1 = pop:
  484.     tval = val1
  485.  
  486.     onerr errhand
  487.  
  488.     rem
  489.     rem    If this is a trig operation convert
  490.     rem    the value to the trig format selected
  491.     rem
  492.     if loc("SCT", op$) and frmtrig% = 1
  493.         val1 = rad(val1)
  494.     endif
  495.  
  496.     rem
  497.     rem    Decode the operation
  498.     rem
  499.     if op$ = "S"
  500.         result = sin(val1)
  501.     elseif op$ = "C"
  502.         result = cos(val1)
  503.     elseif op$ = "T"
  504.         result = tan(val1)
  505.     elseif op$ = "A"
  506.         result = asin(val1)
  507.     elseif op$ = "K"
  508.         result = acos(val1)
  509.     elseif op$ = "J"
  510.         result = atan(val1)
  511.     elseif op$ = "L"
  512.         result = ln(val1)
  513.     elseif op$ = "G"
  514.         result = log(val1)
  515.     elseif op$ = "E"
  516.         result = exp(val1)
  517.     elseif op$ = "P"
  518.         result = val1 ** 2
  519.     elseif op$ = "Q"
  520.         result = sqr(val1)
  521.     elseif op$ = "V"
  522.         result = 1 / val1
  523.     endif
  524.  
  525.     rem
  526.     rem    If this is an inverse trig opeation
  527.     rem    conver to the trig format slected
  528.     rem
  529.     if loc("AKJ", op$) and frmtrig% = 1
  530.         result = deg(result)
  531.     endif
  532.     
  533.     onerr off
  534.  
  535.     rem
  536.     rem    Put the result back in the stack
  537.     rem    and get out
  538.     rem
  539.     push:(result)
  540.     return
  541.     
  542.     rem
  543.     rem    Error handler. Complain and
  544.     rem     resotre the stack to its previous state.
  545.     rem
  546.     errhand::
  547.     onerr off
  548.     problem:(err$(err))
  549.  
  550.     if len(temp$)
  551.         editstr$ = temp$
  552.         editpos% = len(temp$)+1
  553.     else
  554.         push:(tval)
  555.     endif
  556. endp
  557.  
  558. rem*******************************************
  559. rem
  560. rem    Basic arithmetic operations
  561. rem
  562. rem*******************************************
  563.  
  564. proc binop:(op$)
  565.     local result, val1, val2
  566.     local temp$(30)
  567.     
  568.     rem
  569.     rem        Put the edit box in the stack
  570.     rem
  571.     temp$ = editstr$
  572.     if pushstr:
  573.         return
  574.     endif
  575.     
  576.     if tos% < 3
  577.         problem:("Stack empty")
  578.         return
  579.     endif
  580.  
  581.     val2 = pop:
  582.     val1 = pop:
  583.     
  584.     onerr errhand
  585.     
  586.     if op$ = "+"
  587.         result = val1 + val2
  588.     elseif op$ = "-"
  589.         result = val1 - val2
  590.     elseif op$ = "*"
  591.         result = val1 * val2
  592.     elseif op$ = "/"
  593.         result = val1 / val2
  594.     elseif op$ = "X"
  595.         result = val1 ** val2
  596.     endif
  597.  
  598.     onerr off
  599.     
  600.     push:(result)
  601.     return
  602.     
  603.     rem
  604.     rem    Error handler. Complain and
  605.     rem     resotre the stack to its previous state.
  606.     rem
  607.     errhand::
  608.     onerr off
  609.     problem:(err$(err))
  610.  
  611.     push:(val1)
  612.     if len(temp$)
  613.         editstr$ = temp$
  614.         editpos% = len(temp$)+1
  615.     else
  616.         push:(val2)
  617.     endif
  618. endp
  619.  
  620. rem*******************************************
  621. rem
  622. rem    Change Sign operation
  623. rem
  624. rem*******************************************
  625. proc chsop:
  626.     local epos%, echar$(1)
  627.     local base, expon, length%
  628.  
  629.     epos% = loc(editstr$, "E")
  630.     
  631.     length% = len(editstr$)
  632.  
  633.   onerr errhand
  634.  
  635.     base = eval(editstr$)
  636.  
  637.     if epos% = 0
  638.         base  = eval(editstr$)
  639.         expon = 0
  640.     else
  641.         echar$ = mid$(editstr$, epos%, 1)
  642.         base  = eval(left$(editstr$, epos%-1))
  643.         epos% = epos% + 1
  644.         if mid$(editstr$, epos%, 1) = "+"
  645.             epos% = epos% + 1
  646.         endif
  647.         expon = eval(right$(editstr$, length% - epos%+1))
  648.     endif
  649.  
  650.     if epos% = 0 or editpos% < epos%
  651.         base = -base
  652.     else
  653.         expon = -expon
  654.     endif
  655.  
  656.     if epos%
  657.         editstr$ = gen$(base, 25) + echar$ + gen$(expon, 25)
  658.     else
  659.         editstr$ = gen$(base,25)
  660.     endif
  661.     if len(editstr$) < length%
  662.         editpos% = editpos% -1
  663.         if editpos% < 1 
  664.             editpos% = 1
  665.         endif
  666.     elseif len(editstr$) > length%
  667.         editpos% = editpos% + 1
  668.     endif
  669.     
  670.     onerr off
  671.     return
  672.  
  673.     errhand::
  674.     onerr off
  675.     problem:(err$(err))
  676. endp
  677.     
  678. rem*******************************************
  679. rem
  680. rem    Attend to the menu
  681. rem
  682. rem*******************************************
  683. proc menuop:
  684.     local k%, c$(1)
  685.  
  686.     minit
  687.     mcard "Options", "Format", %f
  688.     mcard "Special", "New stack", %n, "About", -%i, "Exit", %x
  689.  
  690.     k% = menu
  691.     c$ = chr$(k%)
  692.     
  693.     if k% = 0    
  694.         return
  695.     elseif c$ = "x"
  696.         stop
  697.     elseif c$ = "i"
  698.         about:
  699.     elseif c$ = "f"
  700.         formatop:
  701.     elseif c$ = "n"
  702.         clrstk:
  703.     endif
  704. endp
  705.  
  706. rem*******************************************
  707. rem
  708. rem    Format and display the about window
  709. rem
  710. rem*******************************************
  711.  
  712. proc about:
  713.     dinit "RPN 3a Calculator Version 1.0"
  714.     dtext "", "Original program:", 2
  715.     dtext "", "RPN Calculator Ver 1.01 for the Series 3", 2
  716.     dtext "", "Copyright (c) 1992 Jaime Pereira", 2
  717.     dtext "", "jep@world.std.com", 2
  718.     dtext "", "Compuserve 70441,465", 2
  719.     dtext "", "Ported to the Series 3a by:", 2
  720.     dtext "", "Victor Alvarado  vma@mvuts.att.com", 2
  721.     dialog
  722. endp
  723.  
  724. rem*******************************************
  725. rem
  726. rem    Format and display the help window
  727. rem
  728. rem*******************************************
  729.  
  730. proc helpfunc:
  731.     global hcmd$(5,7), hkey$(5,2)
  732.  
  733.     local id%
  734.     
  735.     id% = gcreate(0, 10, 480, 140, 0, 1)
  736.     guse id%
  737.     gxborder 1,$203
  738.  
  739.     gat 120, 24 : glineby 0, 116
  740.     gat 240, 24 : glineby 0, 116
  741.     gat 360, 24 : glineby 0, 116
  742.  
  743.     gat 0, 24 : glineby 480, 0
  744.  
  745.     gat 180, 20: gprint "Keyboard Usage"
  746.     
  747.     rem
  748.     rem    first column
  749.     rem
  750.     hcmd$(1) = "Swap" : hkey$(1) = "S"
  751.     hcmd$(2) = "Rot"  : hkey$(2) = "R"
  752.     hcmd$(3) = "Sto"  : hkey$(3) = "I"
  753.     hcmd$(4) = "Rcl"  : hkey$(4) = "O"
  754.     hcmd$(5) = "Pi"   : hkey$(5) = "P"
  755.  
  756.     hcolput:(12)
  757.  
  758.      rem
  759.     rem    Second column
  760.     rem
  761.     hcmd$(1) = "sin(x)"      : hkey$(1) = chr$(2) + "S"
  762.     hcmd$(2) = "cos(x)"      : hkey$(2) = chr$(2) + "C"
  763.     hcmd$(3) = "tan(x)"      : hkey$(3) = chr$(2) + "T"
  764.     hcmd$(4) = "ln(x)"       : hkey$(4) = chr$(2) + "L"
  765.     hcmd$(5) = "e"+chr$(3)   : hkey$(5) = chr$(2) + "E"
  766.  
  767.     hcolput:(132)
  768.  
  769.     rem
  770.     rem    third column
  771.     rem
  772.     hcmd$(1) = "asin(x)"      : hkey$(1) = chr$(2) + "A"
  773.     hcmd$(2) = "acos(x)"      : hkey$(2) = chr$(2) + "K"
  774.     hcmd$(3) = "atan(x)"      : hkey$(3) = chr$(2) + "J"
  775.     hcmd$(4) = "log(x)"       : hkey$(4) = chr$(2) + "G"
  776.     hcmd$(5) = "y"+chr$(3)  : hkey$(5) = "X"
  777.  
  778.     hcolput:(252)
  779.  
  780.     rem
  781.     rem    fourth column
  782.     rem
  783.     hcmd$(1) = "1/x"        : hkey$(1) = chr$(2) + "V"
  784.     hcmd$(2) = "sqrt(x)"    : hkey$(2) = chr$(2) + "Q"
  785.     hcmd$(3) = "-x"        : hkey$(3) = "C"
  786.     hcmd$(4) = ""        : hkey$(4) = ""
  787.     hcmd$(5) = ""        : hkey$(5) = ""
  788.  
  789.     hcolput:(372)
  790.  
  791.     gvisible on
  792.     
  793.     get
  794.     gclose id%
  795. endp
  796.  
  797. rem*******************************************
  798. rem
  799. rem    A helper function for the
  800. rem    help display
  801. rem
  802. rem*******************************************
  803.  
  804. proc hcolput:(xpos%)
  805.     local ypos%, cnt%
  806.     
  807.     ypos% = 48
  808.     cnt% = 1
  809.  
  810.     while cnt% <= 5
  811.         gat xpos%, ypos%
  812.         gprint hcmd$(cnt%)
  813.         gat xpos% + 78, gy
  814.         gprint hkey$(cnt%)
  815.         ypos% = ypos% + 20
  816.         cnt% = cnt% + 1
  817.     endwh
  818. endp
  819.  
  820. rem*******************************************
  821. rem
  822. rem    My error handler
  823. rem
  824. rem*******************************************
  825.  
  826. proc problem:(info$)
  827.     giprint info$
  828.     beep 5, 300
  829. endp
  830.  
  831.