;*************************** AMUS Program Label ******************************
; Filename: CLIP2                                           Date: 3/22/92
; Category: UTIL         Hash Code: 041-400-062-054      Version: 1.0(102)       
; Initials: GR/AM        Name: JAMES A. JARBOE IV
; Company: EDUCATIONAL VIDEO NETWORK, INC          Telephone #: 4092955767
; Related Files: 
; Min. Op. Sys.: 1.3D                          Expertise Level: BEG
; Special: Terminal must support cursor addressing and get data at cursor.
; Description: Clips a picture of your terminal screen or another jobs 
; terminal screen to a jobnam.PIC file. Terminal driver and terminal must
; support TCRT calls 19 and 20
;*****************************************************************************
;*; Updated on 19-Mar-92 at 11:51 AM by James A. Jarboe I V; edit time: 1:39:30
;************************************************************************
; CLIP.M68	-	"CLIP"
;
; by Dave Heyliger - AMUS Staff
; Modified by James A. Jarboe I V
;
; CLIP will "clip" the current screen of a JOB's terminal and place this
; picture in a file in your current PPN. The JOB should be in a non-active
; state, i.e., waiting for input or at the dot. The file is JOBNAM.PIC. You
; may even CLIP yourself - this is not a problem.
;
; CLIP uses TCRT calls 19 and 20 to get data that is already on the screen
; into a file.
; 
; Usage: .CLIP jobnam
;
; Example: .CLIP JOB2
;	    This will create JOB2.PIC in your PPN
;
; SPECIAL NOTE: 
;	This program WILL ONLY work on terminals that support TCRT calls:
;	-1,19   - Read cursor address.
;       -1,20   - Read cursor at address.
;
;       This program will check the TRMBMP (term bitmap) of the driver
;       to see if those TCRT calls are supported. Some terminals support
;       the TCRT calls but the bitmap may be incorrect. If your terminal
;       manual says that it does support READ CURSOR ADDRESS and READ
;       CURSOR AT ADDRESS and the terminal driver bitmap is incorrect,
;       correct the terminal driver bitmap bytes, reassemble and try again.
;
;       A PARTIAL listing of Terminal drivers that DO support these calls:
;	AM60    AM62     AM65     AM70     AM75     SOR135     
;       TVI925  WYSE50   WYSE60   WYS350   LINK
;
;       To check if your terminal driver supports these TCRT calls,
;       see if there is code at C19: and C20: labels in your driver and
;       see if bytes 19 and 20 are set to 1 in the driver bitmap, or
;       this program will report if the driver does not support these calls.
;
; What can hang CLIP up?  'Pert near anythang irregular.
;       For instance another job using a VT102 driver that says that it 
;       supports TCRT calls 19 and 20 in the Bitmap, and has a PC attached
;	to that terminal that is doing a VT102 terminal emulation that does
;	not really support the TCRT 19 and 20 calls.
;
;       A terminal that supports TCRT calls 19 and 20, a driver that 
;       supports the TCRT calls and a terminal turned OFF will cause
;       CLIP to hangup.
;
;       A terminal that supports TCRT calls 19 and 20, a driver that 
;       supports the TCRT calls and no terminal attached to the trmdef port
;       will cause CLIP to hangup.
;
;       CLIP relies entirely on the functions of a physical terminal to
;       return to this program the cursor address and value is at that
;       cursor address. If a terminal driver is written to 1.x and 2.x
;       standards and if the terminal supports TCRT calls 19 and 20, and if
;	the terminal is cabled to a port,  and if the terminal is turned on.
;	all should go well.
;
; 	CLIP will time out if the terminal does not physically support the
;	TCRT 19 and 20 calls, so your job will not hangup.
;
; Re-write of program 12-30-87 by Dave Heyliger
; Modifed 18-Mar-92 by James A. Jarboe I V to bring up to 1.3D and
; 2.x standards.
;************************************************************************
;
; Edit History:
; [100] 30-Dec-87 Written by Dave Heyliger.
; [101] 18-Mar-92 by James A. Jarboe I V
;	Added TRMRST and TRMWST for 1.xD and 2.x standards.
;  	Use TRMCHR to see if terminal supports TCRT calls.
;       Fixed problem of hanging up when TRMSTS not in DAT mode.
;       Added support for wide displays and long rows.
;	Added ^C exit from CLIPor job verses the CLIPee.
;	Now supports 132 columns and log rows via TRMCHR.
;
; [102] 19-Mar-92 by James A. Jarboe I V
;       Would report NOSUPT message on CLIPed terminal not CLIPor
;       terminal.
;       Now times out if the physical terminal does not respond to
;       TCRT calls 19 or 20. Prevents terminal lockup.

	PAGE
