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