.MCALL	.MODULE,	.PRINT
.MODULE	DRV407,RELEASE=V00,VERSION=20,COMMENT=<Tek 4107 Driver>

	.LIBRARY /UTL.MLB/
	.MCALL	$UTL
	$UTL

F0	= %0
F1	= %1
F2	= %2
F3	= %3

GS	= 35
US	= 37

.NLIST
	.INCLUDE /GKSDEF.INC/
.LIST

	.PAGE
	.SBTTL	CGI Transfer Vector Table

	.PSECT	C$$COD,RW,D,LCL,CON

$CGID0::.WORD	VINI		; Initialize
	.WORD	VRD		; Reset Defaults
	.WORD	VTRM		; Terminate
	.WORD	VMPC		; Make Picture Current
	.WORD	VSDM		; Set Deferral Mode
	.WORD	VPVS		; Prepare View Surface
	.WORD	VEP		; End Page
	.WORD	VBC		; Background Color
	.WORD	VVE		; VDC Extent
	.WORD	VDV		; Device Viewport
	.WORD	VCR		; Clip Rectangle
	.WORD	VCI		; Clip Indicator
	.WORD	VPL		; Polyline
	.WORD	VDP		; Disjoint Polyline
	.WORD	VPM		; PolyMarker
	.WORD	VTXT		; Text
	.WORD	VP		; Polygon
	.WORD	VSLT		; Set Line Type
	.WORD	VSLW		; Set Line Width
	.WORD	VSLC		; Set Line Colour
	.WORD	VQTS		; Inquire Description Table Size
	.WORD	VQDT		; Inquire Description Tables
	.WORD	VTP		; Text Path
	.WORD	VTA		; Text Alignment
	.WORD	VCO		; Character Orientation
	.WORD	VCH		; Character Height
	.WORD	VCEF		; Character Expansion Factor
	.WORD	VCS		; Character Spacing
	.WORD	VTC		; Text colour.
	.WORD	VMT		; Marker Type.
	.WORD	VMS		; Marker Size.
	.WORD	VMC		; Marker Colour.

	.PAGE
	.SBTTL	Output Device Description Table

OUTPUT	= 0
INPUT	= 1
OUTIN	= 2

D$CLAS:	.WORD	OUTPUT		; Device Class
D$ID:	.WORD	D$0001-.	; Device Identification

HARD	= 0
SOFT	= 1

D$HSCL:	.WORD	SOFT		; Hard/Soft Copy Class

VECTOR	= 0
RASTER	= 1
OTHER	= 2

D$DT:	.WORD	RASTER		; Display Type

IRG	= 0
IMM	= 1

D$BCC:	.WORD	IMM		; Background Color Capability
D$DMT:	.WORD	IRG		; Dynamic Modification for Transformation
D$BLC:	.FLT2	0.0,0.0		; Bottom Left Corner
D$URC:	.FLT2	4095.0,3072.0	; Upper Right Corner
D$DSW:	.WORD	640.		; Display Surface Width
D$DSH:	.WORD	480.		; Display Surface Height
D$POLY:	.WORD	-1		; PolyLine, Number of Points Supported.
D$LAL:	.WORD	D$0002-.	; List of Available Linetypes.
D$NLW:	.WORD	1		; Nominal Linewidth
D$MNLW:	.WORD	1		; Minimum Linewidth
D$MXLW:	.WORD	1		; Maximum Linewidth

D$0001:	.ASCII	/Tektronix 4107/<200>
	.EVEN
D$0002:	.WORD	8.		; Number of Available Linetypes
	.WORD	0,1,2,3,4,5,6,7	; List of Available Linetypes

DTSIZE	= . - D$CLASS		; Size of the Description Tables.
	.PAGE
	.SBTTL	Device Control State List

C$INIT	= 0
C$NOIN	= 1
CSTATE:	.WORD	C$NOIN		; Default in NOT Initialized.

C$CLEN	= 0
C$DIRT	= 1
C$VSS:	.WORD	C$DIRT		; Default is view surface dirty.

C$ASTI	= 0
C$BNI	= 1
C$ASAP	= 2
C$DEFR:	.WORD	C$ASTI		; Default deferral state is ASTI.

