TKREAD ;PG&A,TOOLKIT I,2.25,GENERAL INPUT ROUTINE (Create ^TKREAD);30JAN95 3:04P;;;20SEP97  10:19 [ 11/22/2000  10:47 AM ]
 ;Copyright (C) 1985, Patterson, Gray and Assoc., Inc.
 ;
 ;  Must set %R,%C, & X before executing.
 ;
 ;If RX is defined when TKREAD is executed, then TKREAD returns:    
 ;  RX=1 (Cursor Up) RX=2 (Cursor Down) RX=3 (Tab) RX=4 (Cursor Left)
 ;  RX=5 (Cursor Right)  RX=0 (Other)  RX=terminator (if TRM set)
 ;  RX=-1 (timeout when TIM set)
 ;
 ;Other variables that may be used: LNG,CHR,ESC,TIM,TRM,UC,TKCC,MIN,MAX,PAT
 ;    FNC,PROMPT,AUTO
 ;
SETUP K ^TKREAD S TK("OS")=^TK("OS"),A=$P($T(READ)," ",2,99),^TKREAD=A
 I TK("OS")="DTM" S ^TKREAD=$ZXECUTE(A) F I=1:1 S A=$T(READ+I) Q:A=""  S B=$P(A," ",2,255),A=$P(A," "),^TKREAD(A)=$ZXECUTE(B)
 I TK("OS")'="DTM" F I=1:1 S A=$T(READ+I) Q:A=""  S B=$P(A," ",2,255),A=$P(A," "),^TKREAD(A)=B
 K A,B,I Q
 ;
TEST D:'$D(TK) INIT^TKDEV S TKCC=1,X="123456789012345678901234567890"
T1 S PROMPT="X=",%R=24,%C=37,LNG=30,RX=0,TRM="Q",FNC=^TK(.3) W @TKP,"|" S %C=5 X ^TKREAD W !!,X,"  RX=",RX,"  TKCC=",TKCC,"  FNC=",FNC,!! G T1
 ;
READ D:$D(TK)=0 INIT^TKDEV N TKi,TKj S TKi=0 F TKj=0:0 X ^TKREAD(TKi) Q:TKi=99
0 S TKi=10,TKl=$S($D(TKCC):TKCC,1:1),ESC=0,TKf="" S:$D(FNC) TKf=FNC,FNC="" X:$D(PROMPT) ^(2) S:$D(LNG)=0 LNG=79-%C S:TKl>LNG TKl=LNG
1 S TKi=3 F TKj=0:0 R TKC#1:TIM S:'$T TKi=16 Q:TKC=""  S:$D(UC) TKC=$S(TKC?1L:$C($A(TKC)-32),1:TKC) S:$D(TRM) ESC=TRM[TKC S:ESC TKi="CR" S:CHR'=""&(CHR'[TKC) TKi=7 Q:TKi'=3  S:TKl'<LNG TKi=6 Q:TKi'=3  W TKC S X=$E(X,1,TKl-1)_TKC_$E(X,TKl+1,255),TKl=TKl+1
2 W @TKP,TK("LO"),PROMPT,TK("HI"),X S %C=%C+$L(PROMPT)
3 X TK("T") S ZF=$P(^TK(.3),"\",$A(^TK(.3,TK,0),$F(^(0),ZF))+2),TKi=$S(ZF="":7,TKf[ZF:17,$D(^TKREAD(ZF)):ZF,1:7)
RK X $S(TKl<LNG:"W TK(""RT"") S TKl=TKl+1,TKi=1",$D(RX):"S RX=5,TKi=""CR""",1:"S TKi=1")
LK X $S(TKl>1:"S TKl=TKl-1,TKi=1 W TK(""L"")",$D(RX):"S RX=4,TKi=""CR""",1:"S TKi=1")
6 S:TKl>LNG TKi=7 Q:TKi=7  W TKC S X=$E(X,1,TKl-1)_TKC_$E(X,TKl+1,255),TKl=TKl+1,TKi=$S($D(AUTO)#2=0:1,AUTO:"CR",1:1)
7 W $C(7) S TKi=1
DC W $E(X,TKl+1,256)," " S X=$E(X,1,TKl-1)_$E(X,TKl+1,256)_" ",TKi=1 W @TKP,$E(X,1,TKl-1)
RU S TKi=1 I TKl>1 S X=$E(X,1,TKl-2)_" "_$E(X,TKl,256),TKl=TKl-1 W $C(8)," ",$C(8)
10 S TKi=1,TKc=%C,%C=%C+TKl-1 W @TKP,TK("HI") S %C=TKc,X=X_$J("",LNG-$L(X)),TIM=$S($D(TIM):TIM,1:99999) X ^TK("TERM-ON"),^TK("WRAP-OFF"),^TK("ECHO-OFF") S:$D(CHR)=0 CHR="" S:$D(RX) RX=0
EF S X=$E(X,0,TKl-1)_$J("",LNG-TKl+1),TKc=%C,%C=%C+TKl-1,TKi=1 W @TKP,$J("",LNG-TKl+1),@TKP S %C=TKc K TKc
CR S TKc=X,TKi=13 S:ESC RX=TKC I $E(X,$L(X))=" " F TKj=0:0 S TKj=$F(X," ",TKj) Q:'TKj  I $E(X,TKj,255)?." " S X=$E(X,1,TKj-2) Q
13 S:X="" TKi=20 I X'="" X:$D(PAT) "I $L(PAT) S TKi=19 I @PAT S TKi=13" X:TKi=13 "I $D(MAX),X>MAX S TKi=19" X:TKi=13 "I $D(MIN),X<MIN S TKi=19" S:TKi=13 TKi=20
IC X $S($E(X,LNG)'=" ":"W $C(7)",1:"W "" "",$E(X,TKl,LNG-1) S X=$E(X,1,TKl-1)_"" ""_$E(X,TKl,LNG-1) W @TKP,$E(X,1,TKl-1)") S TKi=1
UK S TKi="CR" S @$S(TKf[ZF:"TKf=ZF",$D(RX):"RX=1",1:"TKi=7")
DK S TKi="CR" S @$S(TKf[ZF:"TKf=ZF",$D(RX):"RX=2",1:"TKi=7")
TB S TKi="CR" S @$S(TKf[ZF:"TKf=ZF",$D(RX):"RX=3",1:"TKi=7")
16 S RX=-1,TKi=20
17 S FNC=ZF,TKi="CR"
19 S X=TKc,(TKi,TKl)=1,ESC=0 S:$D(RX) RX=0 W $C(7),@TKP
20 X ^TK("ECHO-ON"),^TK("TERM-OFF"),^TK("WRAP-ON") S:$D(TKCC) TKCC=TKl K PROMPT,MAX,MIN,LNG,CHR,PAT,TRM,UC,ZF,TIM,TKj,TKc,TKl,TKf S TKi=99