OBJNAM TCRT.SBR ; Created Sept/84, Last modified 23-Nov-84
; Subroutine to return TCRT calls to a BASIC string
; by Irv Bromberg, Medic/OS Consultants
; 78 Wildginger Way, Toronto, Ontario, CANADA   M3H 5X1
RADIX 10
VEDIT=5
VMINOR=4
VMAJOR=1
VSUB=0

IF EQ,1

Calling syntax: XCALL TCRT,String,TCRT#...unlimited list of TCRT calls

With a TCRT call# as a floating parameter the string returned will
be equivalent to TAB(-1,TCRT#).  If the TCRT# is an unformatted variable
or a string expression then the first two bytes will be sent as the
TCRT call, example:

MAP1 TCRT
 MAP2 Row,B,1
 MAP2 Column,B,1

Row=12 : Column=34

XCALL TCRT,String,TCRT  to return a required cursor address sequence,

or one can simply use:  XCALL TCRT,String,CHR(Row)+CHR(Column)

Possible errors are signalled by ^C operator interrupt to BASIC, if
the number of parameters passed is <2 or the String has null dimensions
or if the TCRT calls overflowed the String's dimensioned length.  In
the latter case any characters before the overflow are returned in the
String and the extra characters are discarded.

Do not use a String dimensioned larger than 64K-bytes.

TCRT.SBR turns on echo-suppress while it is active to prevent
echo characters from interfering.

ENDC

SEARCH SYS
SEARCH SYSSYM
SEARCH TRM

Header:  PHDR -1,0,PH$REE!PH$REU

JCB     =A0
Source  =A1
String  =A2
ArgLst  =A3
Worksp  =A4
TCB     =A5
TDV     =A6
Atemp   =A6

Char    =D1
CrtCmd  =D1
Number  =D1
Size    =D2
Pcount  =D3
Tsts    =D4

Cmd     =^H0FF00

STRADR  =JOBRBK
STRSIZ  =JOBRBK+4
OrgTCRT =JOBRBK+6

       MOV     JOBCUR,JCB              ; get JCB
       MOV     JOBTRM(JCB),TCB         ; get TCB

       MOVW    @ArgLst,Pcount          ; get #parameters passed
       CMPW    Pcount,#2               ; error if <2
       BLO     Error
       MOV     8(ArgLst),Size          ; get string size, error if null
       BNE     OK
Error:  ORW     #J.CCC,JOBSTS(JCB)      ; signal ^C to BASIC
       RTN                             ; return to BASIC

OK:     MOVW    T.STS(TCB),Tsts         ; save current T.STS
       ANDW    #^C<OIP>,Tsts           ; but clear OIP bit
       ORW     #ECS,T.STS(TCB)         ; set echo suppression
       MOV     4(ArgLst),String        ; get string address
       MOV     String,STRADR(JCB)      ; save string address
       MOVW    Size,STRSIZ(JCB)        ; save string size
       MOV     T.TDV(TCB),TDV          ; get current TDV address
       PUSH    TDV                     ; save current TDV
       ADD     #TD.CRT,TDV             ; calculate TCRT routine address
       MOV     TDV,OrgTCRT(JCB)        ; save original TCRT address
       LEA     TDV,CRTDVR              ; get new terminal driver address
10$:    TSTB    T.STS(TCB)              ; wait for OIP to clear
       BMI     10$
       MOV     TDV,T.TDV(TCB)          ; swap terminal drivers
       ADD     #2,ArgLst               ; bypass parameter count
       SUBW    #2,Pcount               ; pre-dec for DBF & bypass string param
NxtPrm: ADD     #10,ArgLst              ; point to next parameter in ArgLst
       MOV     2(ArgLst),Source        ; get address for this parameter
       CMPB    @ArgLst,#4              ; is this parameter floating?
       BNE     TwoByte                 ; no, get two-byte cursor command
       MOVB    (Source)+,(Worksp)+     ; Move byte-by-byte to ensure
       MOVB    (Source)+,(Worksp)+     ; parameter begins on even address.
       MOVB    (Source)+,(Worksp)+
       MOVB    (Source)+,(Worksp)+
       MOVB    (Source)+,(Worksp)+
       MOVB    (Source)+,(Worksp)+
       SUB     #6,Worksp               ; restore workspace register
       FFTOL   @Worksp,CrtCmd          ; get TCRT call#
       ORW     #Cmd,CrtCmd             ; make into a TCRT call
       BR      DoTCRT
TwoByte:MOVB    (Source)+,CrtCmd        ; get first byte (row)
       LSLW    CrtCmd,#8               ; shift up one byte
       MOVB    @Source,CrtCmd          ; get second byte (column)
DoTCRT: TCRT                            ; do the TCRT call
       DBF     Pcount,NxtPrm

10$:    TSTB    T.STS(TCB)              ; wait for OIP to finish
       BMI     10$

       ; now clear unused end of string to NULLs
       MOVW    STRSIZ(JCB),Size        ; get remaining space count
       BEQ     Done
       DECW    Size                    ; pre-decrement for DBF loop
       MOV     STRADR(JCB),String
ClrEnd: CLRB    (String)+
       DBF     Size,ClrEnd

Done:   POP     T.TDV(TCB)              ; restore original terminal driver
       ANDW    #^C<ECS>,T.STS(TCB)     ; clear echo suppress
       ORW     Tsts,T.STS(TCB)         ; restore original terminal status
       RTN                             ; return to BASIC

       WORD    [TCR],[T  ]             ; TCRT driver name
CRTDVR: WORD    TD$NEW                  ; terminal attributes
       RTN                             ; No Input routine.
       BR      Output                  ; Handle OUTPUT
       RTN                             ; No ECHO routine.
       BR      TCRT                    ; Handle TCRT routine.
       RTN                             ; No INIT routine.
       WORD    0                       ; IMPURE area size
       BYTE    0,0                     ; Terminal size - rows, columns
       LWORD   TD$CLR                  ; so color commands can be returned

TCRT:   MOV     OrgTCRT(JCB),Atemp      ; get original terminal driver TCRT
       JMP     @Atemp                  ; routine's address & jump there

Output: ; note this routine destroys A2 but that is okay because it
       ; was saved by TRMOCP

       TSTW    STRSIZ(JCB)             ; any room left in string?
       BNE     PutChr
       ORW     #J.CCC,JOBSTS(JCB)      ; signal string overflow
       BR      ClrChr
PutChr: MOV     STRADR(JCB),String      ; get current position in string
       MOVB    Char,(String)+          ; save Char and update position
       MOV     String,STRADR(JCB)      ; save updated address
       DECW    STRSIZ(JCB)             ; decrement remaining space
ClrChr: CLRB    Char                    ; so TRMSER will not try to output Char
       RTN                             ; return to TRMOCP
       END