home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 102 / af102a.adf / Tutorial_Code / Console.rexx
Encoding:
OS/2 REXX Batch file  |  1997-07-25  |  7.3 KB  |  331 lines
  1. /* ------------------------------------------------------------ */
  2.  
  3. /* console.rexx */
  4.  
  5. /* ------------------------------------------------------------ */
  6.  
  7. /* miscellaneous definitions... */
  8.  
  9.  
  10. g.TRUE=1; g.FALSE=0; g.CR='0D'x; g.BACKSPACE='08'x
  11.  
  12. g.SPACE='20'x; g.APPROX='7E'x; g.ESC='1B'x; g.CSI='9b'x
  13.  
  14. g.BACKGROUND     = g.CSI||'3e'x||'32'x||'6d'x
  15.  
  16. g.CELL_COLOUR    = g.CSI||'34'x||'32'x||'6d'x
  17.  
  18. g.INVERSE_ON     = g.CSI||'37'x||'6d'x        /* inverse video style command */ 
  19.  
  20. g.INVERSE_OFF    = g.CSI||'32'x||'37'x||'6d'x /* inverse off command */ 
  21.  
  22. g.ITALIC_ON      = g.CSI||'33'x||'6d'x        /* italic text style command */
  23.  
  24. g.ITALIC_OFF     = g.CSI||'32'x||'33'x||'6d'x /* italic off command */
  25.  
  26. g.BOLD_ON        = g.CSI||'31'x||'6d'x        /* bold text style command */
  27.  
  28. g.BOLD_OFF       = g.CSI||'32'x||'32'x||'6d'x /* bold off command */
  29.  
  30. g.UNDERSCORE_ON  = g.CSI||'34'x||'6d'x        /* underscore text style command */
  31.  
  32. g.UNDERSCORE_OFF = g.CSI||'32'x||'34'X||'6d'x /* underscore off command */
  33.  
  34. g.TITLE1 = g.BOLD_ON||'I N C O M E - S U M M A R Y'||g.BOLD_OFF
  35.  
  36. g.TITLE2 = g.ITALIC_ON||'Press ESCape to clear form or exit program'||g.ITALIC_OFF
  37.  
  38. g.PROCESS_EXISTING = 'PROCESS THIS DATA SET (Y/N)?  '
  39.  
  40. g.PROCESS_NEW = 'PROCESS NEW SET OF DATA(Y/N)? '
  41.  
  42. g.TOTAL = g.BOLD_ON||'TOTAL                 £'||g.BOLD_OFF
  43.  
  44. g.TOTAL_R=35
  45.  
  46. g.TOTAL_C=28
  47.  
  48. g.PROCESS_PROMPT_R = 38
  49.  
  50. g.PROCESS_PROMPT_C = 4
  51.  
  52. g.GENERAL_C=4
  53.  
  54. g.CLEAR    = '                              '
  55.  
  56. g.CLEAR_TOTAL = '            '
  57.  
  58.  
  59. /* Data table for the form display... */
  60.  
  61.  
  62. f.FIELD_COUNT=12
  63.  
  64. f.1.name='Amount for January:   £'; f.1.r=10; f.1.c=4;  f.1.l=8
  65.  
  66. f.2.name='Amount for February:  £'; f.2.r=12; f.2.c=4;  f.2.l=8
  67.  
  68. f.3.name='Amount for March:     £'; f.3.r=14; f.3.c=4;  f.3.l=8
  69.  
  70. f.4.name='Amount for April:     £'; f.4.r=16; f.4.c=4;  f.4.l=8
  71.  
  72. f.5.name='Amount for May:       £'; f.5.r=18; f.5.c=4;  f.5.l=8
  73.  
  74. f.6.name='Amount for June:      £'; f.6.r=20; f.6.c=4;  f.6.l=8
  75.  
  76. f.7.name='Amount for July:      £'; f.7.r=22; f.7.c=4;  f.7.l=8
  77.  
  78. f.8.name='Amount for August:    £'; f.8.r=24; f.8.c=4;  f.8.l=8
  79.  
  80. f.9.name='Amount for September: £'; f.9.r=26; f.9.c=4;  f.9.l=8
  81.  
  82. f.10.name='Amount for October:   £'; f.10.r=28; f.10.c=4;  f.10.l=8
  83.  
  84. f.11.name='Amount for November:  £'; f.11.r=30; f.11.c=4;  f.11.l=8
  85.  
  86. f.12.name='Amount for December:  £'; f.12.r=32; f.12.c=4;  f.12.l=8
  87.  
  88. reply$. = '' 
  89.  
  90. /* ------------------------------------------------------------ */
  91.  
  92. /* start main code by opening window and displaying form... */
  93.  
  94. call Open(window,'RAW:40/40/430/330/console.rexx')
  95.  
  96. call Writech(window,g.BACKGROUND||g.CELL_COLOUR)
  97.  
  98. call WriteToConsoleWindow(window,2,g.GENERAL_C,g.TITLE1)
  99.  
  100. call WriteToConsoleWindow(window,6,g.GENERAL_C,g.TITLE2)
  101.  
  102. call WriteToConsoleWindow(window,g.TOTAL_R,g.GENERAL_C,g.TOTAL)
  103.  
  104. call DisplayConsoleWindow(window)
  105.  
  106.  
  107. /* now collect data... */
  108.  
  109. exit_flag=g.FALSE /* force entry into loop */
  110.  
  111. do while ~exit_flag
  112.  
  113.    call ClearConsoleWindow(window)
  114.  
  115.    if ReadConsoleWindow(window) then
  116.  
  117.       do
  118.       
  119.         call WriteToConsoleWindow(window,g.PROCESS_PROMPT_R,g.PROCESS_PROMPT_C,g.PROCESS_EXISTING)
  120.  
  121.         x$=Readch(window,1)
  122.                
  123.         if Upper(x$)=='Y' then call ProcessData()
  124.  
  125.       end
  126.  
  127.    call WriteToConsoleWindow(window,g.PROCESS_PROMPT_R,g.PROCESS_PROMPT_C,g.PROCESS_NEW)
  128.  
  129.    x$=Readch(window,1)
  130.    
  131.    if Upper(x$)=='N' then exit_flag=g.TRUE
  132.      
  133.       else do
  134.       
  135.             call WriteToConsoleWindow(window,g.PROCESS_PROMPT_R,g.PROCESS_PROMPT_C,g.CLEAR) 
  136.  
  137.             call WriteToConsoleWindow(window,g.TOTAL_R,g.TOTAL_C,g.CLEAR_TOTAL) 
  138.  
  139.            end
  140. end
  141.  
  142. call Close(window)
  143.  
  144. exit /* logical program end */
  145.  
  146.  
  147. /* ------------------------------------------------------------ */
  148.  
  149. /* Here you can do whatever you like but for this example
  150.    we are just adding the entered reply fields together and
  151.    displaying the total amount (ignoring any invalid, 
  152.    ie non-numeric, entries)... */ 
  153.  
  154. ProcessData: Procedure expose f. g. reply$.
  155.  
  156. total=0
  157.  
  158. do i=1 to f.FIELD_COUNT
  159.    
  160.    if DataType(reply$.i,'Numeric') then total=total+reply$.i 
  161.  
  162. end
  163.  
  164. call WriteToConsoleWindow(window,g.TOTAL_R,g.TOTAL_C,total) 
  165.  
  166. return
  167.  
  168. /* ------------------------------------------------------------ */
  169.  
  170. DisplayConsoleWindow: Procedure expose f. g.
  171.  
  172. parse arg window
  173.  
  174. do i=1 to f.FIELD_COUNT
  175.  
  176.    call WriteToConsoleWindow(window,f.i.r,f.i.c,f.i.name)
  177.  
  178. end
  179.  
  180. return
  181.  
  182. /* ------------------------------------------------------------ */
  183.  
  184. ClearConsoleWindow: Procedure expose f. g.
  185.  
  186. parse arg window
  187.  
  188. do i=1 to f.FIELD_COUNT
  189.    
  190.    call InitialiseInputField(window,f.i.r,f.i.c+Length(f.i.name)+1,f.i.l)
  191.  
  192. end
  193.  
  194. return
  195.  
  196. /* ------------------------------------------------------------ */
  197.    
  198. ReadConsoleWindow: Procedure expose f. g. reply$.
  199.  
  200. parse arg window
  201.  
  202. data_ok_flag=g.TRUE
  203.  
  204. do i=1 to f.FIELD_COUNT
  205.  
  206.    reply$.i=ReadFromConsoleWindow(window,f.i.r,f.i.c+Length(f.i.name)+1,f.i.l); 
  207.    
  208.    if reply$.i==g.ESC then 
  209.    
  210.          do
  211.    
  212.           i=f.FIELD_COUNT
  213.    
  214.           data_ok_flag=g.FALSE
  215.                               
  216.          end
  217. end
  218.  
  219. return data_ok_flag
  220.  
  221. /* ------------------------------------------------------------ */
  222.  
  223. WriteToConsoleWindow: Procedure expose g.
  224.  
  225. parse arg window,r,c,text$
  226.  
  227. call Writech(window,g.CSI||r||'3B'x||c||'48'x)
  228.  
  229. call Writech(window,text$)
  230.  
  231. return
  232.  
  233. /* ------------------------------------------------------------ */
  234.  
  235. ReadFromConsoleWindow: Procedure expose g.
  236.  
  237. parse arg window,r,c,count
  238.  
  239. input_string$=''
  240.  
  241. i=0 /* loop counter */
  242.  
  243. x$=''
  244.  
  245. call Writech(window,g.CSI||r||'3B'x||c||'48'x) /* position cursor */
  246.  
  247. do while x$~==g.CR
  248.  
  249.    if i<count+1 then do
  250.  
  251.         select
  252.    
  253.              when x$==g.CSI then 
  254.              
  255.                   do
  256.              
  257.                     call Readch(window,1)
  258.              
  259.                     x$=Readch(window,1)
  260.                                
  261.                   end
  262.              
  263.              
  264.              when x$==g.BACKSPACE & i>1 then 
  265.              
  266.                   do
  267.  
  268.                     i=i-1
  269.  
  270.                     Writech(window,x$||'.'x$)
  271.  
  272.                     input_string$=Left(input_string$,Length(input_string$)-1)
  273.  
  274.                     x$=Readch(window,1)
  275.  
  276.                   end
  277.  
  278.  
  279.               when x$==g.ESC then 
  280.               
  281.                   do
  282.                                                                   
  283.                     input_string$=g.ESC
  284.                                 
  285.                     x$=g.CR
  286.                                
  287.                   end
  288.                                 
  289.                                      
  290.               when x$>=g.SPACE & x$<g.APPROX then 
  291.               
  292.                   do
  293.  
  294.                     i=i+1
  295.  
  296.                     Writech(window,x$)
  297.  
  298.                     input_string$=input_string$||x$
  299.  
  300.                     x$=Readch(window,1)
  301.  
  302.                   end
  303.              
  304.                 
  305.               otherwise x$=Readch(window,1)
  306.                         
  307.                         
  308.         end                     /* case-select end */
  309.               
  310.    end                          /* if-then end */
  311.    
  312.    else x$=g.CR
  313.                 
  314. end                             /* do-while loop end */
  315.  
  316. return input_string$
  317.  
  318. /* ------------------------------------------------------------ */
  319.  
  320. InitialiseInputField: Procedure expose g.
  321.  
  322. parse arg window,r,c,count
  323.  
  324. call Writech(window,g.CSI||r||'3B'x||c||'48'x) /* position cursor */
  325.  
  326. call Writech(window,Copies('.',count))
  327.  
  328. return
  329.  
  330. /* ------------------------------------------------------------ */
  331.