;***************************************************************************
;                                                                          *
;                            S Y M B O L I C S				   *
;                                                                          *
;***************************************************************************
;
	SEARCH SYS			; Search normals
	SEARCH SYSSYM
	SEARCH TRM

	VMAJOR = 1			; Current release.
	VEDIT = 102.			; 19-Mar-92 by GR/AM

	PAGE
;***************************************************************************
;                                                                          *
;                               M A C R O S                                *
;                                                                          *
;***************************************************************************
;
; Do a TCRT call.
; Where: 
;        ROW = cursor row or -1 for TCRT call.
;        COL = cursor column or actual tcrt call.
; 
DEFINE	PRTTAB	ROW, COL
	MOVW	#<ROW_8.+COL>,D1
	TCRT
ENDM

; Ring bell.
;
DEFINE	DING
	MOV	#7, D1
	TTY
ENDM

; Low intensity.
;
DEFINE	DIM
	PRTTAB	-1, 11.
ENDM

; Normal intensity
;
DEFINE	BRIGHT
	PRTTAB	-1, 12.
ENDM

	PAGE
;***************************************************************************
;                                                                          *
;                       C O N S T A N T    V A L U E S                     *
;                                                                          *
;***************************************************************************
;
	$LF	=	10.		; The line feed.
	$CR	=	13.		; The Carriage return.
	$SPACE	=	32.		; The space character.
	$DASH	=	45.		; The "-" character.
	$DEL	=	127.		; The delete character.
	
	DF$ROW	=	24.		; Default row.
	DF$COL	=	80.		; Default column.
	DF$MAX	=	40.		; Maximum time out count.

	OF$ROW	=	31.		; Row offset from cursor call.
	OF$COL	=	31.		; Column offset from cursor call.

	PAGE
;***************************************************************************
;                                                                          *
;                           I M P U R E   A R E A                          *
;                                                                          *
;***************************************************************************
;
;
	.OFINI	
	.OFDEF	PICFIL,D.DDB			;picture file DDB
	.OFDEF	OURTRM,4			;"our" terminal pointer
	.OFDEF	THRTRM,4			;"their" terminal pointer
	.OFDEF	STSWRD,2			;"their" status word
	.OFDEF	CURSOR,2			;"their" current cursor pos.
	.OFDEF	IDX,4				;JOBIDX of JOB on input line
	.OFDEF	ASCBUF, 8.		; Ascii buffer.
	.OFDEF	TRMSTF, TC.SZB		; Terminal characteristics.
	.OFSIZ	IMPSIZ			; Size of impure area.


	PAGE
;***************************************************************************
;                                                                          *
;                               P R O G R A M                              *
;                                                                          *
;***************************************************************************
;
CLIP2:	PHDR	-1,0,PH$REE!PH$REU		;reentrant, reusable

	GETIMP	IMPSIZ,A3			;A3 will point to vars	

;process input line
;
	LIN					;just a CR?
	JEQ	HELPEM			; Yes..help em.

	BYP					;bypass whitespace
	LEA	A0,PICFIL(A3)			;point to picture file DDB
	FSPEC	@A0,PIC				;create filename (and JOBNAM)

;find the JOB on the input line
;
	MOV	JOBTBL,A2			;JOB TABLE address to A2
	LEA	A1,D.FIL(A0)			;point A1 to JOBNAM in DDB
