home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / RXANSI12.ZIP / RXANSI.CMD next >
OS/2 REXX Batch file  |  1991-04-03  |  10KB  |  275 lines
  1. /* -------------------------------------------------------------------- */
  2. /* REXX procedure to demonstrate the RXANSI REXX extension              */
  3. /*                                                                      */
  4. /* To use locally, just enter 'RXANSI'.                                 */
  5. /* To use remotely, pass the file handle of the comm port,              */
  6. /* For MAXIMUS this would be ;                                          */
  7. /*       [Extern_dos]CMD.EXE /C e:\rxansi\rxansi12\RXANSI %P            */
  8. /*                                                                      */
  9. /* See documentation for futher details                                 */
  10. /*                                                                      */
  11. /* -------------------------------------------------------------------- */
  12.  
  13. SIGNAL ON SYNTAX NAME usergone /* if remote & user hangsup, goto usergone. */
  14.  
  15. CALL init                      /* register extensions with REXX */  
  16.  
  17. rc = RxAnsiInit()              /* Set up ANSI variables */
  18.  
  19. ARG Commhndl
  20. IF Commhndl ¬= '' THEN         /* If remote user */
  21.    rc = RxMode(MIXED,Commhndl) /* set mode to mixed */
  22. ELSE                   /* but if local */
  23.    rc = RxMouse(ON)            /* turn on mouse support */
  24.  
  25. CALL Setup                     /* display initial screen */  
  26.  
  27. DO FOREVER
  28.    rc = RxGoTo(x,y)           /* position cursor */
  29.    ch = RxGetChar()           /* get user input */
  30.    IF (ch ¬= 'ESCAPE') & (ch ¬= 'BUTTON_2') THEN  /* if it's not escape.. */
  31.       IF LENGTH(ch) = 1 THEN DO   /* and it's a single character.. */
  32.          Rc = RxPutChars(ch)       /* display it */
  33.      y = y + 1          /* and step on to next column */
  34.       END
  35.       ELSE 
  36.          CALL Movecursor      /* must be a cursor control command */
  37.    ELSE 
  38.      CALL dispmenu           /* Escape hit - go show some menus */
  39. END
  40.  
  41.  
  42. /* --------------------------------------------------------------------- */
  43. /* Remote user has hung up - tell host and quit                          */
  44. /* --------------------------------------------------------------------- */
  45. usergone:
  46.   IF lastkey = 'USER GONE' THEN
  47.      SAY 'User gone'
  48.   ELSE
  49.      SAY 'Bug in your Rexx procedure'
  50.   CALL term
  51.   RETURN
  52.  
  53. /* --------------------------------------------------------------------- */
  54. /* Register all the functions to REXX                                    */
  55. /* --------------------------------------------------------------------- */
  56. init : procedure
  57. CALL RxFuncAdd 'RXANSIINIT','RXANSI','RXANSIINIT'
  58. CALL RxFuncAdd 'RXGOTO',    'RXANSI','RXGOTO'
  59. CALL RxFuncAdd 'RXMODE',    'RXANSI','RXMODE'
  60. CALL RxFuncAdd 'RXMOUSE',   'RXANSI','RXMOUSE'
  61. CALL RxFuncAdd 'RXLINE',    'RXANSI','RXLINE'
  62. CALL RxFuncAdd 'RXLINETYPE','RXANSI','RXLINETYPE'
  63. CALL RxFuncAdd 'RXHMENU',   'RXANSI','RXHMENU'
  64. CALL RxFuncAdd 'RXVMENU',   'RXANSI','RXVMENU'
  65. CALL RxFuncAdd 'RXBOX',     'RXANSI','RXBOX'
  66. CALL RxFuncAdd 'RXGETCHAR', 'RXANSI','RXGETCHAR'
  67. CALL RxFuncAdd 'RXGETCHARS','RXANSI','RXGETCHARS'
  68. CALL RxFuncAdd 'RXPUTCHARS','RXANSI','RXPUTCHARS'
  69. RETURN
  70.  
  71. /* --------------------------------------------------------------------- */
  72. /* Display initial screen plus sales pitch!                              */
  73. /* --------------------------------------------------------------------- */
  74. Setup:
  75. rc = RxPutChars(white on_black cls)
  76. rc = RxLineType(S,D)                   /* Set line type &       */  
  77. rc = RxBox(2,1,23,80)                  /* Draw Box round screen */
  78.  
  79. IF commhndl ¬= '' THEN                 /* If remote user, ESCAPE is two */   
  80. DO                                     /* hits of esc.key, so tell them */      
  81.    rc = RxGoTo(24,65)
  82.    rc = RxPutChars(intense yellow 'ESC+ESC = Menu' reset)
  83. END
  84. ELSE
  85. DO
  86.    rc = RxGoTo(24,69)
  87.    rc = RxPutChars(intense yellow 'ESC = Menu' reset)
  88. END
  89.  
  90. /* Display sales pitch */
  91. rc = RxGoTo(5,60)
  92. rc = RxPutChars(Intense Yellow '     RxANSI' reset)
  93. rc = RxGoTo(6,60)
  94. rc = RxPutChars(Intense Yellow 'Version 1.2' reset)
  95. rc = RxGoTo(8,15)
  96. rc = RxPutChars(intense 'Features available in version 1.2 include ;' ) 
  97. rc = RxGoTo(9,15)
  98. rc = RxPutChars(Blue 'o ' cyan 'Horizontal and vertical menus' ) 
  99. rc = RxGoTo(10,15)
  100. rc = RxPutChars(Blue 'o ' cyan 'Local and remote access' ) 
  101. rc = RxGoTo(11,15)
  102. rc = RxPutChars(Blue 'o ' cyan 'Box and Line drawing commands' ) 
  103. rc = RxGoTo(12,15)
  104. rc = RxPutChars(Blue 'o ' cyan 'Mouse Support' reset) 
  105. rc = RxGoTo(14,15)
  106. rc = RxPutChars(White 'This is a mockup of an editor, as an example of what' ) 
  107. rc = RxGoTo(15,15)
  108. rc = RxPutChars(White 'is achievable with a simple REXX procedure and RXANSI. ' ) 
  109. rc = RxGoTo(17,15)
  110. rc = RxPutChars(White 'Have a play around with the cursor and mouse, use the' ) 
  111. rc = RxGoTo(18,15)
  112. rc = RxPutChars(White 'menus, enter text and see what you think - don''t worry,' ) 
  113. rc = RxGoTo(19,15)
  114. rc = RxPutChars(White 'none of the options do anything.' ) 
  115. rc = RxGoTo(21,35)
  116. rc = RxPutChars(intense yellow 'Enjoy !' reset ) 
  117.  
  118. /* Initialise a few variables. */
  119. x = 3      
  120. y = 2
  121. fn = ''                            
  122. RETURN
  123.  
  124. /* --------------------------------------------------------------------- */
  125. /* Deal with cursor movement keys.                                       */
  126. /* --------------------------------------------------------------------- */
  127. Movecursor:
  128. IF ch = 'HOME' THEN DO
  129.    x = 3
  130.    y = 2
  131. END
  132. IF ch = 'END' THEN DO
  133.    x = 23
  134.    y = 79
  135. END
  136. IF ch = 'RIGHT' THEN
  137.    y = y + 1
  138. IF ch = 'LEFT' THEN
  139.    y = y - 1
  140. IF ch = 'UP' THEN
  141.    x = x - 1
  142. IF ch = 'DOWN' THEN
  143.    x = x + 1
  144. IF ch = 'ENTER' THEN DO
  145.    y = 1
  146.    x = x + 1
  147. END
  148. IF ch = 'BUTTON_1' THEN DO
  149.    y = mouse_y
  150.    x = mouse_x
  151. END
  152. /* -------------------------- */
  153. /* Ensure cursor is in bounds */
  154. /* -------------------------- */
  155. IF x < 3 THEN
  156.    x = 3
  157. IF x > 22 THEN
  158.    x = 22
  159. IF y < 2 THEN
  160.    y = 2
  161. IF y > 79 THEN
  162.    y = 79
  163. RETURN
  164.  
  165. /* --------------------------------------------------------------------- */
  166. /* Display menus                                                         */
  167. /* --------------------------------------------------------------------- */
  168. dispmenu:
  169. m1 = RxHMenu(1,1,File,Control,Search,Help)      /* draw menu */
  170. menuno = WORDPOS(m1,'FILE CONTROL SEARCH HELP') /* Find entry */ 
  171. IF (lastkey ¬= 'ESCAPE') & (lastkey ¬= 'BUTTON_2') THEN DO
  172.    DO UNTIL (lastkey = 'ENTER') | (lastkey = 'BUTTON_1')
  173. /*                              keep going till they choose an entry */  
  174.       SELECT
  175.        when menuno = 1 THEN     /* Files menu */
  176.           m2 = RxVMenu(2,3,'Edit','Save','Save As','New','Exit')
  177.        when menuno = 2 THEN     /* Control menu */
  178.           m2 = RxVMenu(2,12,'Insert Line', 'Delete Line','Cut','Paste')
  179.        when menuno = 3 THEN     /* Search menu */
  180.           m2 = RxVMenu(2,24,'Enter String', 'Search Again')
  181.        when menuno = 4 THEN     /* Help menu */
  182.           m2 = RxVMenu(2,34,'File', 'Control', 'Search')
  183.        OTHERWISE
  184.       END
  185.       rc = RxLine(2,2,2,79)         /* redraw top of screen */
  186.       IF (lastkey = 'ESCAPE') | (lastkey = 'BUTTON_2') THEN 
  187.         leave
  188.    END
  189.  
  190.    IF (lastkey ¬= 'ESCAPE') & (lastkey ¬= 'BUTTON_2') THEN DO
  191.       m1 = word('FILE CONTROL SEARCH HELP',menuno)   /* get offset of option */ 
  192.       Rc = RxGoTo(24,1)
  193.       SELECT
  194.        When (M1 = FILE) THEN         /* If they chose FILE, process it */       
  195.          CALL menufile
  196.        When (M1 = CONTROL) | (M1 = SEARCH) | (M1 = HELP) THEN DO /* else do this */
  197.          Rc = RxPutChars('OK. 'blue'(Hit any key to continue)'white)
  198.          rc = RxGoTo(24,18)
  199.          fn = RxGetChar()
  200.          rc = RxGoTo(24,1)
  201.          Rc = RxPutChars('                                                 ')
  202.        END
  203.        OTHERWISE
  204.       END
  205.    END
  206. END
  207. rc = RxGoTo(1,1)
  208. rc = RxPutChars(On_black||copies(' ',80))      /* Remove Horizontal menu */                                             
  209. RETURN
  210.  
  211.  
  212. /* --------------------------------------------------------------------- */
  213. /* Process File vertical menu                                            */
  214. /* --------------------------------------------------------------------- */
  215. menufile:
  216. SELECT
  217.   When (M2 = 'Edit') THEN DO         /* Make each option do something */
  218.      Rc = RxPutChars('Enter Filename : ' On_blue)
  219.      fn = RxGetChars(24,18,20,fn)
  220.      rc = RxGoTo(24,1)
  221.      Rc = RxPutChars(On_black '                                                 ')
  222.   END
  223.   When (M2 = 'Save') THEN DO
  224.      Rc = RxPutChars('File Saved 'blue'(Hit any key to continue)'white)
  225.      rc = RxGoTo(24,18)
  226.      rc = RxGetChar()
  227.      rc = RxGoTo(24,1)
  228.      Rc = RxPutChars('                                                 ')
  229.   END
  230.   When (M2 = 'Save As') THEN DO
  231.      Rc = RxPutChars('Enter Filename : ' On_blue)
  232.      fn = RxGetChars(24,18,20,fn)
  233.      rc = RxGoTo(24,1)
  234.      Rc = RxPutChars(On_black '                                                 ')
  235.   END
  236.   When (M2 = 'New') THEN DO
  237.      rc = RxPutChars(cls)
  238.      rc = RxBox(2,1,23,80)
  239.      IF commhndl ¬= '' THEN DO
  240.         rc = RxGoTo(24,65)
  241.         rc = RxPutChars(intense yellow 'ESC+ESC = Menu' reset)
  242.      END
  243.      ELSE DO
  244.         rc = RxGoTo(24,69)
  245.         rc = RxPutChars(intense yellow 'ESC = Menu' reset)
  246.      END
  247.      fn = ''
  248.   END
  249.   When (M2 = 'Exit') THEN DO
  250.      Rc = RxPutChars(white on_black) 
  251.      rc = RxMouse(OFF)            /* turn off mouse support */
  252.      CALL term
  253.      EXIT
  254.   END
  255.   OTHERWISE
  256. END
  257. RETURN
  258.  
  259. /* --------------------------------------------------------------------- */
  260. /* Deregister all the functions from REXX                                */
  261. /* --------------------------------------------------------------------- */
  262. term : procedure
  263. CALL RxFuncDrop 'RXANSIINIT'
  264. CALL RxFuncDrop 'RXGOTO'   
  265. CALL RxFuncDrop 'RXMODE'   
  266. CALL RxFuncDrop 'RXMOUSE'   
  267. CALL RxFuncDrop 'RXLINE'   
  268. CALL RxFuncDrop 'RXLINETYPE'   
  269. CALL RxFuncDrop 'RXHMENU'  
  270. CALL RxFuncDrop 'RXBOX'    
  271. CALL RxFuncDrop 'RXGETCHAR'
  272. CALL RxFuncDrop 'RXGETCHARS'
  273. CALL RxFuncDrop 'RXPUTCHARS'
  274. RETURN 
  275.