.MCALL	.MODULE
.MODULE	DRV745,RELEASE=V00,VERSION=20,COMMENT=<HP 7475 Driver>
	.ENABL	LC
	.NLIST	CND
	.LIST	MEB

	.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	HARD		; Hard/Soft Copy Class

VECTOR	= 0
RASTER	= 1
OTHER	= 2

D$DT:	.WORD	VECTOR		; Display Type

IRG	= 0
IMM	= 1

D$BCC:	.WORD	IRG		; Background Color Capability
D$DMT:	.WORD	IRG		; Dynamic Modification for Transformation
D$BLC:	.FLT2	0.0,0.0		; Bottom Left Corner
D$URC:	.FLT2	16640.0,10365.0	; Upper Right Corner
D$DSW:	.WORD	414.		; Display Surface Width (mm)
D$DSH:	.WORD	258.		; Display Surface Height (mm)
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	/HP 7475 Plotter/<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,16640.0	; Storage for default viewport.
	.FLT2	0.0,10365.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.

	.SBTTL	Local flags 

SYMODE:	.WORD	0		; In(-1)/Out(0) of symbol mode.
	.PAGE
	.SBTTL	Initialize

	.ENABL	LSB
;************************************************************************
;* 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.
	EXECUT	$UTLPR,<PLTON,OBUFF> ; Plotter ON.
	RTS	PC		; Return.
	.DSABL	LSB

PLTON:
;	.ASCII	<33>/.(/	; Turn on the plotter.
	.ASCII	<33>/.@1024;0:/
	.ASCII	<33>/.M10;0;10;13;0:/
	.ASCII	<33>/.I512;;17:/
	.ASCII	<33>/.N;19:/
	.ASCII	/IN;/		; Turn on and Initialize.
	.ASCII	/VS19.05;/	; Pen speed (cm/sec).
	.ASCII	/PS0;/		; Select B size paper.
	.BYTE	200
	.EVEN
	.PAGE
	.SBTTL	Reset Defaults

	.ENABL	LSB
;************************************************************************
;* Reset Defaults							*
;************************************************************************

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

	MOV	#-1,C$LC	; Initialize pen selection (color).
	MOV	#12$,R5
	JSR	PC,VSLC

	MOV	#-1,C$MT	; Initialize marker type.
	MOV	#14$,R5
	JSR	PC,VMT

	RTS	PC		; Return.
	.DSABL	LSB

10$:	.WORD	1,11$
11$:	.WORD	1		; Default line type is 1.
12$:	.WORD	1,13$
13$:	.WORD	1		; Default pen is 1.
14$:	.WORD	1,15$
15$:	.WORD	3		; Default marker type is 3.
	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	Terminate

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

VTRM:	EXECUT	$UTLFL,<OBUFF>	; Flush the buffer.
	EXECUT	$UTLPR,<PLTOFF,OBUFF> ; Turn OFF the plotter.
	EXECUT	$UTLFL,<OBUFF>	; Flush the buffer.
	RTS	PC		; Return.
	.DSABL	LSB

PLTOFF:	.ASCII	/PU;/		; Pen up.
	.ASCII	/SP;/		; Store the pen.
	.ASCII	/IN;/		; Initialize.
;	.ASCII	<33>/.)/	; Plotter OFF.
	.BYTE	200
	.EVEN
	RTS	PC		; Return.
	.DSABL	LSB
	.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,<VPVS01,OBUFF>
	RTS	PC		; Return.
	.DSABL	LSB

VPVS01:	.ASCII	/IP;/		; Set P1 and P2 to default coordinates.
	.ASCII	/IW;/		; Set the input window.
	.BYTE	200
	.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.
	BGE	20$			
	JMP	60$			; Branch if DONE.

20$:	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	$UTLPR,<PENUP,OBUFF>	; Set up to MOVE to the first point.
	EXECUT	$UTLPR,<PENABS,OBUFF>	; Absolute MOVE.
	EXECUT	WTRANS,<C$DVEX,P1,DC>	; Convert P1 to device coordinates.
	MOV	#DC,R1			; Get the address to MOVE to.
	JSR	PC,HPCOOR		; Encode the point.
	EXECUT	$UTLCH,<SEMCOL,OBUFF>	; Add a semi-colon.
	TST	SYMODE			; In symbol mode?
	BEQ	25$			; Branch if not.

	EXECUT	$UTLPR,<EXSYMB,OBUFF>	; Exit symbol mode.
	CLR	SYMODE			; Clear the symbol mode flag.
25$:	EXECUT	$UTLPR,<PENDWN,OBUFF>	; Put the pen down
	EXECUT	$UTLPR,<PENABS,OBUFF>	; Absolute DRAW.
	BR	40$			; Avoid a COMMA now.