C$DVEX:	.FLT2	0.0,1.0		; Storage for default window.
	.FLT2	0.0,1.0
C$DVVP:	.FLT2	0.0,4095.0	; Storage for default viewport.
	.FLT2	0.0,3071.0

C$CLRE	= 0			; Clip to clip rectangle
C$EFVP	= 1			; Clip to effective viewport
C$COFF	= 2			; Clip OFF.
C$CLIN:	.WORD	C$CLRE

C$CLIP:	.FLT2	0.0,0.0		; Storage for default clip rectangle.
	.FLT2	32767.0,32767.0

	.SBTTL	Line Attribute State List

C$LBI:	.WORD	1		; Line Bundle Index.
C$LT:	.WORD	1		; Line Type.
C$LW:	.WORD	0		; Line Width.
C$LC:	.WORD	1		; Line Color.

	.SBTTL	Text Attribute State List

C$TC:	.WORD	1		; Text Colour.
C$CH:	.FLT2	.01		; Text Height.
C$CW:	.FLT2	.01		; Character Width.
C$CO:	.FLT2	0.0,1.0,1.0,0.0	; Character Orientation.

PRIGHT	= 0
PLEFT	= 1
PUP	= 2
PDOWN	= 3

C$TP:	.WORD	PRIGHT		; Text Path.

HNORMA	= 0
HLEFT	= 1
HCENTR	= 2
HRIGHT	= 3

C$TAH:	.WORD	HNORMA		; Text Alignment Horizontal.

VNORMA	= 0
VTOP	= 1
VCAP	= 2
VHALF	= 3
VBASE	= 4
VBOTTO	= 5

C$TAV:	.WORD	VNORMA		; Text Alignment Vertical.

	.SBTTL	Marker Attribute State List

C$MT:	.WORD	3		; Marker Type.
C$MS:	.FLT2	1.00		; Marker Width.
C$MC:	.WORD	1		; Marker Color.

	.PAGE
	.SBTTL	Initialize

;************************************************************************
;* Initialize								*
;************************************************************************

VINI:	MOV	@2(R5),OCHAN	; As a temporary measure, the RT channel
				; to use for this device is passed as a
				; parameter, although the CGI definition
				; of this function doesn't specify a
				; parameter.

	CLR	OBLKN		; Reset the block number to 0.
	CALL	$UTLPR,#SELGRH,#OBUFF ; Select TEK mode.
	RTS	PC		; Return.

SELGRH:	.ASCII	<33>/%!0/<200>	; Select TEK mode.
	.EVEN
	.PAGE
	.SBTTL	Reset Defaults

;************************************************************************
;* Reset Defaults							*
;************************************************************************

VRD:	MOV	#-1,C$LT	; Force the action.
	MOV	#10$,R5
	JSR	PC,VSLT		; Initialize line type.
	RTS	PC		; Return.

10$:	.WORD	1,11$
11$:	.WORD	1
	.PAGE
	.SBTTL	Terminate

;************************************************************************
;* Terminate								*
;************************************************************************

VTRM:
	CALL	$UTLPR,#SELEDT,#OBUFF ; Select TEK mode.
	CALL	$UTLFL,#OBUFF	; Flush the buffer.
	RTS	PC		; Return.

SELEDT:	.ASCII	<33>/%!2/<200>	; Select TEK mode.
	.EVEN
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Make Picture Current

;************************************************************************
;* Make Picture Current							*
;************************************************************************

VMPC:	CALL	$UTLFL,#OBUFF	; Flush the output buffer.
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Set Deferral Mode

;************************************************************************
;* Set Deferral Mode							*
;************************************************************************

VSDM:	MOV	@2(R5),R1	; Get the deferral mode.

	RTS	PC		; Return.
	.PAGE
	.SBTTL	Prepare View Surface

;************************************************************************
;* Prepare View Surface							*
;************************************************************************

VPVS:	MOV	@2(R5),R1	; Get the indicator (FORCE HARDCOPY,
				; CONDITIONAL)
	CALL	$UTLPR,#DELSEG,#OBUFF ; Delete all segments.
	MOV	#-1,R1
	JSR	PC,TEKINT
	CALL	$UTLPR,#CLRSFC,#OBUFF ; Renew View 1.
	MOV	#1,R1
	JSR	PC,TEKINT
	RTS	PC		; Return.

