home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
kdraw.zip
/
DrawJ.kex
< prev
next >
Wrap
Text File
|
1998-09-12
|
8KB
|
227 lines
** (c) Copyright International Business Machines Corporation 1994, 1998.
* All Rights Reserved.
*
* KEDIT macro: Draw box characters of DBCS
* Version: 1.23
* Author: Shintaroh Hori (shori@jp.ibm.com) Yamato, IBM Japan
*/
/* Changeable by User's preference. Note that they Must be uppercase. */
exitkey='ESC'; penkey='C-F1'; altpen='C-F2'
penup?=0 ; w? =0 ; a?=0 /* initialize */
sp = ' '
bc. = sp /* blank for non-box chracters */
bc.0=3 /* (# of line combination)-1 */ /*---437 box ---*/
bc.1.0 ='84A2'x;bc.1.1 ='84A2'x;bc.1.2 ='84A2'x;bc.1.3 ='84AD'x /* ┐ ╕ ╖ ╗ */
bc.2.0 ='84A7'x;bc.2.1 ='84BC'x;bc.2.2 ='84B7'x;bc.2.3 ='84B2'x /* ┤ ╡ ╢ ╣ */
bc.3.0 ='84A3'x;bc.3.1 ='84A3'x;bc.3.2 ='84A3'x;bc.3.3 ='84AE'x /* ┘ ╛ ╜ ╝ */
bc.4.0 ='84A8'x;bc.4.1 ='84B8'x;bc.4.2 ='84BD'x;bc.4.3 ='84B3'x /* ┴ ╧ ╨ ╩ */
bc.5.0 ='84A4'x;bc.5.1 ='84A4'x;bc.5.2 ='84A4'x;bc.5.3 ='84AF'x /* └ ╘ ╙ ╚ */
bc.6.0 ='84A5'x;bc.6.1 ='84BA'x;bc.6.2 ='84B5'x;bc.6.3 ='84B0'x /* ├ ╞ ╟ ╠ */
bc.7.0 ='84A1'x;bc.7.1 ='84A1'x;bc.7.2 ='84A1'x;bc.7.3 ='84AC'x /* ┌ ╒ ╓ ╔ */
bc.8.0 ='84A6'x;bc.8.1 ='84B6'x;bc.8.2 ='84BB'x;bc.8.3 ='84B1'x /* ┬ ╤ ╥ ╦ */
bc.9.0 ='84A9'x;bc.9.1 ='84B9'x;bc.9.2 ='84BE'x;bc.9.3 ='84B4'x /* ┼ ╪ ╫ ╬ */
bc.10.0='849F'x;bc.10.1='84AA'x;bc.10.2='849F'x;bc.10.3='84AA'x /* ─ ═ ─ ═ */
bc.11.0='84A0'x;bc.11.1='84A0'x;bc.11.2='84AB'x;bc.11.3='84AB'x /* │ │ ║ ║ */
arrcnt = 0
arrows.0 = '81AA'x '81AB'x '81A8'x '81A9'x /* EOF */
call SetBoxVars
call SetArrVars
/* verify if this macro is run under KEDIT or other editor */
parse source . . this
if pos('.', this)=0 then ked?=1 /* KEXX macro, so KEDIT */
else /* REXX */ ked? = ( address()=='KEDIT' )
call SetDrawID ThisFileID() /* store current file id */
move.CURR = 'cursor right'
move.CURL = 'cursor left '
move.CURU = 'cursor up '
move.CURD = 'cursor down '
csrkey ='CURU CURD CURR CURL'
csrkey2='A-CURU A-CURD A-CURR A-CURL'
call SetKID
hlpLine.0 = altpen'=Bold Line'
hlpLine.1 = altpen'=Single Line'
if ked? then do
blink = blink.1() ; 'set blink off'
maccmd ='MACRO'
end
else maccmd ='HIT'
'EXTRACT /cmdline/';if cmdline.1='BOTTOM' & ked? then cl= '-2';else cl='-1'
help.0=cl 'Blue on Bright green' exitkey'=Exit Csr=Draw Box A-Csr=Arrow 'penkey'=PenUp '
help.1=cl 'Blue on Bright magen' exitkey'=Exit Csr=Draw Box A-Csr=Arrow 'penkey'=PenDown'
'cursor home'
lastkey = sp
call DispHelp
kth = 0; ktv= 0
do forever
'READV key noignoremouse'
if rc \= 0 then do
call beep 2000, 60
msg ='Mouse is ignored while DrawJ macro is effective.'
'dialog /'msg'/ TITLE /Information!/'
iterate
end
key = readv.1
kid = kid.key
dfid? = ChkDrawID()
keyflg0 = lk2f.lastkey
keyflg1 = ck2f.key
if ( \penup? & (keyflg0\=keyflg1) & \ InCmdLine() & dfid? ) then do
if kid=1 then do; call DrawBox ; iterate; end
if kid=2 then do
'text' k2a.key.a? ; 'cursor left' ; 'cursor left'
key = substr(key,3)
lastkey = key
''move.key
if ck2f.key =1 | ck2f.key=8 then ''move.key /* DBCS key movement */
iterate
end
end
if key = exitkey & dfid? then leave
if kid > 3 then do
if key = penkey then penup?=\(penup?)
else if key = altpen then w?=\(w?);
call DispHelp
iterate
end
lastkey=sp; ''maccmd key /* process this key */
if keyflg1 =1 | keyflg1=8 then ''move.key /* DBCS key movement */
end
'set reserved' cl 'off'
call SetDrawID
if ked? then 'set blink' blink
EXIT 0
/*-----------------------------------------------*/
/* functions */
/*-----------------------------------------------*/
DrawBox:
if keyflg1 = 1 | keyflg1 = 8 then kth=w? ; else ktv=w?
'EXTRACT /field/'; char= substr(field.1, field.3, 2) /* DBCS chars */
new = d2c(keyflg0+keyflg1)
if pos(char,bcall) =0 then tid = ktv || kth
else do
new = bitor(new,b2f.char)
if keyflg1=1 | keyflg1=8 then tid = b2tv.char || kth
else tid = ktv || b2th.char
end
'text' f2b.tid.new ;'cursor left' ; 'cursor left'
''move.key
if keyflg1 =1 | keyflg1=8 then ''move.key /* DBCS key movement */
'EXTRACT /field/'; char= substr(field.1, field.3, 2) /* DBCS chars */
if pos(char,bcall) \=0 then do
new = bitor(d2c(lk2f.key),b2f.char)
if keyflg1=1 | keyflg1=8 then tid = b2tv.char || kth
else tid = ktv || b2th.char
'text' f2b.tid.new ;'cursor left' ; 'cursor left'
end
lastkey = key
return
SetDrawID: procedure
parse arg fid
'editv setf DRAWFILE' fid
return
ChkDrawID: /* Return TRUE if being in a valid file */
'editv getf DRAWFILE'
if drawfile = ThisFileID() then return 1
'msg Though DRAW macro is in effect, you cannot draw a line in this file.'
return 0
SetBoxVars:
/* define flag values for box characters */
cf.1 ='C'x; /* ┐ */ cf.2 ='E'x; /* ┤ */ cf.3 ='A'x; /* ┘ */ cf.4 ='B'x; /* ┴ */
cf.5 ='3'x; /* └ */ cf.6 ='7'x; /* ├ */ cf.7 ='5'x; /* ┌ */ cf.8 ='D'x; /* ┬ */
cf.9 ='F'x; /* ┼ */ cf.10='9'x; /* ─ */ cf.11='6'x; /* │ */ cf.12='0'x; /* */
/* set flags for last key and current key. (Used for ADD, but not for OR) */
lk2f. = 0 ;
lk2f.CURR = 8 ; ck2f.CURR = 1
lk2f.CURL = 1 ; ck2f.CURL = 8
lk2f.CURU = 4 ; ck2f.CURU = 2
lk2f.CURD = 2 ; ck2f.CURD = 4
type.0 ='00'; type.1 ='01'; type.2 ='10'; type.3 ='11'
bcall=''
b2f. = cf.12 /* treat non-box characters as blank */
f2b. = sp /* treat invalid flag value as blank */
b2th. = '' ; b2tv. = '' /* DBCS */
/* Be careful that KEXX cannot handle '0'x for index variable for stem */
do i=1 to 12
flg = cf.i
do j=0 to bc.0
c=bc.i.j
if c \==sp then bcall = bcall || c
t=type.j
b2f.c =flg
f2b.t.flg =c
if b2th.c == '' then b2th.c = substr(type.j,2,1) /* DBCS */
if b2tv.c == '' then b2tv.c = substr(type.j,1,1) /* DBCS */
end
end
kr0='1'x; ku0='2'x; kd0='4'x; kl0='8'x; /* flags for cursor keys */
do j=0 to bc.0 by 3
t=type.j
hb = bc.10.j
vb = bc.11.j
f2b.t.kr0 = hb
f2b.t.kl0 = hb
f2b.t.ku0 = vb
f2b.t.kd0 = vb
end
t='01'
f2b.t.kr0 = bc.10.3
f2b.t.kl0 = bc.10.3
f2b.t.ku0 = bc.11.0
f2b.t.kd0 = bc.11.0
t='10'
f2b.t.kr0 = bc.10.0
f2b.t.kl0 = bc.10.0
f2b.t.ku0 = bc.11.3
f2b.t.kd0 = bc.11.3
return
SetArrVars:
ari0='A-CURR'; ale0='A-CURL'; aup0='A-CURU'; ado0='A-CURD'
do i=0 to arrcnt
parse var arrows.i aup ado ari ale
k2a.ari0.i = ari
k2a.ale0.i = ale
k2a.aup0.i = aup
k2a.ado0.i = ado
end
return
SetKID:
kid.= 0
do i=1 to words(csrkey); k=word(csrkey,i); kid.k=1; end
do i=1 to words(csrkey2); k=word(csrkey2,i); kid.k=2; end
kid.exitkey=3
kid.penkey=4
kid.altpen=5
return
DispHelp:
'set reserved' help.penup? hlpLine.w? /* DBCS version */
return
/*---------------------------*/
InCmdLine:
if ked? then return command()
else return incommand()
ThisFileID:
if ked? then return fileid.1()
else do /* other clone editor */
'EXTRACT /FPATH/FNAME/FEXT/'
if fext.1=='' then return fpath.1 || fname.1
else return fpath.1 || fname.1'.'fext.1
end