30$:	MOV	(A2)+,A4			;A4 now points to each JCB per SCAN
	MOV	A4,D1				;Set the status register
	JMI	NONAME				;didn't find JOB
	BEQ	30$				;if a "0" then look at next JCB
	CMM	JOBNAM(A4),@A1			;see if name matches
	BNE	30$				;no match

;found JOB, initialize picture file, save IDX value
;
	MOV	A4,IDX(A3)			;save IDX value
	INIT	@A0				;initialize DDB
	LOOKUP	@A0				;there?
	BNE	50$				;nope
	DSKDEL	@A0				;yup, erase old pic file

;make .PIC file
;
50$:	OPENO	@A0				;get ready to create file


;if YOURSELF, don't do any detaching, attaching etc..
;
	JOBIDX	A2			; Index job.
	CMP	A2, A4			; Is this us?
	JEQ	SETTSW			; Yes..bypass below.

; Tell what is going on if CLIPping another job.
;
	DIM
	TYPE	<Found >
	BRIGHT
	CALL	SHWNAM
	DIM
	TYPE 	<, creating >
	BRIGHT
	OFILE	@A0, OT$TRM
	DIM
	TYPE	<.  Please wait ...>

;attach "other" terminal to "this" terminal
;
	MOV	JOBTRM(A2), OURTRM(A3)	; Save our TCB address.

	MOV	JOBTRM(A4),A5			;get what's inside into A5
	MOV	A5,THRTRM(A3)			;and save it too
	TRMRST	D6, @A5			; Get term status properly.
	MOVW	D6, STSWRD(A3)		; Save status.

	LEA	A5,JOBTRM(A4)			;address of "their" TB^
	LEA	A1,JOBTRM(A2)			;A1 points to "our" TB^

	CALL	SETLOK			; Lock system.
	CLR	@A5				;"detach" their terminal
	MOV	THRTRM(A3),@A1			;"attach" their terminal to us
	CALL	SUNLOK			; Unlock system.

;set the terminal status word.
;
SETTSW:
	TRMRST	D6			; Get term status properly.
	ORW	#<T$IMI!T$ECS!T$DAT>,D6	; Set status word.
	TRMWST	D6			; Set term status properly.
	
	TRMCHR	TRMSTF(A3), TC$BMP	; Get terminal characterstics.
	CALL	CHKBIT			; Term bitmap support TCRT calls?
	JNE	EXT			; No..19 or 20 not supported.
	TSTW	TRMSTF+TC.COL(A3)	; Is there a valid column count?
	BNE	10$			; Yes..OK.
	MOVW	#DF$COL, TRMSTF+TC.COL(A3)	; No..set default.
10$:
	TSTW	TRMSTF+TC.ROW(A3)	; Is there a valid row count?
	BNE	20$			; Yes..OK.
	MOVW	#DF$ROW, TRMSTF+TC.ROW(A3)	; No..set default.
20$:
	CALL	CLRBUF				;clear out input buffer

;now remember the cursor position of the terminal
;
	PRTTAB	-1, 19.			; Read Cursor address.
	CALL	TSTBUF			; Does terminal respond to TCRT call?
	JNE	EXT			; No..exit reporting already done.
	LEA	A2,CURSOR(A3)			;point A2 to cursor area
	KBD	EXT				;get row
	SUBB	#OF$ROW, D1			;create row number
	MOVB	D1,(A2)+			;save row
	CALL	TSTBUF			; Does terminal respond to TCRT call?
	JNE	EXT			; No..exit reporting already done.
	KBD	EXT				;get column
	SUBB	#OF$COL, D1			;convert to binary number
	MOVB	D1,@A2				;save column
	CALL	CLRBUF				;clear input buffer

;now scan the entire screen and get the picture
;
	MOV	#1,D2				;start row
	CLR	D3				;clear column count.
	CLR	D1			; Clear TCRT call.