DELSEG:	.ASCII	<33>/SK/<200>	; Delete Segments.
CLRSFC:	.ASCII	<33>/KN/<200>	; Renew View.
	.EVEN
	.PAGE
	.SBTTL	End Page

;************************************************************************
;* End Page								*
;************************************************************************

VEP:
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Background Color

;************************************************************************
;* Background Color							*
;************************************************************************

VBC:	MOV	2(R5),R1	; Pointer to a color value (3-tuple).

	RTS	PC		; Return.
	.PAGE
	.SBTTL	VDC Extent

;************************************************************************
;* VDC Extent								*
;************************************************************************

VVE:	MOV	2(R5),R1	; Pointer to the first corner.
	MOV	4(R5),R2	; Pointer to the second corner.
	MOV	#C$DVEX,R3	; Pointer to low NDC extent.
	MOVFLT	(R1)+,(R3)+
	MOVFLT	(R2)+,(R3)+
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Device Viewport

;************************************************************************
;* Device Viewport							*
;************************************************************************

VDV:	MOV	2(R5),R1	; Pointer to the first corner.
	MOV	4(R5),R2	; Pointer to the second corner.
	MOV	#C$DVVP,R3	; Pointer to device viewport.
	MOVFLT	(R1)+,(R3)+
	MOVFLT	(R2)+,(R3)+
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Clip Rectangle

;************************************************************************
;* Clip Rectangle							*
;************************************************************************

VCR:	MOV	2(R5),R1	; Pointer to the first corner.
	MOV	4(R5),R2	; Pointer to the second corner.

	RTS	PC		; Return.
	.PAGE
	.SBTTL	Clip Indicator

;************************************************************************
;* Clip Indicator							*
;************************************************************************

VCI:	MOV	@2(R5),R1	; Get the clip indicator (CLIP RECTANGLE,
				; EFFECTIVE VIEWPORT, OFF)

	RTS	PC		; Return.
	.PAGE
	.SBTTL	Polyline

;************************************************************************
;* Polyline								*
;************************************************************************

VPL:	MOV	@2(R5),-(SP)		; Get the number of points.
	MOV	4(R5),-(SP)		; Get a pointer to the point list
	DEC	2(SP)			; One less line segment than points.

10$:	DEC	2(SP)			; Decrement the counter.
	BLT	40$			; Branch if DONE.

	MOV	(SP),R0			; R0 points to the begin point.
	ADD	#2*FLTSIZ,(SP)
	MOV	(SP),R1			; R1 points to the end point.
	CALL	CLIPPR,R0,R1,#P1,#P2,#C$DVEX ; Clip to the Workstation Window.
	TST	R0			; Anything to display?
	BEQ	10$			; Branch if not.

	CALL	$UTLPR,#PLSTRT,#OBUFF	; Set up to MOVE to the first point.

	CALL	WTRANS,#C$DVEX,#P1,#DC	; Convert P1 to device coordinates.
	MOV	#DC,R1			; Get the address to MOVE to.
	JSR	PC,TEKXY		; Encode the point.

20$:	CALL	WTRANS,#C$DVEX,#P2,#DC	; Convert P2 to device coordinates.
	MOV	#DC,R1			; R1 points to the destination.
	JSR	PC,TEKXY		; Encode the point.

30$:	DEC	2(SP)			; Count line segments.
	BLT	40$			; Branch if DONE.
	MOV	(SP),R0			; R0 points to the begin point.
	ADD	#2*FLTSIZ,(SP)
	MOV	(SP),R1			; R1 points to the end point.
	CALL	CLIPPR,R0,R1,#P1,#P2,#C$DVEX ; Clip to the Workstation Window.
	TST	R0			; Anything to display?
	BNE	20$			; Branch if there is.
	BR	10$			; Otherwise, start over.

40$:	ADD	#4,SP			; Clear the stack.
	CALL	$UTLPR,#PLSTOP,#OBUFF
	RTS	PC			; Return.

