.MCALL	.MODULE,	.PRINT
.MODULE	DRVV50,RELEASE=V00,VERSION=20,COMMENT=<Visual 550 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		; Start at block 0.
	RTS	PC		; Return.

	.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

	.ENABL	LSB
;************************************************************************
;* Terminate								*
;************************************************************************

VTRM:	EXECUT	$UTLPR,<SELEDT,OBUFF> ; Select ALPHANUMERIC mode.
	EXECUT	$UTLFL,<OBUFF>	; Flush the buffer.
	RTS	PC		; Return.
	.DSABL	LSB

SELEDT:	.ASCII	<US><33>/</
	.ASCII	<30>//<200>	; Select ALPHA mode.
	.EVEN
	RTS	PC		; Return.
	.PAGE
	.SBTTL	Make Picture Current

	.ENABL	LSB
;************************************************************************
;* Make Picture Current							*
;************************************************************************

VMPC:	EXECUT	$UTLFL,<OBUFF>	; Flush the output buffer.
	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	Set Deferral Mode

	.ENABL	LSB
;************************************************************************
;* Set Deferral Mode							*
;************************************************************************

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

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

	.ENABL	LSB
;************************************************************************
;* Prepare View Surface							*
;************************************************************************

VPVS:	MOV	@2(R5),R1	; Get the indicator (FORCE HARDCOPY,
				; CONDITIONAL)
	EXECUT	$UTLPR,<CLRSFC,OBUFF> ; Renew View 1.
	RTS	PC		; Return.
	.DSABL	LSB

CLRSFC:	.ASCII	<US><33><14><200> ; Clear screen, enter graphics mode.
	.EVEN
	.PAGE
	.SBTTL	End Page

	.ENABL	LSB
;************************************************************************
;* End Page								*
;************************************************************************

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

	.ENABL	LSB
;************************************************************************
;* Background Color							*
;************************************************************************

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

	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	VDC Extent

	.ENABL	LSB
;************************************************************************
;* 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.
	.DSABL	LSB
	.PAGE
	.SBTTL	Device Viewport

	.ENABL	LSB
;************************************************************************
;* 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.
	.DSABL	LSB
	.PAGE
	.SBTTL	Clip Rectangle

	.ENABL	LSB
;************************************************************************
;* Clip Rectangle							*
;************************************************************************

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

	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	Clip Indicator

	.ENABL	LSB
;************************************************************************
;* Clip Indicator							*
;************************************************************************

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

	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	Polyline

	.ENABL	LSB
;************************************************************************
;* 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.

	EXECUT	$UTLCH,<PLSTRT,OBUFF>	; Set up to MOVE to the first point.

	EXECUT	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$:	EXECUT	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.
	EXECUT	$UTLCH,<PLSTOP,OBUFF>
	RTS	PC			; Return.
	.DSABL	LSB

PLSTRT:	.BYTE	<GS>
PLSTOP:	.BYTE	<US>
	.PAGE
	.SBTTL	Disjoint Polyline

	.ENABL	LSB
;************************************************************************
;* Disjoint Polyline							*
;************************************************************************

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

	.ENABL	LSB
;************************************************************************
;* 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.

	MOV	(SP),R5			; Restore R5.
	CALL	WTRANS,#C$DVEX,4(R5),#DC; Convert to device coordinates.
	SUB	#25.,DC			; Center the marker.
	SUB	#46.,DC+2		;
	EXECUT	$UTLCH,<PLSTRT,OBUFF>
	MOV	#DC,R1			; Get the address to MOVE to.
	JSR	PC,TEKXY		; Encode the point.
	EXECUT	$UTLCH,<PLSTOP,OBUFF>
	EXECUT	$UTLCH,<MTASC,OBUFF>	

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

	.EVEN
	.PAGE
	.SBTTL	TeXT

	.ENABL	LSB
;************************************************************************
;* TeXT									*
;************************************************************************

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

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	70$
	
40$:	CMP	C$TAH,#HCENTR
	BNE	50$
	DIVF	TWO,F0		; Divide by 2.
	BR	70$

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

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

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

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

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

	EXECUT	$UTLCH,<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	80$

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

	RTS	PC		; Return.
	.DSABL	LSB

TWO:	.FLT2	2.0
MOVE:	.BYTE	GS
GRATXT:	.BYTE	US
	.EVEN
	.PAGE
	.SBTTL	Draw Polygon

	.ENABL	LSB
;************************************************************************
;* Draw Polygon								*
;************************************************************************

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

	.ENABL	LSB
;************************************************************************
;* Set Line Type							*
;************************************************************************

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

	MOV	@2(R5),R0	; Get the index
	MOV	R0,C$LT
	DEC	R0
	BIC	#177774,R0	; Only four line types allowed.
	MOVB	LINTBL(R0),SELLTY+2 ; Get the device dependent index.
	EXECUT	$UTLPR,<SELLTY,OBUFF> ; Select line index.

10$:	RTS	PC		; Return.
	.DSABL	LSB

LINTBL:	.BYTE	'\, 'd, '@, 'b
SELLTY:	.BYTE	<US>,<33>,'\
	.EVEN
	.PAGE
	.SBTTL	Set Line Width

	.ENABL	LSB
;************************************************************************
;* Set Line Width							*
;************************************************************************

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

	.ENABL	LSB
;************************************************************************
;* Set Line Colour							*
;************************************************************************

VSLC:	RTS	PC		; Return.
	.DSABL	LSB

	.PAGE
	.SBTTL	Inquire Description Table Size

	.ENABL	LSB
;************************************************************************
;* Inquire Description Table Size					*
;************************************************************************

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

	.ENABL	LSB
;************************************************************************
;* 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.
	.DSABL	LSB
	.PAGE
	.SBTTL	Set Character Height

	.ENABL	LSB
;************************************************************************
;* 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.
        EXECUT	WSCHAT,<C$DVEX,C$CH,C$CW,C$CO,<C$CO+<2*FLTSIZ>>,IHIGHT,IWIDTH,IUPVEC,IBSVEC>
	EXECUT	$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
	.DSABL	LSB

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

	.ENABL	LSB
;************************************************************************
;* 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.
	.DSABL	LSB
	.PAGE
	.SBTTL	Text Colour

	.ENABL	LSB
;************************************************************************
;* Text Colour								*
;************************************************************************

VTC:	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	PolyMarker Colour

	.ENABL	LSB
;************************************************************************
;* PolyMarker Colour							*
;************************************************************************

VMC:	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	PolyMarker Type

	.ENABL	LSB
;************************************************************************
;* 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),R0	; Save the new colour.
	MOV	R0,C$MT		; Code the index.
	DEC	R0		; Start at 0, not 1.
	MOVB	MTLST(R0),MTASC	; Get the marker type.
10$:	RTS	PC		; Return.
	.DSABL	LSB

MTLST:	.BYTE	'., '+, '*, 'o, 'x
MTASC:	.BYTE	'*
	.EVEN
	.PAGE
	.SBTTL	Routines not yet Implemented.

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

	.ENABL	LSB
;************************************************************************
;* 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.
	.DSABL	LSB
	.PAGE
	.ENABL	LSB

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.
	.DSABL	LSB
	.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		; Output 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