home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / kdraw.zip / Draw.kex next >
Text File  |  1998-09-12  |  8KB  |  248 lines
  1. ** (c) Copyright International Business Machines Corporation 1994, 1998.
  2. *                  All Rights Reserved.
  3. *
  4. *     KEDIT macro: DRAW box characters
  5. *     Version: 1.23
  6. *     Author: Shintaroh Hori      (shori@jp.ibm.com)     Yamato, IBM Japan
  7. */
  8. /* Changeable by User's preference.  Note that they Must be uppercase. */
  9. exitkey='ESC'; penkey='C-F1'; altpen='C-F2'; arrkey='C-F3'
  10.  
  11. penup?=0 ; w? =0 ; a?=0  /* initialize */
  12. arg lang .
  13. if lang \='ALT' then do /* box chars of single/double line for US code page */
  14.    bc. = ' ' /* blank for non-box chracters */
  15.    bc.0=3    /* (# of line combination)-1   */
  16.    bc.1.0 ='BF'x;bc.1.1 ='B8'x;bc.1.2 ='B7'x;bc.1.3 ='BB'x  /* ┐  ╕  ╖  ╗   */
  17.    bc.2.0 ='B4'x;bc.2.1 ='B5'x;bc.2.2 ='B6'x;bc.2.3 ='B9'x  /*  ┤  ╡  ╢  ╣  */
  18.    bc.3.0 ='D9'x;bc.3.1 ='BE'x;bc.3.2 ='BD'x;bc.3.3 ='BC'x  /* ┘  ╛  ╜  ╝   */
  19.    bc.4.0 ='C1'x;bc.4.1 ='CF'x;bc.4.2 ='D0'x;bc.4.3 ='CA'x  /* ┴  ╧  ╨  ╩   */
  20.    bc.5.0 ='C0'x;bc.5.1 ='D4'x;bc.5.2 ='D3'x;bc.5.3 ='C8'x  /* └  ╘  ╙  ╚   */
  21.    bc.6.0 ='C3'x;bc.6.1 ='C6'x;bc.6.2 ='C7'x;bc.6.3 ='CC'x  /* ├  ╞  ╟  ╠   */
  22.    bc.7.0 ='DA'x;bc.7.1 ='D5'x;bc.7.2 ='D6'x;bc.7.3 ='C9'x  /* ┌  ╒  ╓  ╔   */
  23.    bc.8.0 ='C2'x;bc.8.1 ='D1'x;bc.8.2 ='D2'x;bc.8.3 ='CB'x  /*  ┬  ╤  ╥  ╦  */
  24.    bc.9.0 ='C5'x;bc.9.1 ='D8'x;bc.9.2 ='D7'x;bc.9.3 ='CE'x  /* ┼  ╪  ╫  ╬   */
  25.    bc.10.0='C4'x;bc.10.1='CD'x;bc.10.2='C4'x;bc.10.3='CD'x  /* ─  ═  ─  ═   */
  26.    bc.11.0='B3'x;bc.11.1='B3'x;bc.11.2='BA'x;bc.11.3='BA'x  /* │  │  ║  ║   */
  27.    arrcnt = 1
  28.    arrows.0 = '18'x '19'x '1A'x '1B'x                       /*    EOF    */
  29.    arrows.1 = '1E'x '1F'x '10'x '11'x                       /*          */
  30. end
  31. else do /* box chars of double line for Japanese code pages 932 and 942 */
  32.    altpen = '__!!' /* kill AltPen key because only double lines are available */
  33.    bc.0 = 0
  34.    bc.1.0= '02'x
  35.    bc.2.0= '17'x
  36.    bc.3.0= '04'x
  37.    bc.4.0= '15'x
  38.    bc.5.0= '03'x
  39.    bc.6.0= '19'x
  40.    bc.7.0= '01'x
  41.    bc.8.0= '16'x
  42.    bc.9.0= '10'x
  43.    bc.10.0='06'x
  44.    bc.11.0='05'x
  45.    arrcnt = 0
  46.    arrows.0 = '1C'x '07'x '1E'x '1F'x
  47. end
  48. sp = ' '
  49. call SetBoxVars
  50. call SetArrVars
  51.  
  52. /* verify if this macro is run under KEDIT or other editor */
  53. parse source . . this
  54. if pos('.', this)=0 then ked?=1 /* KEXX macro, so KEDIT */
  55. else    /* REXX */       ked? = ( address()=='KEDIT' )
  56.  
  57. call SetDrawID ThisFileID()   /* store current file id */
  58.  
  59. move.CURR = 'cursor right'
  60. move.CURL = 'cursor left '
  61. move.CURU = 'cursor up   '
  62. move.CURD = 'cursor down '
  63.  
  64. csrkey ='CURU CURD CURR CURL'
  65. csrkey2='A-CURU A-CURD A-CURR A-CURL'
  66. call SetKID
  67.  
  68. hlpLine.0 = altpen'=Double Line'
  69. hlpLine.1 = altpen'=Single Line'
  70. hlpArrow  = arrkey'=Alter Arrow'
  71. if lang='ALT' then do;hlpLine.='';hlpArrow='';end /*suppress for Japanese code*/
  72.  
  73. if ked? then do
  74.   blink = blink.1() ; 'set blink off'
  75.   maccmd ='MACRO'
  76. end
  77. else maccmd ='HIT'
  78.  
  79. 'EXTRACT /cmdline/';if cmdline.1='BOTTOM' & ked? then cl= '-2';else cl='-1'
  80. help.0=cl 'Blue on Bright green' exitkey'=Exit Csr=Draw Box A-Csr=Arrow 'penkey'=PenUp  '
  81. help.1=cl 'Blue on Bright magen' exitkey'=Exit Csr=Draw Box A-Csr=Arrow 'penkey'=PenDown'
  82. 'cursor home'
  83. lastkey = sp
  84.  
  85. call DispHelp
  86. kth = 0; ktv= 0
  87. do forever
  88.    'READV key noignoremouse'
  89.    if rc \= 0 then do
  90.       call beep 2000, 60
  91.       msg ='Mouse is ignored while Draw macro is effective.'
  92.       'dialog /'msg'/ TITLE /Information!/'
  93.       iterate
  94.    end
  95.    key = readv.1
  96.    kid = kid.key
  97.    dfid?  = ChkDrawID()
  98.    keyflg0 = lk2f.lastkey
  99.    keyflg1 = ck2f.key
  100.    if ( \penup? & (keyflg0\=keyflg1) & \ InCmdLine() & dfid? ) then do
  101.       if kid=1 then do; call DrawBox ; iterate; end
  102.       if kid=2 then do
  103.          'text' k2a.key.a? ; 'cursor left'
  104.          key = substr(key,3)
  105.          lastkey = key
  106.          ''move.key
  107.         iterate
  108.       end
  109.    end
  110.    if key = exitkey & dfid? then leave
  111.    if kid > 3 then do
  112.       if key = penkey      then penup?=\(penup?)
  113.       else if key = altpen then w?=\(w?);
  114.       else if key = arrkey then a?=\(a?);
  115.       call DispHelp
  116.       iterate
  117.    end
  118.    lastkey=sp; ''maccmd key  /* process this key */
  119. end
  120. 'set reserved' cl 'off'
  121. call SetDrawID
  122. if ked? then 'set blink' blink
  123.  
  124. EXIT 0
  125. /*-----------------------------------------------*/
  126. /*       functions                               */
  127. /*-----------------------------------------------*/
  128. DrawBox:
  129.    if keyflg1 = 1 | keyflg1 = 8 then kth=w? ; else ktv=w?
  130.    'EXTRACT /field/'; char= field.2 /* get char at cursor */
  131.    new = d2c(keyflg0+keyflg1)
  132.    if pos(char,bcall) =0 then tid = ktv || kth
  133.    else do
  134.       new = bitor(new,b2f.char)
  135.       if keyflg1=1 | keyflg1=8 then tid = b2tv.char || kth
  136.                                else tid = ktv || b2th.char
  137.    end
  138.    'text' f2b.tid.new ;'cursor left'
  139.    ''move.key
  140.    'EXTRACT /field/'; char= field.2 /* get char at cursor */
  141.    if pos(char,bcall) \=0 then do
  142.       new = bitor(d2c(lk2f.key),b2f.char)
  143.       if keyflg1=1 | keyflg1=8 then tid = b2tv.char || kth
  144.                                else tid = ktv || b2th.char
  145.       'text' f2b.tid.new ;'cursor left'
  146.     end
  147.    lastkey = key
  148. return
  149.  
  150. SetDrawID: procedure
  151.   parse arg fid
  152.   'editv setf DRAWFILE' fid
  153. return
  154. ChkDrawID: /* Return TRUE if being in a valid file */
  155.   'editv getf DRAWFILE'
  156.   if drawfile = ThisFileID() then return 1
  157.   'msg Though DRAW macro is in effect, you cannot draw a line in this file.'
  158. return 0
  159.  
  160. SetBoxVars:
  161. /* define flag values for box characters */
  162. cf.1 ='C'x; /* ┐ */ cf.2 ='E'x; /* ┤ */ cf.3 ='A'x; /* ┘ */ cf.4 ='B'x; /* ┴ */
  163. cf.5 ='3'x; /* └ */ cf.6 ='7'x; /* ├ */ cf.7 ='5'x; /* ┌ */ cf.8 ='D'x; /* ┬ */
  164. cf.9 ='F'x; /* ┼ */ cf.10='9'x; /* ─ */ cf.11='6'x; /* │ */ cf.12='0'x; /*   */
  165. /* set flags for last key and current key. (Used for ADD, but not for OR) */
  166. lk2f.     = 0 ;
  167. lk2f.CURR = 8 ;   ck2f.CURR = 1
  168. lk2f.CURL = 1 ;   ck2f.CURL = 8
  169. lk2f.CURU = 4 ;   ck2f.CURU = 2
  170. lk2f.CURD = 2 ;   ck2f.CURD = 4
  171.  
  172. type.0 ='00'; type.1 ='01'; type.2 ='10'; type.3 ='11'
  173. bcall=''
  174. b2f. = cf.12  /* treat non-box characters as blank */
  175. f2b. = ' '    /* treat invalid flag value as blank */
  176. /* Be careful that KEXX cannot handle '0'x for index variable for stem */
  177. do i=1 to 12
  178.    flg = cf.i
  179.    do j=0 to bc.0
  180.      c=bc.i.j
  181.      if c \==sp then bcall = bcall || c
  182.      t=type.j
  183.      b2f.c =flg
  184.      f2b.t.flg =c
  185.      b2th.c = substr(type.j,2,1)
  186.      b2tv.c = substr(type.j,1,1)
  187.    end
  188. end
  189. kr0='1'x; ku0='2'x; kd0='4'x; kl0='8'x;  /* flags for cursor keys */
  190. do j=0 to bc.0 by 3
  191.    t=type.j
  192.    hb = bc.10.j
  193.    vb = bc.11.j
  194.    f2b.t.kr0 = hb
  195.    f2b.t.kl0 = hb
  196.    f2b.t.ku0 = vb
  197.    f2b.t.kd0 = vb
  198. end
  199. t='01'
  200. f2b.t.kr0 = bc.10.3
  201. f2b.t.kl0 = bc.10.3
  202. f2b.t.ku0 = bc.11.0
  203. f2b.t.kd0 = bc.11.0
  204. t='10'
  205. f2b.t.kr0 = bc.10.0
  206. f2b.t.kl0 = bc.10.0
  207. f2b.t.ku0 = bc.11.3
  208. f2b.t.kd0 = bc.11.3
  209. return
  210.  
  211. SetArrVars:
  212.   ari0='A-CURR'; ale0='A-CURL'; aup0='A-CURU'; ado0='A-CURD'
  213.   do i=0 to arrcnt
  214.     parse var arrows.i aup ado ari ale
  215.     k2a.ari0.i = ari
  216.     k2a.ale0.i = ale
  217.     k2a.aup0.i = aup
  218.     k2a.ado0.i = ado
  219.   end
  220. return
  221.  
  222. SetKID:
  223.   kid.= 0
  224.   do i=1 to words(csrkey);  k=word(csrkey,i);  kid.k=1; end
  225.   do i=1 to words(csrkey2); k=word(csrkey2,i); kid.k=2; end
  226.   kid.exitkey=3
  227.   kid.penkey=4
  228.   kid.altpen=5
  229.   kid.arrkey=6
  230. return
  231.  
  232. DispHelp:
  233.   'set reserved' help.penup? hlpLine.w? hlpArrow
  234. return
  235.  
  236. /*---------------------------*/
  237. InCmdLine:
  238.   if ked? then return command()
  239.           else return incommand()
  240.  
  241. ThisFileID:
  242.   if ked? then return fileid.1()
  243.   else do /* other clone editor */
  244.      'EXTRACT /FPATH/FNAME/FEXT/'
  245.      if fext.1=='' then return fpath.1 || fname.1
  246.      else return fpath.1 || fname.1'.'fext.1
  247.   end
  248.