PLSTRT:	.ASCII	<GS>//<200>
PLSTOP:	.ASCII	<US>//<200>
	.PAGE
	.SBTTL	Disjoint Polyline

;************************************************************************
;* Disjoint Polyline							*
;************************************************************************

VDP:
	RTS	PC		; Return.
	.PAGE
	.SBTTL	PolyMarker

;************************************************************************
;* PolyMarker								*
;************************************************************************

VPM:	PUSH	R5			; Save R5.
	MOV	4(R5),R0		; Get the address of the point.
	MOV	R0,R1			; R0 has the X address
	ADD	#FLTSIZ,R1		; R1 has the Y address.
	CALL	CLIPCD,R0,R1,#C$DVEX	; Clip to the Workstation Window.
;	BNE	10$			; Branch if we should clip.

	CALL	$UTLPR,#DRWMRK,#OBUFF	; Set up to DRAW the MARKER.

	MOV	(SP),R5			; Restore R5.
	CALL	WTRANS,#C$DVEX,4(R5),#DC; Convert to device coordinates.
	MOV	#DC,R1			; Get the address to MOVE to.
	JSR	PC,TEKXY		; Encode the point.

10$:	POP	R5			; Clear the stack.
	RTS	PC			; Return.

DRWMRK:	.ASCII	<33>/LH/<200>
	.PAGE
	.SBTTL	TeXT

;************************************************************************
;* TeXT									*
;************************************************************************

; Point (P)
; Flag (Final/Not Final)
; String (S)

VTXT:	MOV	2(R5),R0
	MOV	#P1,R1
	MOVFLT	(R0)+,(R1)+		; Get the reference point.
	MOVFLT	(R0)+,(R1)+

	MOV	6(R5),R1		; Address of the string.
	CLR	R0			; Clear the counter.
	BR	20$

10$:	INC	R0
20$:	CMPB	(R1),#0			; Check for NULL.
	BEQ	30$
	CMPB	(R1)+,#200		; Check for 200(8).
	BNE	10$

30$:	PUSH	R0			; Save the string length.
	SETI
	SETF
	LDCIF	R0,F0			; Convert the count to floating.
	MULF	C$CW,F0			; F0 has the length of the string.

	CMP	C$TAH,#HLEFT		; Check the horizontal justification
	BEQ	120$
	
40$:	CMP	C$TAH,#HCENTR
	BNE	50$
	DIVF	TWO,F0			; Divide by 2.
	BR	60$

50$:	CMP	C$TAH,#HRIGHT
	BNE	120$

60$:	LDF	P1,F1
	SUBF	F0,F1			; Subtract from P1.
	STF	F1,P1

	LDF	C$CH,F0			; F0 has the character height.

	CMP	C$TAV,#VTOP
	BNE	70$
	MULF	ONEP5,F0		; Multiply by 1.5
	BR	110$

70$:	CMP	C$TAV,#VCAP
	BEQ	110$

80$:	CMP	C$TAV,#VHALF
	BNE	90$
	DIVF	TWO,F0			; Divide by two.
	BR	110$

90$:	CMP	C$TAV,#VNORMA
	BEQ	100$
	CMP	C$TAV,#VBASE
	BEQ	100$
	CMP	C$TAV,#VBOTTO
	BNE	110$

100$:	MOV	#0,R0
	LDCIF	R0,F0		; Move by zero.

110$:	LDF	P1+<FLTSIZ>,F1	; 
	SUBF	F0,F1		; Subtract from P1.
	STF	F1,P1+FLTSIZ

120$:	MOV	6(R5),CPNT	; Save the pointer to the string.

130$:	CMPB	@CPNT,#0	; Test for end-of-string
	BEQ	140$
	CMPB	@CPNT,#200
	BEQ	140$

	CALL	WTRANS,#C$DVEX,#P1,#DC
	CALL	$UTLPR,#MOVE,#OBUFF	
	MOV	#DC,R1		; Get the address to move to.	
	JSR	PC,TEKXY	; Encode the point.

	CALL	$UTLPR,#GRATXT,#OBUFF
	CALL	$UTLCH,CPNT,#OBUFF; Send the character.
	INC	CPNT
	SETF
	LDF	P1,F0
	ADDF	C$CW,F0		; Move to the next character position.
	STF	F0,P1
	BR	130$