30$:	EXECUT	$UTLCH,<COMMA,OBUFF>	; Send a separator.
40$:	EXECUT	WTRANS,<C$DVEX,P2,DC>	; Convert P2 to device coordinates.
	MOV	#DC,R1			; R1 points to the destination.
	JSR	PC,HPCOOR		; Encode the point.

50$:	DEC	2(SP)			; Count line segments.
	BLT	60$			; 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	30$			; Branch if there is.
	EXECUT	$UTLCH,<SEMCOL,OBUFF>	; Add a semi-colon.
	JMP	10$			; Otherwise, start over.

60$:	ADD	#4,SP			; Clear the stack.
	EXECUT	$UTLCH,<SEMCOL,OBUFF>
	RTS	PC			; Return.
	.DSABL	LSB

PENUP:	.ASCII	/PU;/<200>
PENDWN:	.ASCII	/PD;/<200>
EXSYMB:	.ASCII	/SM;/<200>
PENABS:	.ASCII	/PA/<200>
SEMCOL:	.ASCII	/;/
	.EVEN
	.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	20$			; Branch if we should clip.

	TST	SYMODE			; Are we in symbol mode?
	BNE	10$			; Branch if we are.

	EXECUT	$UTLPR,<MRKCOL,OBUFF>	; Select the marker colour.
	MOV	C$MC,R1			; Code the index.
	DEC	R1			; Start at 0, not 1.
	MOVB	MCLLST(R1),R0		; Get the pen number.
	JSR	PC,HPINT
	EXECUT	$UTLCH,<SEMCOL,OBUFF>

	EXECUT	$UTLPR,<MARKSZ,OBUFF>	; Select the marker size.
	EXECUT	$UTLPR,<MRKTYP,OBUFF>	; Send the command.
	MOV	C$MT,R1			; Code the index.
	DEC	R1			; Start at 0, not 1.
	ADD	#MTLST,R1		; R1 has the address of the character.
	CALL	$UTLCH,R1,#OBUFF
	EXECUT	$UTLCH,<SEMCOL,OBUFF>

10$:	EXECUT	$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,HPCOOR		; Encode the point.
	EXECUT	$UTLCH,<SEMCOL,OBUFF>	; Send the terminator.
	MOV	#-1,SYMODE		; Set the flag.

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

MRKCOL:	.ASCII	/SP/<200>
MRKTYP:	.ASCII	/SM/<200>
MARKSZ:	.ASCII	/SR.75,1.5;/<200>	; Select character size.
DRWMRK:	.ASCII	/PU;/			; Raise the pen.
	.ASCII	/PA/<200>		; Move in absolute mode.
MTLST:	.BYTE	'., '+, '*, 'o, 'x	; List of markers.
MCLLST:	.BYTE	 1,  2,  3,  4,  5,  6	; List of colours (pens)
	.EVEN
	.PAGE
	.SBTTL	TeXT

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

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

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

	MOV	6(R5),CPNT		; Save the pointer to the string.
	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.

	EXECUT	$UTLPR,<PENUP,OBUFF>	; Set up to MOVE to the first point.
	EXECUT	$UTLPR,<PENABS,OBUFF>	; Absolute MOVE.
	EXECUT	WTRANS,<C$DVEX,P1,DC>	; Convert P1 to device coordinates.
	MOV	#DC,R1			; Get the address to MOVE to.
	JSR	PC,HPCOOR		; Encode the point.
	EXECUT	$UTLCH,<SEMCOL,OBUFF>	; Add a semi-colon.

	EXECUT	$UTLPR,<CHPLOT,OBUFF>	; Position the text.

	MOV	(SP),R0			; Retrieve the character count.
	LDCIF	R0,F0			; Put into a floating point register.

	CMP	C$TAH,#HNORMA		; Check for horizontal justification.
	BEQ	35$
	CMP	C$TAH,#HLEFT		; Check the horizontal justification
	BNE	40$

35$:	EXECUT	$UTLPR,<CHDFLT,OBUFF>	; Put in default values.
	BR	60$
	
40$:	CMP	C$TAH,#HCENTR
	BNE	50$
	DIVF	TWO,F0			; Divide by 2.
	NEGF	F0			; Indicate move to the left.
	STF	F0,P1			; Save the value.
	MOV	#P1,R0
	JSR	PC,HPDEC
	BR	60$

50$:	CMP	C$TAH,#HRIGHT
	BNE	60$
	NEG	R0			; Indicate move to the left.
	JSR	PC,HPINT


60$:	EXECUT	$UTLCH,<COMMA,OBUFF>

	CMP	C$TAV,#VTOP
	BNE	70$
	MOV	#-2,R0
	JSR	PC,HPINT
	BR	100$

