home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Rice_CMS / gopher24 / gopcliui.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-01-03  |  5.6 KB  |  157 lines
  1. /*
  2.  *        Name: GOPCLIUI REXX
  3.  *              VM TCP/IP Network GOPHER Client user input
  4.  *      Author: Rick Troth, Rice University, Information Systems
  5.  *        Date: 1992-Dec-23
  6.  *
  7.  *       Input: a prompt string
  8.  *      Output: the user's response
  9.  *
  10.  *              Untested with multiples,  but should work that way.
  11.  */
  12.  
  13. /*
  14.  *      Copyright 1992 Richard M. Troth.   This software was developed
  15.  *      with resources provided by Rice University and is intended
  16.  *      to serve Rice's user community.   Rice has benefitted greatly
  17.  *      from the free distribution of software,  therefore distribution
  18.  *      of unmodified copies of this material is not restricted.
  19.  *      You may change your own copy as needed.   Neither Rice
  20.  *      University nor any of its employees or students shall be held
  21.  *      liable for damages resulting from the use of this software.
  22.  */
  23.  
  24. Trace "OFF"
  25.  
  26. /*  fetch fs. stem variable from calling REXX environment  */
  27. 'CALLPIPE REXXVARS 1 | DROP | JOIN 1 /,/' ,
  28.         '| CHANGE /n /,/ | CHANGE /,v /,/ 1 | LOCATE /FS./ | VARLOAD'
  29.  
  30. /*  trouble with plain write,  so fetch current screen contents  */
  31. 'CALLPIPE LITERAL 00 | SPEC 1-2 X2C 1' ,
  32.         '| FULLSCR' fs.tube 'CONDREAD | VAR SCREEN'
  33. Parse Var screen 1 aid 2 cursor 4 screen
  34.  
  35. Do Forever
  36.  
  37.     'PEEKTO PROMPT'
  38.     If rc ^= 0 Then Leave
  39.  
  40.     Parse Var prompt prompt ';' preset
  41.     prompt = Strip(prompt)
  42.     preset = Strip(preset)
  43.  
  44.     /* --------------------------------------------------------- GPROMPT
  45.      *  Present a prompt and read from the Gopher user's screen.
  46.      *  Preset response data may have been supplied.
  47.      */
  48.  
  49.     prompt = fs.write || 'C3'x || screen || ,
  50.             sba(1,-1) || field("PROT","GREEN") || prompt ,
  51.             || field("HIGH","WHITE") || '13'x || preset || ,
  52.             Copies('00'x,fs.scrcols*2-Length(prompt)-Length(preset)-4) ,
  53.             || field("PROT")
  54.  
  55.     'CALLPIPE VAR PROMPT | FULLSCR' fs.tube '| VAR RS'
  56.     Parse Var rs With 1 aid 2 . 4 rs
  57.  
  58.     If  aid = '7D'x   /* enter */   Then Do
  59.         Parse Var rs With . '11'x rs
  60.         rs = Substr(rs,3)
  61.         If rs = "" Then rs = preset
  62.         'OUTPUT' rs
  63.         End  /*  If  ..  Do  */
  64.  
  65.     Else 'OUTPUT'
  66.  
  67.     'CALLPIPE VAR CURSOR | SPEC /00C311/ X2C 1 1.2 NEXT' ,
  68.             '/13/ X2C NEXT | FULLSCR' fs.tube 'NOREAD | HOLE'
  69.  
  70.     'READTO'
  71.  
  72.     End  /*  Do  Forever  */
  73.  
  74. Exit rc * (rc ^= 12)
  75.  
  76.  
  77.  
  78.  
  79. /* ----------------------------------------------------------------- SBA
  80.  * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
  81.  * Construct Set Buffer Address order from row and column.
  82.  */
  83.  
  84. SBA:      Procedure Expose fs.
  85.  
  86. arg row , col, .
  87. row = Trunc(row)
  88. col = Trunc(col)
  89.  
  90. /*-----------------------------------------------------------------*/
  91. /* Calculate binary address.                                       */
  92. /*-----------------------------------------------------------------*/
  93.  
  94. offset = row * fs.scrcols + col
  95. Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End
  96.  
  97. if fs.14bit then return '11'x || d2c(offset,2)
  98.  
  99. /*-----------------------------------------------------------------*/
  100. /* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
  101. /*-----------------------------------------------------------------*/
  102.  
  103. 'CALLPIPE var offset'               ,   /* Start with char number.    */
  104.     '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
  105.     '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
  106.     '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
  107.            '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
  108.     '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
  109.     '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
  110.                 '01-09 C1-C9'       ,   /*   buffer address.          */
  111.                 '11-19 D1-D9'       ,   /*                            */
  112.                 '22-29 E2-E9'       ,   /*                            */
  113.                 '30-39 F0-F9'       ,   /*                            */
  114.     '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
  115.     '| var offset'                      /* Put back in variable.      */
  116.  
  117. Return offset
  118.  
  119.  
  120.  
  121. /* --------------------------------------------------------------- FIELD
  122.  * Generate the 3270 DS sequence for extended field attributes
  123.  * (if available).
  124.  */
  125. FIELD:    Procedure Expose fs.
  126. a = '00'x
  127. b = '00'x
  128. c = 'F1'x
  129. i = 1
  130. Do While Arg(i) ^= ""
  131.     Select  /*  at  */
  132.         When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)
  133.         When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)
  134.         When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)
  135.         When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)
  136.         When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)
  137.         When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)
  138.         When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)
  139.         When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x
  140.         When Abbrev("RED",Arg(i),3)         Then c = 'F2'x
  141.         When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x
  142.         When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x
  143.         When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x
  144.         When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x
  145.         When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x
  146.         Otherwise nop
  147.         End  /*  Select  at  */
  148.     i = i + 1
  149.     End  /*  Do  While  */
  150.  
  151. If  ^fs.color   | ,
  152.     ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)
  153.                 Else    Return '2902'x || ,
  154.                                'C0'x   || bitor(a,'40'x) || ,
  155.                                '42'x   || bitor(c,'40'x)
  156.  
  157.