TKFAXE ;PG&A,TK-FAX,2.10,FAX EDITOR;17JUL92 12:37P [ 11/22/2000  10:47 AM ]
 ;Copyright (C) 1991-1994, Patterson, Gray and Associates Inc.
 ;
BEG D INIT S %R=1,%C=20 W @TKP,"         F O N T     E D I T O R             ",TK("LO"),!!,TK("CS") S X=TK("HL"),$P(X,X,42)=""
 S %C=38 F R=32:16:255 S %R=3 W @TKP," ",$S(R>99:$E(R),1:"") S %R=4 W @TKP,$E(R+100,2,3) S %C=%C+3
 S %C=33,%R=5 W @TKP,"   ",TK("G1"),TK("TLC"),X,TK("HL"),TK("G0")
 F R=0:1:15 S %R=R+6 W @TKP,LO,$J(R,2)," ",TK("G1"),TK("VL"),TK("G0")," ",HI F C=0:1:13 S CH=C*16+R+32 W $S(CH=32:"sp ",CH=127:"dl ",1:" "_$TR($C(CH),CA,CB)_" ")
 S %R=24,%C=3 W @TKP,LO_"Font is    columns by    rows"
FONT S %R=3,%C=1,PROMPT="Enter Font number ",X="",LNG=3,FNC="EX",CHR="" X ^TKREAD G EXIT:X=""!(FNC="EX") S FNT=X,FNTI=FNT\10*10
 I '$D(^TKFAXF(FNT)) W $C(7) G FONT D NFONT G EXIT:'$D(^TKFAXF(FNT))
 S FR=+^TKFAXF(FNT),FC=$P(^(FNT),"`",2)
 D BOX S CH=32,%R=23,%C=66,CHP="CHP="_TKP,@CHP