70$:	CMP	C$TAV,#VCAP
	BNE	75$
	MOV	#-1,R0
	JSR	PC,HPINT
	BR	100$

75$:	CMP	C$TAV,#VHALF
	BNE	80$
	MOV	#MP5,R0
	JSR	PC,HPDEC
	BR	100$

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

90$:	MOV	#0,R0
	JSR	PC,HPINT
	
100$:	EXECUT	$UTLCH,<SEMCOL,OBUFF>

	EXECUT	$UTLPR,<LABEL,OBUFF>	; Set up to do a label.

	CALL	$UTLPR,CPNT,#OBUFF	; Do the string.
	EXECUT	$UTLCH,<ETX,OBUFF>	; End-of-Text string.

	TST	(SP)+		; Clear the stack.

	RTS	PC		; Return.
	.DSABL	LSB

MP5:	.FLT2	-0.5
TWO:	.FLT2	2.0
CHDFLT:	.ASCII	/0/<200>
CHPLOT:	.ASCII	/CP/<200>
LABEL:	.ASCII	/LB/<200>
ETX:	.BYTE	<3>
	.EVEN
	RTS	PC		; Return.
	.DSABL	LSB
	.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	20$		; Branch if not.

	PUSH	R5		; Save R5.
	EXECUT	$UTLPR,<SELLTY,OBUFF> ; Select line index.
	POP	R5		; Restore R5.
	MOV	@2(R5),C$LT	; Get the index
	MOV	C$LT,R1
	DEC	R1		; Change from (1 - N) to (0 - N-1).
	BIC	#177774,R1	; Must be 0-3.
	BEQ	10$		; This device doesn't have an index for
				; solid lines (Line Type Index 0).

	MOVB	LTLIST(R1),R0	; Get the desired line type.
	JSR	PC,HPINT	; Encode and send it.
10$:	EXECUT	$UTLCH,<SEMCOL,OBUFF> ; Terminate the command.
20$:	RTS	PC		; Return.
	.DSABL	LSB

SELLTY:	.ASCII	/LT/<200>
LTLIST:	.BYTE	-1,2,1,4
	.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:	CMP	@2(R5),C$LC	; New line color?
	BEQ	10$		; Branch if not.

	PUSH	R5		; Save R5.
	EXECUT	$UTLPR,<SELLIX,OBUFF> ; Select line index.
	POP	R5		; Restore R5.
	MOV	@2(R5),C$LC	; Get the index
	MOV	C$LC,R0
	JSR	PC,HPINT	; Encode and send it.
	EXECUT	$UTLCH,<SEMCOL,OBUFF> ; Terminate the command.

10$:	RTS	PC		; Return.
	.DSABL	LSB

SELLIX:	.ASCII	/SP/<200>
	.EVEN
	.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:	SETF
	SETI
	LDF	@2(R5),F0
	STF	F0,C$CH		; Store the character height.
	MULF	POINT5,F0	; Default character width.
	STF	F0,C$CW
        EXECUT	WSCHAT,<C$DVEX,C$CH,C$CW,C$CO,<C$CO+<2*FLTSIZ>>,IHIGHT,IWIDTH,IUPVEC,IBSVEC>
	EXECUT	$UTLPR,<SETSIZ,OBUFF>

	LDCIF	IWIDTH,F0	; Width in device units.
	LDF	D$URC,F1
	SUBF	D$BLC,F1
	DIVF	F1,F0
	MULF	TEN2,F0		; Convert to a percentage.
	STF	F0,P1
	MOV	#P1,R0		; Encode the character width.
	JSR	PC,HPDEC	

	EXECUT	$UTLCH,<COMMA,OBUFF>

	LDCIF	IHIGHT,F0	; Height in device units.
	LDF	D$URC+<FLTSIZ>,F1
	SUBF	D$BLC+<FLTSIZ>,F1
	DIVF	F1,F0
	MULF	TEN2,F0		; Convert to a percentage.
	STF	F0,P1
	MOV	#P1,R0		; Encode the character width.
	JSR	PC,HPDEC	

	EXECUT	$UTLCH,<SEMCOL,OBUFF> ; Terminate the command.
	RTS	PC
	.DSABL	LSB


POINT5:	.FLT2	0.5
SETSIZ:	.ASCII	/SR/<200>
	.EVEN
	.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:	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.
	EXECUT	$UTLPR,<SELLIX,OBUFF> ; Select line index.
	MOV	C$TC,R0
	JSR	PC,HPINT	; Encode and send it.
	EXECUT	$UTLCH,<SEMCOL,OBUFF> ; Terminate the command.
