home *** CD-ROM | disk | FTP | other *** search
/ back2roots/padua / padua.7z / padua / lang / RexxArpLib-30.lzh / rexx / Rexxcalc.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1991-04-26  |  3.2 KB  |  142 lines
  1. /*
  2. **  This implements a simple calculator in REXX with intuition interface.
  3. **  Intended to serve as an example for RexxArpLib 2.0 and later, NOT as
  4. **  an example of how to write a calculator...
  5. **
  6. **  By W.G.J. Langeveld, november 1988.
  7. */
  8.  
  9. /*
  10. *   Set up a host
  11. */
  12. runwsh "'x = CreateHost(REXXCALCHOST, REXXCALCPORT)'"
  13.  
  14. /*
  15. *   Wait until it is ready. It times out after a while, so do a few of them.
  16. *   May not be necessary, try it on your system for best results.
  17. */
  18. WaitForPort REXXCALCHOST
  19. WaitForPort REXXCALCHOST
  20. WaitForPort REXXCALCHOST
  21.  
  22. /*
  23. *   Open the window
  24. */
  25. idcmp = 'CLOSEWINDOW+GADGETUP'
  26. flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+BACKFILL'
  27. call OpenWindow(REXXCALCHOST, 50, 50, 180, 130, idcmp, flags)
  28.  
  29. /*
  30. *   Add all the gadgets
  31. */
  32. do i = 7 to 9
  33.  call AddGadget(REXXCALCHOST, 20+(i-7)*32, 50, i, i, i)
  34. end
  35.  
  36. do i = 4 to 6
  37.  call AddGadget(REXXCALCHOST, 20+(i-4)*32, 70, i, i, i)
  38. end
  39. do i = 1 to 3
  40.  call AddGadget(REXXCALCHOST, 20+(i-1)*32, 90, i, i, i)
  41. end
  42.  
  43. call AddGadget(REXXCALCHOST,  20, 110, 0,   "  0  ", 0)
  44. call AddGadget(REXXCALCHOST,  84, 110, ".", ".", ".")
  45. call AddGadget(REXXCALCHOST, 120,  70, "X", "X", "*")
  46. call AddGadget(REXXCALCHOST, 152,  70, "/", "/", "/")
  47. call AddGadget(REXXCALCHOST, 120,  90, "+", "+", "+")
  48. call AddGadget(REXXCALCHOST, 152,  90, "-", "-", "-")
  49. call AddGadget(REXXCALCHOST, 120,  50, "C", " CLR ", "C")
  50. call AddGadget(REXXCALCHOST, 120, 110, "=", "  =  ", "=")
  51.  
  52. /*
  53. *   Draw the dialogue area
  54. */
  55. call SetDrMd(REXXCALCHOST, JAM1)
  56. call SetAPen(REXXCALCHOST, 2)
  57. call RectFill(REXXCALCHOST, 10, 20, 170, 40)
  58. call SetAPen(REXXCALCHOST, 1)
  59. call RectFill(REXXCALCHOST, 15, 25, 165, 35)
  60. call SetReqColor(REXXCALCHOST, PROMPTPEN, 3)
  61. call SetReqColor(REXXCALCHOST, BACKPEN, 1)
  62.  
  63. /*
  64. *   Initialize some things first. Make sure we trap errors.
  65. */
  66. signal on syntax
  67.  
  68. quitflag = 0
  69. register = 0
  70. number = 0
  71. newnum = 1
  72.  
  73. call WindowText(REXXCALCHOST, "\  "||number)
  74.  
  75. /*
  76. *   This is the part that waits for messages.
  77. *   Study carefully: you have to be sure to get ALL messages.
  78. */
  79. mp = openport(REXXCALCPORT)
  80.  
  81. start:
  82.  
  83. do forever
  84.    if quitflag = 1 then leave
  85.    t = waitpkt(REXXCALCPORT)
  86.    do forever
  87.       p = getpkt(REXXCALCPORT)
  88.       if c2d(p) = 0 then leave
  89.  
  90.       arg = getarg(p)
  91.       t = reply(p, 0)
  92.  
  93. /*
  94. *   Phew! Got a message. Handle it. All this is trivial...
  95. */
  96.       if arg = CLOSEWINDOW then do
  97.          call CloseWindow(REXXCALCHOST)
  98.          quitflag = 1
  99.       end
  100.       else if index("1234567890.", arg) ~= 0 then do
  101.          if newnum = 1 then do
  102.             number = arg
  103.             newnum = 0
  104.          end
  105.          else number = number||arg
  106.       end
  107.       else if arg = "C" then do
  108.          register = 0
  109.          number   = 0
  110.          newnum   = 1
  111.       end
  112.       else if index("+-/*", arg) ~= 0 then do
  113.          oper     = arg
  114.          register = number
  115.          newnum   = 1
  116.       end
  117.       else if arg = "=" then do
  118.          interpret "register"||arg||register||oper||number
  119.          number   = register
  120.          newnum   = 1
  121.       end
  122.       else nop
  123.  
  124. /*
  125. *   Update the dialogue area
  126. */
  127.       if quitflag ~= 1 then call WindowText(REXXCALCHOST, "\  "||number)
  128.  
  129.    end
  130. end
  131.  
  132. exit
  133.  
  134. /*
  135. *   Error trapping:
  136. */
  137. syntax:
  138. call WindowText(REXXCALCHOST, "\   Error")
  139. newnum = 1
  140. signal on syntax
  141. signal start
  142.