LOOP:	CTRLC	20$			; Exit on User ^C.
	INC	D3				;inc column
	MOVB	D2,D1				;TCRT to row,column
	LSLW	D1,#8.
	MOVB	D3,D1
	TCRT
	CALL	GETCHR				;get the character at cursor
	CMPW	D3, TRMSTF+TC.COL(A3)	; Last column?
	BNE	LOOP				;nope
	MOV	#$CR, D1			;yup, get CRLF out to file
	FILOTB	@A0			; Output to file.
	MOV	#$LF, D1		; Set linefeed.
	FILOTB	@A0			; Output to file.
	CLR	D3				;clear column count
10$:
	CMPW	D2, TRMSTF+TC.ROW(A3)	; Last Row?
	BEQ	20$				;yup
	INC	D2				;nope, get next row
	BR	LOOP				;and get next character

;picture all done, reset the cursor
;
20$:
	LEA	A6,CURSOR(A3)			;point to "their" cursor pos
	MOVB	(A6)+,D1			;get row
	LSLW	D1,#8.				;shift over
	MOVB	@A6,D1				;get column number
	TCRT					;return their cursor

	CALL	HOOKUP


; Clean up and exit.
;
OUT:
	BRIGHT
	TYPE	< Finished>
	DIM
	TYPECR	<.>
	BRIGHT
	CLOSE	@A0				;close the file
EXT:	EXIT					;and quit

; Display ASCII job name.
;	
SHWNAM:
	SAVE	A1,A2			; Save registers.
	LEA	A1, PICFIL+D.FIL(A3)	; Index job name in DDB.
	LEA	A2, ASCBUF(A3)		; Index output buffer.
	UNPACK				; To ASCII.
	UNPACK
10$:	CMPB	-(A2), #$SPACE		; Last character a space?
	BEQ	10$			; Yes..backup another one.
	INC	A2			; Bump past last good char.
	CLRB	@A2			; Clear end of buffer.
	TTYL	ASCBUF(A3)		; Output ASCII text.
	REST	A1, A2			; Restore registers.
	RTN				; Return to caller.

; Check bit terminal driver bitmap for TCRT calls 19 and 20.
;
CHKBIT:
	CLR	D7			; Preclear
	MOV	#4, D0			; Set 4th bit.
	LEA	A6, TC.BMP+TRMSTF(A3)	; Index Bitmap.
	ADD	#2, A6			; Offset to correct byte.
	MOVB	@A6, D7
	ANDB	D0, D7
	BEQ	10$			; No..not supported.
	ROLB	D0, #1			; Set next bit in byte.
	MOVB	@A6, D7
	ANDB	D0,D7
	BEQ	10$			; No..not supported.
	LCC	#PS.Z			; Set all is ok.
	RTN				; Return to caller.

10$:	CALL	HOOKUP			; Reattach if necessary.
	CALL	NOSUPT			; Report problem.
	CLOSE	@A0			; Close output file.
	DSKDEL	@A0			; Delete output file.
	LCC	#0			; Set error.
	RTN				; Return to caller.

;SUBROUTINE to get the character under the cursor
;
GETCHR:
	PRTTAB	-1,20.			; Read Cursor at address.
	CALL	INBUF				;wait for input to be returned
	KBD	99$				;get key under cursor
	CMPB	D1, #$SPACE		; Is it less than space?
	BLO	99$			; Yes..no output.
	CMPB	D1, #$DEL		; Is it greater or = to DEL?
	BHIS	99$			; Yes..no output.
	FILOTB	@A0				;and output it to file
99$:	RTN					;return

;SUBROUTINE to clear out input buffer
;
CLRBUF:	TCKI					;input?
	BNE	10$				;nope, all clear
	KBD					;yup, get it out of buffer
	BR	CLRBUF				;and look for more input	
10$:	RTN					;input buffer cleared

;SUBROUTINE to wait for input
;
INBUF:
	TCKI					;input?
	BNE	INBUF				;nope
	RTN					;yup!