10$:	RTS	PC		; Return.
	.DSABL	LSB
	.PAGE
	.SBTTL	PolyMarker Colour

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

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

	MOV	@2(R5),R0
10$:	SUB	#6,R0		; Normalize to the interval 1-6.
	BGT	10$

	ADD	#6,R0
	MOV	R0,C$MC		; Save the new colour.
20$:	RTS	PC		; Return.
	.DSABL	LSB
	.EVEN
	.PAGE
	.SBTTL	PolyMarker Type

	.ENABL	LSB
;************************************************************************
;* PolyMarker Type							*
;************************************************************************

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

	MOV	@2(R5),C$MT	; Save the marker index.
10$:	SUB	#5,R0		; Normalize to the interval 1-5.
	BGT	10$

	ADD	#5,R0
20$:	RTS	PC		; Return.
	.DSABL	LSB
	.EVEN
	.PAGE
	.SBTTL	Routines not yet Implemented.

	.ENABL	LSB
VTP:
VCO:
VCEF:
VCS:
VMS:
	RTS	PC
	.DSABL	LSB
	.PAGE

	.ENABL	LSB
;************************************************************************
;* Special HPGL output routines.					*
;************************************************************************

HPCOOR:	MOV	(R1)+,R0	; Get the X coordinate.
	PUSH	R1
	JSR	PC,HPINT	; Output the integer.
	EXECUT	$UTLCH,<COMMA,OBUFF> ; Need a comma.
	MOV	(SP),R1
	MOV	(R1)+,R0	; Get the Y coordinate.
	JSR	PC,HPINT
	POP	R1
	RTS	PC		; Return.

HPIN2:	MOV	#-1,R3		; Print leading zeros.
	MOV	#<SUBTBL+2>,R1	; Do 4 digits only.
	BR	HPIN3

HPINT:	CLR	R3		; R3 is zero flag.
	MOV	#SUBTBL,R1	; R1 points to the subtraction table.

HPIN3:	TST	R0		; Negative or positive?
	BGE	10$

	PUSH	R0,R1,R3
	EXECUT	$UTLCH,<MINUS,OBUFF>
	POP	R3,R1,R0
	NEG	R0

10$:	TST	(R1)		; End of table?
	BLT	50$		; Branch if it is.

	CLR	R2		; Use R2 as a counter.
	BR	30$

20$:	INC	R2		; Add 1.
30$:	SUB	@R1,R0		; Subtract current power of 10.
	BGE	20$		; Keep going until negative.

	ADD	(R1)+,R0	; Add the power of 10 back in.

	TST	R2		; Is R2 = 0?
	BNE	40$		; Branch if it isn't.
	TST	R3		; Have any non-zero digits been sent?
	BEQ	10$		; Branch if they haven't.

40$:	MOV	#-1,R3		; Non-zero digit. Set the flag.
	PUSH	R0,R1,R3	; Save active registers.
	ADD	#'0,R2		; Convert the number to ASCII.
	PUSH	R2
	MOV	SP,R2		; R2 <-- Pointer to the character.
	CALL	$UTLCH,R2,#OBUFF; Send the character.
	POP	R2,R3,R1,R0	; Clean up the stack.
	BR	10$		; Continue.

50$:	TST	R3		; Anything printed?
	BNE	60$		; Branch if it has.
	EXECUT	$UTLCH,<ZERO,OBUFF> ; Supply at least one 0.

60$:	RTS	PC
	.DSABL	LSB

MINUS:	.ASCII	/-/
ZERO:	.BYTE	<60>
	.EVEN
SUBTBL:	.WORD	10000.
	.WORD	 1000.
	.WORD	  100.
	.WORD	   10.
	.WORD	    1.
	.WORD	-1

	.ENABL	LSB
HPDEC:	SETF
	SETI
	MOV	R0,-(SP)	; Save the pointer.
	LDF	@(SP),F1	; Get the number to create.
	STCFI	F1,R0		; Convert to an integer.	

	JSR	PC,HPINT	; Convert to ASCII.

	EXECUT	$UTLCH,<PERIOD,OBUFF>

	LDF	@(SP)+,F1	; Get the number.
	ABSF	F1		; Take the absolute value.
	STCFI	F1,R0		; Isolate the positive powers.
	LDCIF	R0,F0		; Convert to floating.
	SUBF	F0,F1		; Only negative powers are left.
	MULF	TEN4,F1		; Multiply by 10**3.
	STCFI	F1,R0		; Isolate the positive powers.
	JSR	PC,HPIN2	; Convert to ASCII
	RTS	PC		; Return.	
	.DSABL	LSB

TEN2:	.FLT2	100.
TEN4:	.FLT2	10000.
COMMA:	.ASCII	/,/
PERIOD:	.ASCII	/./
	.EVEN
	.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