140$:	TST	(SP)+		; Clear the stack.

	RTS	PC		; Return.

TWO:	.FLT2	2.0
P33:	.FLT2	.333333
P66:	.FLT2	.666666
ONEP5:	.FLT2	1.5
MOVE:	.ASCII	<33>/LF/<200>
GRATXT:	.ASCII	<33>/LT1/<200>
	.EVEN
	.PAGE
	.SBTTL	Draw Polygon

;************************************************************************
;* Draw Polygon								*
;************************************************************************

VP:
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Set Lint Type

;************************************************************************
;* Set Line Type							*
;************************************************************************

VSLT:	CMP	@2(R5),C$LT	; New Line Type?
	BEQ	10$		; Branch if not.

	PUSH	R5		; Save R5.
	CALL	$UTLPR,#SELLTY,#OBUFF ; Select line index.
	POP	R5		; Restore R5.
	MOV	@2(R5),R0	; Get the index
	MOV	R0,C$LT
	DEC	R0
	BIC	#177774,R0	; Only four line types allowed.
	MOVB	LINTBL(R0),R1	; Get the device dependent index.
	JSR	PC,TEKINT	; Encode and send it.
10$:	RTS	PC		; Return.

LINTBL:	.BYTE	0, 4, 1, 2
SELLTY:	.ASCII	<33>/MV/<200>
	.EVEN
	.PAGE
	.SBTTL	Set Line Width

;************************************************************************
;* Set Line Width							*
;************************************************************************

VSLW:
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Set Line Colour

;************************************************************************
;* Set Line Colour							*
;************************************************************************

VSLC:	CMP	@2(R5),C$LC	; New line color?
	BEQ	10$		; Branch if not.

	PUSH	R5		; Save R5.
	CALL	$UTLPR,#SELLIX,#OBUFF ; Select line index.
	POP	R5		; Restore R5.
	MOV	@2(R5),C$LC	; Get the index
	MOV	C$LC,R1
	JSR	PC,TEKINT	; Encode and send it.
10$:	RTS	PC		; Return.

SELLIX:	.ASCII	<33>/ML/<200>
	.EVEN
	.PAGE
	.SBTTL	Inquire Description Table Size

;************************************************************************
;* Inquire Description Table Size					*
;************************************************************************

VQTS:
	MOV	#DTSIZE,R0	; Return the size of the Description Tables
	RTS	PC
	.PAGE
	.SBTTL	Inquire Description Tables

;************************************************************************
;* Inquire Description Tables						*
;************************************************************************

VQDT:
	MOV	#D$CLAS,R1	; Source address.
	MOV	2(R5),R2	; Destination address.
	MOV	#DTSIZE/2,R3	; Table size.

10$:	MOV	(R1)+,(R2)+	; Copy the table.
	SOB	R3,10$

	RTS	PC		; Return.
	.PAGE
	.SBTTL	Set Character Height

;************************************************************************
;* Set Character Height							*
;************************************************************************

VCH:	MOV	2(R5),R1	; Get the address of the height.
	MOV	#C$CH,R2	
	MOVFLT	(R1)+,(R2)+	; Copy the new character height.
	MOV	2(R5),R1	; Set the width to the height
	MOV	#C$CW,R2	
	MOVFLT	(R1)+,(R2)+	; Copy the new character width.
        CALL	WSCHAT,#C$DVEX,#C$CH,#C$CW,#C$CO,#<C$CO+<2*FLTSIZ>>,#IHIGHT,#IWIDTH,#IUPVEC,#IBSVEC
	CALL $UTLPR,#SETSIZ,#OBUFF
	MOV	IWIDTH,R1		; Encode the character width.
	ASR	R1			; (Half the Height)
	JSR	PC,TEKINT	
	MOV	IHIGHT,R1		; Encode the character height.
	JSR	PC,TEKINT
	MOV	#0,R1			; Character spacing.
	JSR	PC,TEKINT
	RTS	PC