CHR X ^TK("ECHO-OFF")
CHR1 S %R=CH-32#16+6,%C=CH\16*3+32,Y=$S(CH=32:"sp",CH=127:"dl",1:" "_$TR($C(CH),CA,CB)_" ") W CHP,CH,"  ",@TKP,TK("RON")_Y_TK("ROF")
CHR2 R X#1 X TK("T") S:X="" TKF=$P(TKY,"\",$A(TKX,$F(TKX,ZF))+2) I X]"" W @TKP,Y S CH=$A(X) G CHR1
 G CCR:TKF="CR" W @TKP,Y G @("C"_TKF):"UK,DK,LK,RK,EX,CR"[TKF,CHR2
CUK S:CH>32 CH=CH-1 G CHR1
CDK S:CH<255 CH=CH+1 G CHR1
CLK S:CH>47 CH=CH-16 G CHR1
CRK S:CH<240 CH=CH+16 G CHR1
CEX G FONT
CCR D DSP,EDIT G CHR
END K X1,FC,FNT,FTNI,JJ,Y,R,X,TKF,FONT Q
EDIT S %R=7,%C=4
EDT1 W @TKP S R=%R-6 R X#1 I X="" X TK("T") S TKF=$P(TKY,"\",$A(TKX,$F(TKX,ZF))+2) G:"UK,DK,RK,LK,EX,CR,SE"[$J(TKF,1) @TKF W $C(7) G EDT1
 S FONT(R)=$E(FONT(R),1,%C-4)_$S(X=" ":" ",1:"X")_$E(FONT(R),%C-2,99) W $E(FONT(R),%C-3) G RK
DK S %R=%R+1 S:%R>(FR+6) %R=7 G EDT1
UK S %R=%R-1 S:%R<7 %R=FR+6 G EDT1
RK S %C=%C+1 S:%C>(FC+3) %C=4 G EDT1
LK S %C=%C-1 S:%C<4 %C=FC+3 G EDT1
CR S %C=4 G EDT1
SE S %R=24,%C=40 W @TKP,"(Reverse,Invert,Flip,Up,Down)-" R X#1 W @TKP,TK("CL")
 I X="R" F J=1:1 Q:$D(FONT(J))=0  S FONT(J)=$TR(FONT(J),"01","10")
 I X="U" S A=FONT(1) F J=1:1 S FONT(J)=FONT(J+1) I $D(FONT(J+2))=0 S FONT(J+1)=A Q
 I X="D" X "F J=0:1 Q:'$D(FONT(J+1))" S A=FONT(J) F J=J-1:-1:1 S FONT(J+1)=FONT(J) I J=1 S FONT(J)=A Q
 D DSPP G EDIT
EX S %C=4 I '$D(^TKFAXT) F JJ=1:1 Q:'$D(^TKFAXF(FNTI,.3,JJ))  S ^TKFAXT(^(JJ))=JJ
 F R=1:1:FR S %R=R+6 W @TKP,$J("",FC) S X=$TR(FONT(R)," X","01") D CMPL S:'$D(^TKFAXT(Y)) ^TKFAXT(Y)=JJ,^TKFAXF(FNTI,.3,JJ)=Y,JJ=JJ+1 D EX1
 Q
EX1 S:$D(^TKFAXF(FNT,0,CH,R)) ^(R)=X S:$D(^TKFAXF(FNT,CH,R)) ^(R)=Y
 S Y=^TKFAXT(Y),^TKFAXF(FNT,.1,R)=$E(^TKFAXF(FNT,.1,R),1,CH-32)_$C(Y#256)_$E(^(R),CH-31+1,255) Q:JJ<256
 S ^TKFAXF(FNT,.2,R)=$E(^TKFAXF(FNT,.2,R),1,CH-32)_$C(Y\256)_$E(^(R),CH-31+1,255) Q
CMPL S Y="",D=1
CMPL1 S (L,M)=$F(X,1,D) S:L=0 L=FC+2 S L=L-D-1 S:L<1 L=0 S Y=Y_$S(Y="":L,M:wht(L),1:","_L),W=D+L
 I W<(FC+1) S L=$F(X,0,W) S:L=0 L=FC+2 S L=L-W-1,Y=Y_$S(Y[",":"",1:",")_blk(L),D=W+L G CMPL1
 Q
DSP K FONT I $D(^TKFAXF(FNT,.4)) S FC=$A(^TKFAXF(FNT,.4),CH) D BOX
 F R=1:1:FR S X=$S($D(^TKFAXF(FNT,.2,R)):$A(^(R),CH-31)*256+$A(^TKFAXF(FNT,.1,R),CH-31),$D(^TKFAXF(FNT,.1,R)):$A(^(R),CH-31),1:0) D DSP1 S FONT(R)=$TR(X," X","01")
DSPP S %C=4 F R=1:1:FR S %R=R+6 W @TKP,$TR(FONT(R),"01"," X")
 Q
DSP1 I 'X S X=$J("",FC) Q
 S W=0,X1=^TKFAXF(FNTI,.3,X) I X1?.N S X=$J("",X1) Q
 S X=$P(X1,",",2),ZZ=0,Y="",(Y1,Y2)=0 D DECODE^TKFAXD S X=$J("",+X1) F K=1:1:$L(Y,"+") S:K#2 X=X_$E("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",1,+$P(Y,"+",K)) S:K#2=0 X=X_$J("",+$P(Y,"+",K))
 S X=X_$J("",$P(X1,",",3)) Q
BOX S %R=24,%C=11 W @TKP,$J(FC,2) S %C=25 W @TKP,$J(FR,2) S %C=1 F %R=6:1:23 W @TKP,$S(%R>6&(%R<(FR+7)):$J(%R-6,2),1:"  "),PAD
 S %C=3,LNG=$S('FC:12,1:FC),TT=6,NT=FR N TW,TE,TM S %C=3,TW=LNG
 S TE=TK("VL")_$J("",TW)_TK("VL"),TM="",$P(TM,TK("HL"),TW+1)="" D 1,2,3
 Q
1 S %R=TT W @TKP,TK("G1")_TK("TLC")_TM_TK("TRC")_TK("G0") Q
2 W TK("G1") F %R=TT+1:1:TT+NT W @TKP,TE
 W TK("G0") Q
3 S %R=TT+NT+1 W @TKP,TK("G1")_TK("BLC")_TM_TK("BRC")_TK("G0") Q
4 W TK("G1") F %R=TT+NT:-1:TT+1 W @TKP,TE
 W TK("G0") Q
NFONT S %R=24,%C=11,LNG=2,FNC="EX",X="" X ^TKREAD Q:X=""!(FNC="EX")  S FC=X
 S %R=24,%C=25,LNG=2,FNC="EX",X="" X ^TKREAD Q:X=""!(FNC="EX")  S FR=X
 S ^TKFAXF(FNT)=FR_"`"_FC Q
INIT S HI=TK("HI"),LO=TK("LO") K ^TKFAXT
 S (CA,CB)=" " I TK["VT" S FR="P",TO="VT" D CHARSET^TKINIT2
 S PAD=$J("",31)
 F I=0:1:32 S wht(I)=^TKFAXC(0,0,I),blk(I)=^TKFAXC(0,1,I)
 Q
EXIT K FNT,X,HI,LO,Y,O,X,FONT,CH,wht,blk,PAD Q
ER W $C(7) Q