; SUBROUTINE to test for input from TCRT 19 call.
;   Times out if no response from terminal.
;
TSTBUF:
	CLR	D0			; Clear counter
10$:
	TCKI				; Input?
	BEQ	99$			; Yes..good use it
	SLEEP	#1000.			; Sleep a little.
	INC	D0			; Bump counter.
	CMP	D0, #DF$MAX		; Hit max tries yet?
	BNE	10$			; No..try again
	CALL	HOOKUP			; Reattach terminal.
	CALL	NOINPT			; Output no input message.
	CLOSE	@A0			; Close output file.
	DSKDEL	@A0			; Delete it.
	LCC	#0			; Set not OK
	RTN				; Return to caller.

99$:	LCC	#PS.Z			; Set ok
	RTN				; Return to caller.

; Lock system.
;
SETLOK:
	TST	DDBCHN			; Any IO active in chain?
	BEQ	10$			; No..lock up.
	SLEEP	#10			; Pause.
	BR	SETLOK			; Try again.
10$:	JLOCK				; Lock system.
	RTN				; Return to caller.

; Unlock system.
;
SUNLOK:
	JUNLOK				; Unlock system.
	RTN				; Return to caller.

;re-attach everybody
;
HOOKUP:	
	JOBIDX	A2			; Index this job.
	MOV	IDX(A3),A4		; Get IDX value of JOB
	CMP	A4,A2			; Is this us.
	BEQ	99$			; Yes..never mind.
	CLR	D6			; Preclear.
	MOVW	STSWRD(A3), D6		; Get original status word.
	TRMWST	D6			; Reset status word properly.
	LEA	A5,JOBTRM(A4)		; Index original TCB.

	CALL	SETLOK			; Lock system.
	CLR	@A1			;detach "their" terminal from us
	MOV	THRTRM(A3),@A5		;attach it back to original owner
	MOV	OURTRM(A3),JOBTRM(A2)	;attach OUR original terminal back
	CALL	SUNLOK			; Unlock system.
99$:	RTN				; Return to caller.

; report problem.
;
OOPS:
	DING
	BRIGHT
	TYPECR	<Ooops!>
	CRLF
	DING
	RTN	



; Terminal does not respond to 19 or 20
;
NOINPT:
	CALL	OOPS
	DIM
	TYPE	<The terminal attached to >
	BRIGHT
	CALL	SHWNAM
	DIM
	TYPE	< is >
	BRIGHT
	TYPE	<NOT >
	DIM
	TYPE	<responding to TCRT >
	BRIGHT
	TYPE	<19 >
	DIM
	TYPE	<or >
	BRIGHT	
	TYPE	<20>
	DIM	
	TYPECR	<.>
	BRIGHT
	RTN

; TCRT not supported error message.
;
NOSUPT:
	CALL	OOPS
	DIM
	TYPE	<The terminal >
	BRIGHT
	TYPE	<driver >
	DIM
	TYPE	<used by job >
	BRIGHT
	CALL	SHWNAM
	DIM
	TYPE	< does >
	BRIGHT
	TYPE	<NOT >
	DIM
	TYPE	<support TCRT calls >
	BRIGHT	
	TYPE	<19 >
	DIM
	TYPE	<or >
	BRIGHT
	TYPE	<20>
	DIM	
	TYPECR	<.>
	BRIGHT
	RTN

; Cannot find job error message.
;
NONAME:	
	CRLF				; Bump line.
	DING				; Ring bell.
	TYPE	<?>
	DIM
	TYPE	<Cannot find >
	BRIGHT
	CALL	SHWNAM
	DIM
	TYPECR	<.>

; Universal help.
;
HELPEM:
	CRLF				; Bump line.
	DIM
	TYPE	<%Usage:>
	BRIGHT
	TYPECR	<     .CLIP Jobnam>		;yup, give instructions
	CRLF
	DIM
	TYPE	<            Output file will be >
	BRIGHT
	TYPE	<Jobnam.PIC >
	DIM
	TYPECR	<in your current PPN.>
	BRIGHT
	EXIT

	END



.