SETSIZ:	.ASCII	<33>/MC/<200>
	.PAGE
	.SBTTL	Text Alignment

;************************************************************************
;* Text Alignment							*
;************************************************************************

VTA:	MOV	@2(R5),C$TAH	; Get the horizontal text alignment.
	MOV	@4(R5),C$TAV	; Get the vertical text alignment.
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Text Colour

;************************************************************************
;* Text Colour								*
;************************************************************************

VTC:	CMP	@2(R5),C$TC	; Is the new colour different than the old?
	BEQ	10$		; Branch if it is.

	MOV	@2(R5),C$TC	; Save the new colour.
	CALL	$UTLPR,#TEXCOL,#OBUFF ; Send the Text Index message.
	MOV	C$TC,R1		; Code the index.
	JSR	PC,TEKINT
10$:	RTS	PC		; Return.

TEXCOL:	.ASCII	<33>/MT/<200>
	.PAGE
	.SBTTL	PolyMarker Colour

;************************************************************************
;* PolyMarker Colour							*
;************************************************************************

VMC:	CMP	@2(R5),C$MC	; Is the new colour different than the old?
	BEQ	10$		; Branch if it is.

	MOV	@2(R5),C$MC	; Save the new colour.
	CALL	$UTLPR,#MRKCOL,#OBUFF ; Send the message.
	MOV	C$MC,R0		; Code the index.
	DEC	R0		; Start at 0, not 1.
	MOVB	MCLLST(R0),R1	; Get the marker type.
	JSR	PC,TEKINT
10$:	RTS	PC		; Return.

MCLLST:	.BYTE	0,1,2,3,4,5,6,7,8.,9.,10.,11.,12.,13.,14.,15.
MRKCOL:	.ASCII	<33>/ML/<200>
	.PAGE
	.SBTTL	PolyMarker Type

;************************************************************************
;* PolyMarker Type							*
;************************************************************************

VMT:	CMP	@2(R5),C$MT	; Is the new colour different than the old?
	BEQ	10$		; Branch if it is.

	MOV	@2(R5),C$MT	; Save the new colour.
	CALL	$UTLPR,#MRKTYP,#OBUFF ; Send the message.
	MOV	C$MT,R0		; Code the index.
	DEC	R0		; Start at 0, not 1.
	MOVB	MTLST(R0),R1	; Get the marker type.
	JSR	PC,TEKINT
10$:	RTS	PC		; Return.

MTLST:	.BYTE	0,2,3,4,5
MRKTYP:	.ASCII	<33>/MM/<200>
	.EVEN
	.PAGE
	.SBTTL	Routines not yet Implemented.

VTP:
VCO:
VCEF:
VCS:
VMS:
	RTS	PC
	.PAGE
	.SBTTL	 Special Utilities for Tek Terminals

;************************************************************************
;* TEKINT								*
;* This subroutine encodes an integer for transmission to the TEK 4107	*
;* terminal. ***NOTE*** This subroutine does not use a standard Fortran	*
;* calling sequence. The number to be encoded is placed in R1 and a	*
;* JSR	PC,TEKINT is performed.						*
;************************************************************************

TEKINT:	PUSH	R1		; Save the number.
	SWAB	R1
	ASR	R1
	ASR	R1		; Position the bits.
	BIC	#177700,R1	; Isolate them
	TST	R1		; Are they all 0?
	BEQ	10$		; Branch if they are.
	BIS	#100,R1		; Add the flag bit.
	PUSH	R1		; Store the character.
	MOV	SP,R1		; R1 points to the character.
	CALL	$UTLCH,R1,#OBUFF ; Send the character.
	POP	R1

10$:	MOV	(SP),R1		; Get the number again.
	ASR	R1
	ASR	R1
	ASR	R1
	ASR	R1		; Position the bits.
	BIC	#177700,R1	; Isolate the target bits.
	BIS	#100,R1		; Add the flag bit.
	PUSH	R1		; Store the character.
	MOV	SP,R1		; R1 points to the character.
	CALL	$UTLCH,R1,#OBUFF ; Send the character.
	POP	R1		; Restore R1.

20$:	MOV	(SP),R1		; Get the number again.
	BIC	#177760,R1	; Isolate the target bits.
	BIS	#40,R1		; Set the flag bit.
	TST	(SP)		; Check the sign of the number.
	BLT	30$		; Branch if negative
	BIS	#20,R1		; Setting this bit makes it positive.

30$:	PUSH	R1		; Store the character.
	MOV	SP,R1		; R1 points to the character.
	CALL	$UTLCH,R1,#OBUFF ; Send the character.
	POP	R1		; Restore R1.

	POP	R1		; Clear the stack.
	RTS	PC		; Return.
	.PAGE

TEKXY:	PUSH	R1		; R1 points to the XY coordinate.
	MOV	2(R1),R2	; Get the Y coordinate.
	ASL	R2
	SWAB	R2		; Position the bits.
	BIC	#177740,R2	; Isolate the bits.
	BIS	#40,R2		; Add the flag bit.
	PUSH	R2		; Save the character.
	MOV	SP,R2		; R2 points to the character.
	CALL	$UTLCH,R2,#OBUFF; Send the character.
	POP	R2		; Restore R2.

	MOV	(SP),R1		; Get the pointer again.
	MOV	(R1),R2		; Get the X coordinate.
	BIC	#177774,R2	; Isolate bits 0 and 1.
	MOV	2(R1),R3	; Get the Y coordinate.
	BIC	#177774,R3	; Isolate bits 0 and 1.
	ASL	R3
	ASL	R3		; Position the bits.
	BIS	R3,R2		; OR the Y and X bits.
	BIS	#140,R2		; Add the flag bits.
	PUSH	R2		; Save the character.
	MOV	SP,R2		; R2 points to the character.
	CALL	$UTLCH,R2,#OBUFF; Send the character.
	POP	R2

	MOV	(SP),R1		; Retrieve R1.
	MOV	2(R1),R2	; Get the Y coordinate.
	ASR	R2
	ASR	R2		; Position the bits.
	BIC	#177740,R2	; Isolate the bits.
	BIS	#140,R2		; Add the flag bit.
	PUSH	R2		; Save the character.
	MOV	SP,R2		; R2 points to the character.
	CALL	$UTLCH,R2,#OBUFF; Send the character.
	POP	R2		; Restore R2.

	MOV	(SP),R1		; Retrieve R1.
	MOV	(R1),R2		; Get the X coordinate.
	ASL	R2
	SWAB	R2		; Position the bits.
	BIC	#177740,R2	; Isolate the bits.
	BIS	#40,R2		; Add the flag bit.
	PUSH	R2		; Save the character.
	MOV	SP,R2		; R2 points to the character.
	CALL	$UTLCH,R2,#OBUFF; Send the character.
	POP	R2		; Restore R2.

	MOV	(SP),R1		; Retrieve R1.
	MOV	(R1),R2		; Get the X coordinate.
	ASR	R2
	ASR	R2		; Position the bits.
	BIC	#177740,R2	; Isolate the bits.
	BIS	#100,R2		; Add the flag bit.
	PUSH	R2		; Save the character.
	MOV	SP,R2		; R2 points to the character.
	CALL	$UTLCH,R2,#OBUFF; Send the character.
	POP	R2		; Restore R2.

	POP	R1		; Restore R1.
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Buffers and Data Area

	.PSECT	C$$DAT,RW,D,LCL,CON

OBUFF:	.WORD	BUFFER		; Start address of the buffer.
OBUFEN:	.WORD	BUFEND		; End address of the buffer.
OBUFPT:	.WORD	BUFFER		; Current pointer.
OCHAN:	.WORD	0		; RT-11 Output Channel Number.
OBLKN:	.WORD	0		; Block number.
BUFFER:	.BLKW	256.		; Output data buffer.
BUFEND	= .

P1:	.BLKW	2*<FLTSIZ/2>	; Temporary Storage
P2:	.BLKW	2*<FLTSIZ/2>
DC:	.BLKW	2*<INTSIZ/2>

CPNT:	.WORD	0
IHIGHT:	.WORD	0
IWIDTH:	.WORD	0
IUPVEC:	.WORD	0,0
IBSVEC:	.WORD	0,0
	.END