;This is a COPY (include) file used by MAKPDV.

	OBJNAM	.PDV

;***************************************
;*  AlphaWRITE 2.0 special characters  *
;***************************************

	C$NXB	=^H0CB			; non-exandable space
	C$DEG	=^H0CE			; degree symbol
	C$PAR	=^H0CF			; paragraph symbol
	C$DAG	=^H0D0			; dagger
	C$SEC	=^H0D1			; section symbol
	C$CNT	=^H0D2			; cent sign
	C$QTR	=^H0D3			; 1/4
	C$HAF	=^H0D4			; 1/2
	C$TM 	=^H0D5			; trademark symbol
	C$CPY	=^H0D6			; copyright symbol
	C$REG	=^H0D7			; registered symbol
	C$STR	=^H0E1			; star
	C$BLT	=^H0E2			; bullet
	C$EMD	=^H0E3			; em dash
	C$END	=^H0E4			; en dash
	C$RTN	=^H0E6			; RETURN keycap

;******************
;*  $SPLFL flags  *
;******************

	PF$CPY	=1			; number of copies specified
	PF$DEL	=2			; delete file after printing
	PF$BAN	=4			; print leading banner page
	PF$HDR	=10			; print header at top of each page
	PF$FF	=20			; print form feeds
	PF$FRM	=400			; use specified form name
	PF$INF	=100000			; inform user when printing done

;*********************************
;*  impure area local variables  *
;*********************************
;indexed by A3

	BLDMAX	=200.			; size of bold text buffer

	.OFINI	RESVUS
	.OFDEF	FLAGS,	2		; flags:
		F$BLD	=1		;   bold enabled
		F$ITA	=2		;   italic enabled
		F$FNT	=4		;   font selection required
		F$PRO	=10		;   proportionally spacing
		F$UND	=20		;   underscore in effect
		F$REV	=100		;   reverse in effect
		F$SCR	=200		;   screened in effect
		F$DBL	=400		;   double underscore in effect
	.OFDEF	CURFNT,	1		; current font letter/digit
	.OFDEF	CURSIZ,	1		; current font size (height in points)
	.OFDEF	PITCH,	1		; pitch
	.OFDEF	TABFLG,	1		; tab adjustment flip-flop	
	.OFDEF	LFTOFF,	4		; left paper offset (centipoints) [255]
	.OFDEF	H.LOC,	4		; horizontal location in centipoints [255]
	.OFDEF	V.LOC,	2		; vertical location in points
	.OFDEF	V.SIZ,	2		; size of a line in points
	.OFDEF	TOPMGN,	2		; top margin (points)
	.OFDEF	SAVLPI,	1		; saved lines-per-inch
	.OFDEF	UNUSED,	1		; unused (even up address)
	.OFDEF	REMREG,	2		; remainder register		
	.OFDEF	PAGSIZ,	2		; page size			
	.OFDEF	SPCSIZ,	2		; space expansion size (centipoints)
	.OFDEF	SPCACC,	2		; accummulating space size (centipoints)
	.OFDEF	CHRSIZ,	2		; size of a character (centipoints)
	.OFDEF	OUTCOL,	2		; current column (1..n)
	.OFDEF	UNDSTA,	2		; underscore: starting column
	.OFDEF	UNDEND,	2		; underscore: ending column
	.OFDEF	BLDSTA,	2		; bold: starting column
	.OFDEF	BLDEND,	2		; bold: ending column
	.OFDEF	BLDTXT,	BLDMAX		; bold buffer
	.OFDEF	BLDIDX,	4		; bold buffer address
	.OFDEF	BLDSIZ,	2		; bold text size
	.OFSIZ	MEMSIZ

	IF	GT,MEMSIZ-PDVEXT,ASMERP "?Impure area size exceeded"

;************
;*  macros  *
;************

;add word (memory to memory)

DEFINE	ADDW2	SRC,DST
	MOVW	SRC,D7
	ADDW	D7,DST
	ENDM

DEFINE	ADD2	SRC,DST
	MOV	SRC,D7
	ADD	D7,DST
	ENDM

;subtract word (memory to memory)

DEFINE	SUBW2	SRC,DST
	MOVW	SRC,D7
	SUBW	D7,DST
	ENDM

;output ASCIZ string to output file

DEFINE	OUTSTR	ADDR
	LEA	A6,ADDR
	CALL	OUT.STRING
	ENDM

DEFINE	OUTFNT	ADDR
	LEA	A6,ADDR
	CALL	OUT.FONT
	ENDM

DEFINE	BITW	SRC,DST
	MOVW	DST,D7
	ANDW	SRC,D7
	ENDM

DEFINE	BIT	SRC,DST
	MOV	DST,D7
	AND	SRC,D7
	ENDM

PAGE
;***************
;*  PDV entry  *
;***************
;Define the entry points of the .PDV
;
;  CAUTION: Do not change the order or size of the entry points.
;           If any of the functions are not implemented replace the entry
;           point with 'JMP IGNORE'.
;
;  A3 indexes the impure area defined above on entry to the driver.

	PDVFLG	=PD$W20!PD$EXT!PD$PTS!PD$BLD!PD$FNT!PD$EDG!PD$TOP!PD$PCH!PD$ITL!PD$REV!PD$SCR
					; == printer characteristics ==
					; AlphaWRITE 2.0 compatible
					; points-oriented calling interface
					; bold style
					; selectable fonts
					; can print at edge of page
					; top-of-char printhead orientation
					; variable word spacing
					; can return printer characteristics

PDV:	PHDR	-1,0,PH$REE!PH$REU	; program header
	LWORD	PDVFLG			; printer driver flags
	JMP	PDINI			; PDINI,  initialize printer
	JMP	PDCLS			; PDCLS,  shut down printer
	JMP	PDCHR			; PDCHR,  output a character in D1
	JMP	PDCTL			; PDCTL,  output control string indexed by D1
	JMP	IGNORE        		; PDSPL,  output special string & character
	JMP	PDMNLN			; PDMNLN, move to next line & start new line
	JMP	PDMTOF			; PDMTOF, move to Top of Form & setup for new page
	JMP	PDPSON			; PDPSON, enable proportional
	JMP	PDPSOF			; PDSOF,  disable proportional
	JMP	PDUNDR			; PDUNDR, toggle underscore
	JMP	PDBOLD			; PDBOLD, toggle bold
	JMP	IGNORE			; PDSTRK, toggle strikeout
	JMP	IGNORE			; PDBAR,  toggle over-bar
	JMP	PDSLPI			; PDSLPI, set Lines Per Inch
	JMP	IGNORE			; PDSHMI, set Horizontal Motion Index
	JMP	PDSCPI			; PDSCPI, set Characters Per Inch
	JMP	IGNORE			; PDSTM,  set Top Margin
	JMP	PDMTM			; PDMTM,  move to Top Margin
	JMP	PDSLPO			; PDSLPO, set Left Paper Offset
	JMP	PDMLPO			; PDMLPO, move to Left Paper Offset
	JMP	PDSLPP			; PDSLPP, set Lines per Page
	JMP	PDSLSP			; PDSLSP, set line spacing (in 1/2 lines)
	JMP	PDOVRP			; PDOVRP, setup to overprint last char.
	JMP	PDLF			; PDLF,   output LFs per count in D2
	JMP	PDDBL			; PDDBL,  double underscore
	JMP	PDFONT			; PDFONT, set font
	JMP	IGNORE			; PDECHR, extended character (obsolete)
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	IGNORE			;   ENTRY RESERVED FOR USER DEFINITION
	JMP	PDPSIZ			; PDPSIZ, set page size to points in D2
	JMP	PDTMAR			; PDTMAR, set top margin to points in D2
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	IGNORE			;   ENTRY RESERVED FOR ALPHA MICRO
	JMP	PDLEFT			; PDLEFT, set left paper offset to points in D2
	JMP	IGNORE			; PDLEAD, set leading to points in D2
	JMP	IGNORE			; PDFNAM, set font by name (ASCIZ string @A6)
	JMP	PDFSIZ			; PDFSIZ, set font size to points in D2
	JMP	PDITAL			; PDITAL, toggle italic
	JMP	PDSCRN			; PDSCRN, toggle screened
	JMP	PDREV			; PDREV,  toggle reverse
	JMP	PDFATR			; PDFATR, set font attributes directly
	JMP	PDMCHR			; PDMCHR, move to char position in D2
	JMP	PDMLIN			; PDMLIN, move to line position in D2
	JMP	PDMOVE			; PDMOVE, move to points (D1,D2) coordinates
	JMP	IGNORE			; PDSAVE, save print state
	JMP	IGNORE			; PDREST, restore print state
	JMP	PDFTBL			; PDFTBL, return index to font table in A6
	JMP	PDCHR			; PDOUT,  directly output byte in D1
	JMP	IGNORE			; PDSPOR, set page orientation (D1 = "P" or "L")
	JMP	IGNORE			; PDGRAY, set gray scale (D2 = % blk)
	JMP	IGNORE			; PDGRAF, perform graphics. func (D2)
	JMP	PDFSUB			; PDFSUB, perform font substitution (font code in D1)
	JMP	IGNORE			; PDTRSC, translate special character D1
	JMP	IGNORE			; PDTREC, translate extended character D1
	JMP	PDOTSC  		; PDOTSC, output special character D1
	JMP	PDCHR			; PDOTEC, output extended character D1
	JMP	IGNORE			; PDSETL, set line weight to points in D2
	JMP	IGNORE			; PDPOVR, print page overlay (D2 indexes text)
	JMP	IGNORE			; PDIMON, begin image/icon
	JMP	IGNORE			; PDIMOF, end image/icon
	JMP	IGNORE			; PDKEY,  toggle keycap
	JMP	IGNORE			; PDCART, set cartridge as per D2
	JMP	IGNORE			; PDKERN, set kerning as per D2
	JMP	IGNORE			; PDSPAG, set page printing
	JMP	IGNORE			; PDOUTL, toggle outline fonts
	JMP	IGNORE			; PDCBAR, toggle change bars
	JMP	PDPCH			; PDPCH,  return printer characteristics

IGNORE:	RTN				; just return to caller of .PDV

PAGE
;***********
;*  PDINI  *
;***********
;Function:	Initialize the printer

PDINI:	OUTSTR	$PDINI			; output printer initialization
	MOVB	#'C,CURFNT(A3)		; say current font is Courier
	MOVB	#10.,CURSIZ(A3)		; say current font size is 10
	MOVW	#F$FNT,FLAGS(A3)	; flag for font selection
	MOVB	#12.,PITCH(A3)		; pre-set pitch to 12 CPI
	CLR	H.LOC(A3)		; set starting point		[255]
	CLRW	V.LOC(A3)		;   on page	
	MOVW	#72./8.,V.SIZ(A3)	; set line size
	MOVB	#8.,SAVLPI(A3)		; 6 lpi
	MOVW	#1,OUTCOL(A3)		; at column one
	MOVW	#7200./10.,CHRSIZ(A3)	; set size of a character in centipoints [171]
	RTN				; return

;***********
;*  PDCLS  *
;***********
;Function:	Shut down the printer

PDCLS:	MOV	#PF$DEL!PF$CPY!PF$FRM!PF$FF,SPLPOS(A3) ; /DELETE/COPIES:n/FORMS:ffff/FORMFEED [190]
	MOV	#PF$INF,SPLNEG(A3)			; /NOINFORM	[190]
	OUTSTR	$PDCLS			; output printer shut-down
	RTN				; return

;***********
;*  PDCHR  *
;***********
;Function:	Output character
;
;Inputs:	D1 - character to output

PDCHR:	CALL	SELECT.FONT		; select font if so flagged

	BCALL	SPCOUT			; 

;proportional space handling

	CMPB	D1,#40			; space?
	BNE	10$			;   no
	BITW	#F$PRO,FLAGS(A3)	; proportional spacing in effect?
	BEQ	10$			;   no

	ADDW2	SPCSIZ(A3),SPCACC(A3)	; 
	CMMW	SPCACC(A3),CHRSIZ(A3)	; 
	BLO	10$			; 
	BCALL	SPCOUT			; 
	SUBW2	CHRSIZ(A3),SPCACC(A3)	; 

10$:	RTN				; return

SPCOUT:	FILOTB	PTDDB(A3)		; output character
	INCW	OUTCOL(A3)		; update column
	CLR	D7			; 				[255]
	MOVW	CHRSIZ(A3),D7		; 				[255]
	ADD	D7,H.LOC(A3)		; 			[171][255]
10$:	RTN				; 

;***********
;*  PDCTL  *
;***********
;Function:	Output a control string.
;
;Inputs:	D1 - string index

PDCTL:	SAVE	D1			; save registers
	CMPB	D1,#MAXCDE		; valid special code ?
	BHIS	10$			;   no, ignore it
	ADDW	D1,D1			; make index into word offset
	MOVW	CTLTBL[~D1],D1		; index address
	LEA	A6,CTLTBL[~D1]		;   of string
	CALL	OUT.STRING		; go output it
10$:	REST	D1			; restore registers
	RTN				; return

; Printer control string table
; CAUTION: Do not change the order of the string table.
;          If the string is not implemented put a length of zero at the label.

DEFINE	STRING	TAG
	WORD	TAG-CTLTBL
	ENDM

CTLTBL:	STRING	$CHOME			; 00 return carriage home
	STRING	$MOVAH			; 01 move to absolute horizontal tab
	STRING	$ROLUP			; 02 roll up a partial line
	STRING	$ROLDW			; 03 roll down a partial line
	STRING	$NEGLF			; 04 output negative line feed
	STRING	$SPLP0			; 05 special print position 0
	STRING	$SPLP1			; 06 special print position 1
	STRING	$RIBS1			; 07 print in Secondary ribbon color 1
	STRING	$RIBS2			; 08 print in Secondary ribbon color 2
	STRING	$RIBS3			; 09 print in Secondary ribbon color 3
	STRING	$RIBPR			; 10 print in Primary ribbon color
	STRING	$FDTR1			; 11 select Feeder tray 1
	STRING	$FDTR2			; 12 select Feeder tray 2
	STRING	$FDTR3			; 13 select Feeder tray 3
	STRING	$FDTR4			; 14 select Feeder tray 4
	STRING	$FDTGL			; 15 select Feeder tray 1 & then tray 2
	STRING	$FDEJT			; 16 select Feeder eject
 	STRING	$USR1			; 17 user function 1
	STRING	$USR2			; 18 user function 2
	STRING	$USR3			; 19 user function 3
	STRING	$USR4			; 20 user function 4
	STRING	$RIBS4			; 21 print in Secondary ribbon color 4
	STRING	$RIBS5			; 22 print in Secondary ribbon color 5
	STRING	$RIBS6			; 23 print in Secondary ribbon color 6
	STRING	$RIBS7			; 24 print in Secondary ribbon color 7
TBLEND:					; end of table
	MAXCDE=<<TBLEND-CTLTBL>/2.>	; maximum special code

;************
;*  PDMNLN  *
;************
;Function:	Move to Next Line and setup for new line

PDMNLN:	SAVE	D1			; save registers
	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	10$			;   no
	OUTSTR	$PDUOF			;   yes - turn off underscoring
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	15$			;   no
	OUTSTR	$PDBOF			;   yes - turn off bolding
15$:	MOVB	#$CR,D1			; output
	FILOTB	PTDDB(A3)		;   carriage return
	MOVB	#$LF,D1			; output
	FILOTB	PTDDB(A3)		;   line feed
	MOVW	#1,OUTCOL(A3)		; reset column
20$:	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	25$			;   no
	OUTSTR	$PDUON			;   yes - turn it back on
25$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	30$			;   no
	OUTSTR	$PDBON			;   yes - turn it back on
30$:	CLR	H.LOC(A3)		; 				[255]
	ADDW2	V.SIZ(A3),V.LOC(A3)	; add size of a line to vert. pos
	REST	D1			; restore registers
	RTN				; return

;************
;*  PDMTOF  *
;************
;Function:	Move to Top of Form and setup for new page

PDMTOF:	SAVE	D1			; save registers
	MOVB	#$FF,D1			; load form feed
	FILOTB	PTDDB(A3)		; output it
	MOVW	#1,OUTCOL(A3)		; reset column
	CLR	H.LOC(A3)		; clear horizontal position	[255]
	CLRW	V.LOC(A3)		; clear vertical position
	REST	D1			; restore registers
	RTN				; return

;************
;*  PDPSON  *
;************
;Function:	Enable proportional spacing
;
;Inputs:	WRDSPC(A3) - #points to advance after each space
;		SPCCNT(A3) - number of spaces in line

PDPSON:	ORW	#F$PRO,FLAGS(A3)	; 
	FFTOL	WRDSPC(A3),D7		; 
	MUL	D7,#100.		; 
	MOVW	D7,SPCSIZ(A3)		; 
	CLRW	SPCACC(A3)		; 
	RTN				; 

;************
;*  PDPSOF  *
;************
;Function:	Disable proportional spacing

PDPSOF:	ANDW	#^C<F$PRO>,FLAGS(A3)	; 
	RTN				; 

;************
;*  PDUNDR  *
;************
;Function:	Toggle Underscore

PDUNDR:	XORW	#F$UND,FLAGS(A3)	; flip underscore flag
	BITW	#F$UND,FLAGS(A3)	; underscore on or off?
	BEQ	PDUOFF			;   off

PDUON:	OUTSTR	$PDUON			; turn on underscore
	RTN				; 

PDUOFF:	OUTSTR	$PDUOF			; turn off underscore
	RTN				; 

;***********
;*  PDDBL  *
;***********
;Function:	Toggle Double Underscore

PDDBL:	XORW	#F$DBL,FLAGS(A3)	; flip dbl underscore flag
	BITW	#F$DBL,FLAGS(A3)	; dbl underscore on or off?
	BEQ	PDDOFF			;   off

PDDON:	OUTSTR	$PDDON			; turn on dbl underscore
	RTN				; 

PDDOFF:	OUTSTR	$PDDOF			; turn off dbl underscore
	RTN				; 

;************
;*  PDBOLD  *
;************
;Function:	Toggle Bold

PDBOLD:	XORW	#F$BLD,FLAGS(A3)	; flip bold flag
	BITW	#F$BLD,FLAGS(A3)	; bold on or off?
	BEQ	PDBOFF			;   off

PDBON:	OUTSTR	$PDBON			; turn on bold
	RTN				; 

PDBOFF:	OUTSTR	$PDBOF			; turn off bold
	RTN				; 

;***********
;*  PDREV  *
;***********
;Function:	Toggle Reverse

PDREV:	XORW	#F$REV,FLAGS(A3)	; flip reverse flag
	BITW	#F$REV,FLAGS(A3)	; reverse on or off?
	BEQ	PDROFF			;   off

PDRON:	OUTSTR	$PDRON			; turn on reverse
	RTN				; 

PDROFF:	OUTSTR	$PDROF			; turn off reverse
	RTN				; 

;************
;*  PDSCRN  *
;************
;Function:	Toggle Screened

PDSCRN:	XORW	#F$SCR,FLAGS(A3)	; flip screened flag
	BITW	#F$SCR,FLAGS(A3)	; screened on or off?
	BEQ	PDSOFF			;   off

PDSON:	OUTSTR	$PDSON			; turn on screened
	RTN				; 

PDSOFF:	OUTSTR	$PDSOF			; turn off screened
	RTN				; 

;************
;*  PDSCPI  *
;************
;Function:	Set characters per inch (pitch)
;
;Inputs:	D2 - pitch

PDSCPI:	LEA	A6,$CPI10		; 
	CMP	D2,#10.			; valid pitch of 10?
	BEQ	10$			;   yes
	LEA	A6,$CPI12		; 
	CMP	D2,#12.			; valid pitch of 12?
	BEQ	10$			;   yes
	LEA	A6,$CPI15		; 
	CMP	D2,#15.			; valid pitch of 15?
	BNE	20$			;   yes

10$:	CMPB	D2,PITCH(A3)		; 
	BEQ	20$			; 
	MOVB	D2,PITCH(A3)		; set pitch
	MOV	#7200.,D7		; calculate
	DIV	D7,D2			;   size of a
	MOVW	D7,CHRSIZ(A3)		;     character in centipoints
	OUTSTR	@A6			; 

20$:	RTN				; return

;************
;*  PDSLPI  *
;************
;Function:	Set lines per inch
;
;Inputs:	D2 - lines per inch

PDSLPI:	CMPW	D2,#6			; valid lines per inch setting?
	BEQ	PDSLP6			; 
	CMPW	D2,#8.			; 
	BEQ	PDSLP8			; 

PDSLP6:	MOV	#6,D2			; 
	CMPB	D2,SAVLPI(A3)		; 
	BEQ	PDSLP3			; 
	OUTSTR	$LPI6			; 
	BR	PDSLP2			; 

PDSLP8:	MOV	#8.,D2			; 
	CMPB	D2,SAVLPI(A3)		; 
	BEQ	PDSLP3			; 
	OUTSTR	$LPI8			; 

PDSLP2:	MOVB	D2,SAVLPI(A3)		; set lines per inch
	MOV	#72.,D7			; calculate
	DIV	D7,D2			;   size of
	MOVW	D7,V.SIZ(A3)		;   a line

PDSLP3:	RTN				; return

;***********
;*  PDMTM  *
;***********
;Function:	Move to Top Margin

PDMTM:	SAVE	D1-D2			; save registers
	CLR	D1			; get left
	CLR	D2			; get top
	MOVW	TOPMGN(A3),D2		;   margin setting
	BEQ	10$			;     zero - we're already there
	CALL	PDMOVE			; move to (lpo, topmgn)
10$:	REST	D1-D2			; restore registers
	RTN				; return

;************
;*  PDSLPO  *
;************
;Function:	Set Left Paper Offset
;
;Inputs:	D2 contains the number of 1/10 inch units required

PDSLPO:	SAVE	D2			; save register
	MUL	D2,#720.		; convert to
	AND	#177777,D2		;   centipoints
	MOV	D2,LFTOFF(A3)		; save left paper offset	[255]
	REST	D2			; restore registers
	RTN				; return

;************
;*  PDMLPO  *
;************
;Function:	Move to Left Paper Offset

PDMLPO:	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	10$			;   no
	OUTSTR	$PDUOF			;   yes - turn it off
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	15$			;   no
	OUTSTR	$PDBOF			;   yes - turn it off
15$:	MOV	LFTOFF(A3),D6		; convert lpo			[255]
	CALL	TAB.CENTIPOINTS		; move there
	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	20$			;   no
	OUTSTR	$PDUON			;   yes - turn it back on
20$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	30$			;   no
	OUTSTR	$PDBON			;   yes - turn it back on
30$:	RTN				; return

;****************
;*  TAB.POINTS  *
;****************
;Function:	Set horizontal position
;
;Inputs:	D6 - position in points

;*********************
;*  TAB.CENTIPOINTS  *
;*********************
;Function:	Set horizontal position
;
;Inputs:	D6 - position in centipoints

TAB.POINTS:
;[255]	AND	#177777,D6		; convert points
	MUL	D6,#100.		;   to centipoints
					; and fall through
TAB.CENTIPOINTS:
	SAVE	D0-D5			; save registers

;determine number of points right that we are going to be moving

	MOV	D6,D0			;   copy position -> D0		[255]
;[255]	MOVW	D6,D0			;   position -> D0

	SUB	H.LOC(A3),D0		; subtract previous position	[255]
	BMI	20$			; negative: do nothing
	BEQ	20$			; zero: do nothing
	ADD	D0,H.LOC(A3)		; update horizontal location	[255]

;[171]	MOV	#7200.,D3		; calculate
;[171]	CLR	D7			;   size of
;[171]	MOVB	PITCH(A3),D7		;   a space
;[171]	DIV	D3,D7			;   in
;[171]	AND	#177777,D3		;   centipoints -> D3
	CLR	D3			; 				[171]
	MOVW	CHRSIZ(A3),D3		; 				[171]

	MOVB	#40,D1			; load a space -> D1

;at this point: D0 - number of centipoints right to move
;		D3 - size of a space in centipoints
;		D1 - ASCII code for a space

10$:	CMP	D0,D3			; room for another space?	[255]
	BLO	15$			;   no - exit loop
	FILOTB	PTDDB(A3)		; output space
	INCW	OUTCOL(A3)		; update column
	SUB	D3,D0			; decrement remainder count	[255]
	BR	10$			; loop

15$:	ASR	D3			; divide size of a character in half [171]
	CMP	D0,D3			; more than half a char space left? [171][255]
	BLO	20$			;   no				[171]
	FILOTB	PTDDB(A3)		; output another space		[171]
	INCW	OUTCOL(A3)		; update ouput column count	[171]

20$:	REST	D0-D5			; restore registers
	RTN				; return

;************
;*  PDSLPP  *
;************
;Function:	Set lines per page
;
;Inputs:	D2 contains the form length in number of lines
;
;Notes:		this function currently unimplemented

PDSLPP:	RTN				; return

;************
;*  PDSLSP  *
;************
;Function:	Set line spacing
;
;Inputs:	D2 contains the number of 1/2 lines
;
;Notes:		this function currently unimplemented

PDSLSP:	RTN				; return

;************
;*  PDOVRP  *
;************
;Function:	Setup to overprint the last character

PDOVRP:	SAVE	D1			; save registers
	MOVB	#'H-'@,D1		; output a
	FILOTB	PTDDB(A3)		;   backspace
	DECW	OUTCOL(A3)		; back-up column
	REST	D1			; restore registers
	RTN				; return

;**********
;*  PDLF  *
;**********
;Function:	Output Line Feeds
;
;Inputs:	D2 - number of line feeds

PDLF:	SAVE	D1-D2			; save registers
	TST	D2			; zero?
	BEQ	20$			;   yes - do nothing
	BMI	20$			;   negative - do nothing
10$:	MOVB	#$CR,D1			; output
	FILOTB	PTDDB(A3)		;  carriage return
	MOVB	#$LF,D1			; output
	FILOTB	PTDDB(A3)		;   line feed
	ADDW2	V.SIZ(A3),V.LOC(A3)	; add size of a line		
	SOB	D2,10$			; loop
20$:	CLR	H.LOC(A3)		; reset				[255]
	MOVW	#1,OUTCOL(A3)		;   column
	REST	D1-D2			; restore registers
	RTN				; return

;************
;*  PDFONT  *
;************
;Function:	Set font
;
;Inputs:	D1 - font letter or digit

PDFONT:	MOVB	D1,CURFNT(A3)		; store font letter/digit
	ORW	#F$FNT,FLAGS(A3)	; flag for font select
	RTN				; return

;************
;*  PDFSIZ  *
;************
;Function:	Set font size
;
;Inputs:	D2 - font size in points

PDFSIZ:	ORW	#F$FNT,FLAGS(A3)	; set font selection flag
	CMPW	D2,#12.			; height of 12 points?
	BEQ	10$			;   yes - set pitch to 10
	CMPW	D2,#10.			; height of 10 points?
	BEQ	12$			;   yes - set pitch to 12
10$:	MOVB	#10.,PITCH(A3)		; set new pitch
	MOVW	#72./6,V.SIZ(A3)	; set line size in points	[103]
	MOVB	#6,SAVLPI(A3)		; set lines per inch		[103]
	RTN				; return
12$:	MOVB	#12.,PITCH(A3)		; set new pitch
	MOVW	#72./8.,V.SIZ(A3)	; set line size in points	[103]
	MOVB	#8.,SAVLPI(A3)		; 				[103]
	RTN				; return

;************
;*  PDPSIZ  *
;************
;Function:	Set Paper Size
;
;Inputs:	D2 - page size in points

PDPSIZ:	CMPW	D2,PAGSIZ(A3)		; save page size as last time?	
	BNE	10$			;   no				
	RTN				;   yes - do nothing and return	

10$:	MOVW	D2,PAGSIZ(A3)		; set new page size
	RTN				; return

;************
;*  PDTMAR  *
;************
;Function:	Set Top Margin from value in D2
;
;Inputs:	D2 contains the size of the top margin in points

PDTMAR:	MOVW	D2,TOPMGN(A3)		; set the top margin
	RTN				; return

;************
;*  PDLEFT  *
;************
;Function:	Set left paper offset
;
;Inputs:	D2 - left paper offset in points

PDLEFT:	MOV	D2,D6			; convert to
	MUL	D6,#100.		;   centipoints
	MOV	D6,LFTOFF(A3)		; set left paper offset		[255]
	RTN				; return

;************
;*  PDITAL  *
;************
;Toggle italic style

PDITAL:	XORW	#F$ITA,FLAGS(A3)	; flip italics flag
	BITW	#F$ITA,FLAGS(A3)	; italics on or off?
	BEQ	PDIOFF			;   off

PDION:	OUTSTR	$PDION			; turn on italics
	RTN				; 

PDIOFF:	OUTSTR	$PDIOF			; turn off italics
	RTN				; 

;************
;*  PDFATR  *
;************
;Function:	Set font attributes directly
;
;Inputs:	D2 - bit flags:
;
;			PA$BLD=1		bold
;			PA$UND=2		underscore
;			PA$ITA=4		italic
;			PA$SCR=10		screened
;			PA$REV=20		reverse
;			PA$DBL=40		double underscore
;			PA$BAR=100		overbar

PDFATR:

;bold handling

PDFBLD:	BITW	#PA$BLD,D2		; bold requested?
	BNE	PDFBON			;   yes

PDFBOF:	BITW	#F$BLD,FLAGS(A3)	; is bold already off?
	BEQ	PDFUND			;   yes
	OUTSTR	$PDBOF			;   no - turn it off
	BR	PDFUND			; 

PDFBON:	BITW	#F$BLD,FLAGS(A3)	; is bold already on?
	BNE	PDFUND			;   yes
	OUTSTR	$PDBON			;   no - turn it on

;underscore handling

PDFUND:	BITW	#PA$UND,D2		; underscore requested?
	BNE	PDFUON			;   yes

PDFUOF:	BITW	#F$UND,FLAGS(A3)	; is underscore already off?
	BEQ	PDFRTN			;   yes
	OUTSTR	$PDUOF			;   no - turn it off
	BR	PDFRTN			; 

PDFUON:	BITW	#F$UND,FLAGS(A3)	; is underscore already on?
	BNE	PDFRTN			;   yes
	OUTSTR	$PDUON			;   no - turn it on

PDFRTN:	RTN				; return

;************
;*  PDMCHR  *
;************
;Function:	Move to character position D2
;
;Inputs:	D2 - column number

PDMCHR:	MOV	D2,D6			; copy column
	DEC	D6			; subtract one
	BMI	10$			;   negative - do nothing
	BEQ	10$			;   zero - we are already there
	CLR	D7			; get size			[171]
	MOVW	CHRSIZ(A3),D7		;   of a character		[171]
	MUL	D6,D7			; D6 := column * char_size in cpts [171]
	ADD	LFTOFF(A3),D6		; add in left paper offset	[255]
	CALL	TAB.CENTIPOINTS		; move there
10$:	RTN				; return

;************
;*  PDMLIN  *
;************
;Function:	Move to line
;
;Inputs:	D2 - line to move to (AW 12-point lines)

PDMLIN:	SAVE	D2			; save registers
	PUSHW	V.LOC(A3)		; save vertical location
	CLR	D1			; set horizontal location to far left
	MUL	D2,#12.			; convert vertical to points
	BCALL	PDMOVE			; move to (0,D2)
	POPW	V.LOC(A3)		; restore vertical location
	REST	D2			; restore registers
	RTN				; return

;************
;*  PDMOVE  *
;************
;Function:	Move to location indicated by points coordinates (D1, D2)

PDMOVE:	SAVE	D0-D2			; save registers

	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	10$			;   no
	OUTSTR	$PDUOF			;   yes - turn off underscoring
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	20$			;   no
	OUTSTR	$PDBOF			;   yes - turn off bolding
20$:

;set vertical location to match D2 (points)

PDM.V:	SAVE	D1			; 
10$:	CMMW	V.LOC(A3),D2		; are we at or past right spot?
	BHIS	20$			;   yes

	MOVW	V.LOC(A3),D7		; 
	ADDW	V.SIZ(A3),D7		; 
	CMPW	D7,D2			; 
	BHI	20$			; 

	MOVB	#$CR,D1			; output
	FILOTB	PTDDB(A3)		;   carriage return
	MOVB	#$LF,D1			; output
	FILOTB	PTDDB(A3)		;   line feed
	ADDW2	V.SIZ(A3),V.LOC(A3)	; update current location
	CLR	H.LOC(A3)		; 				[255]
	MOVW	#1,OUTCOL(A3)		; reset column
	BR	10$			; loop
20$:	REST	D1			; 

;set horizontal location to match D1 (points)

PDM.H:	CLR	D6			; 				[255]
	MOVW	D1,D6			; 
	CALL	TAB.POINTS		; 

PDMRTN:	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	10$			;   no
	OUTSTR	$PDUON			;   yes - turn it back on
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	20$			;   no
	OUTSTR	$PDBON			;   yes - turn it back on
20$:	REST	D0-D2			; restore registers
	MOVW	D2,V.LOC(A3)		; agree with calling application
	RTN				; return

;************
;*  PDFTBL  *
;************
;Function:	Return index to font table
;
;Outputs:	A6 - address of font table

PDFTBL:	LEA	A6,FONT.TABLE		; point A6 to font table
	RTN				; return

;************
;*  PDFSUB  *
;************
;Function:	Perform font substitution
;
;Inputs:	D1 - font letter
;
;Outputs:	D1 - substituted font letter (may or may not have changed)

PDFSUB:	LEA	A6,$FSUB		; index substitution table
10$:	MOVB	(A6)+,D6		; get from-char
	BEQ	20$			;   end of table
	MOVB	(A6)+,D7		; get to-char
	CMPB	D6,D1			; is this the font specified?
	BNE	10$			;   no - loop back
	MOVB	D7,D1			;   yes - make replacement
20$:	RTN				; return

DEFINE	DEFSUB
	IF	NDF,$FSUB
$FSUB:	BYTE	0,0			; ** end of table **
	EVEN
	ENDC
	ENDM

;************
;*  PDOTSC  *
;************
;Function:	Output special character
;
;Inputs:	D1 - special character code (C$xxx)

PDOTSC:	SAVE	D1			; save registers
	LEA	A6,$SPCHR		; index special character table
10$:	MOVB	(A6)+,D6		; get spec. char. code
	BEQ	20$			;   end of table
	MOVB	(A6)+,D7		; get replacement code
	CMPB	D6,D1			; match?
	BNE	10$			;   no - loop back
	MOVB	D7,D1			;   yes - make replacement
20$:	CALL	PDCHR			; output character
	REST	D1			; restore registers
	RTN				; return

;text sequence macro

DEFINE	STR	TEXT,SIZE
1$$:	ASCIZ	/TEXT/
	BLKB	SIZE-<.-1$$>
	ENDM

;***********
;*  PDPCH  *
;***********
;Return index to printer characeristics block in A6

PDPCH:	LEA	A6,PCH			; 
	RTN

PCH:	STR	<Unknown>,20.		; PC.MAK make
	STR	<Unknown>,20.		; PC.MOD model
	STR	<Unknown>,20.		; PC.LNG page description language
	WORD	0,0,0,0,0,0,0,0		; PC.EXT graphics file  extensions
	BLKB	PC.SIZ-<.-PCH>		; reserved

;****************					internal routine
;*  OUT.STRING  *
;****************
;Function:	output ASCIZ string to list file
;
;Inputs:	A6 - address of null-terminated string

OUT.STRING:
	SAVE	A0,D1			; save registers
	MOV	A6,A0			; move index to A0
10$:	MOVB	(A0)+,D1		; get byte
	BEQ	20$			;   go handle byte of zero
15$:	FILOTB	PTDDB(A3)		; output byte
	INCW	OUTCOL(A3)		; update column
	BR	10$			; loop
20$:	REST	A0,D1			; restore registers
	RTN				; return

;*****************					internal routine
;*  SELECT.FONT  *
;*****************
;Function:	If flagged, perform a font selection

SELECT.FONT:
	BITW	#F$FNT,FLAGS(A3)	; is a font selection required?
	BEQ	90$			;   no
	SAVE	D1			; save D1
	MOVB	CURFNT(A3),D1		; get last font requested
	BCALL	SELFNT			; and go select it
	ANDW	#^C<F$FNT>,FLAGS(A3)	; turn off font selection flag
	REST	D1			; restore D1
90$:	RTN				; return

SELFNT:	SAVE	A6,D7			; save registers
	MOVB	D1,CURFNT(A3)		; save font letter/digit
	BITW	#F$BLD,FLAGS(A3)	; bold enabled?
	BNE	SELECT.BOLD		;   yes
	BITW	#F$ITA,FLAGS(A3)	; italic enabled?
	BNE	SELECT.ITALIC		;   yes

;search font table for a matching plain font

SELECT.PLAIN:
	LEA	A6,FONT.TABLE		; 
10$:	TSTB	@A6			; 
	JEQ	NOT.FOUND		; 
	CMPB	D1,FO.LOG(A6)		; 
	BNE	20$			; 
	BIT	#FO$BLD,FO.FLG(A6)	; 
	BNE	20$			; 
	BIT	#FO$OBL,FO.FLG(A6)	; 
	JEQ	SELECT			; 
20$:	ADD	#FO.ESZ,A6		; 
	BR	10$			; 

;search font table for a matching bold font

SELECT.BOLD:
	BITW	#F$ITA,FLAGS(A3)	; bold and italic selected?
	BNE	SELECT.BOLDITALIC	;   yes
	LEA	A6,FONT.TABLE		; 
10$:	TSTB	@A6			; 
	JEQ	NOT.FOUND		; 
	CMPB	D1,FO.LOG(A6)		; 
	BNE	20$			; 
	BIT	#FO$BLD,FO.FLG(A6)	; 
	BEQ	20$			; 
	BIT	#FO$OBL,FO.FLG(A6)	; 
	JEQ	SELECT			; 
20$:	ADD	#FO.ESZ,A6		; 
	BR	10$			; 

;search font table for a matching italic font

SELECT.ITALIC:
	LEA	A6,FONT.TABLE		; 
10$:	TSTB	@A6			; 
	JEQ	NOT.FOUND		; 
	CMPB	D1,FO.LOG(A6)		; 
	BNE	20$			; 
	BIT	#FO$BLD,FO.FLG(A6)	; 
	BNE	20$			; 
	BIT	#FO$OBL,FO.FLG(A6)	; 
	JNE	SELECT			; 
20$:	ADD	#FO.ESZ,A6		; 
	BR	10$			; 

;search font table for a matching bold-italic font

SELECT.BOLDITALIC:
	LEA	A6,FONT.TABLE		; 
10$:	TSTB	@A6			; 
	JEQ	NOT.FOUND		; 
	CMPB	D1,FO.LOG(A6)		; 
	BNE	20$			; 
	BIT	#FO$BLD,FO.FLG(A6)	; 
	BEQ	20$			; 
	BIT	#FO$OBL,FO.FLG(A6)	; 
	JNE	SELECT			; 
20$:	ADD	#FO.ESZ,A6		; 
	BR	10$			; 

;can't find the font we want - go with first font in table

NOT.FOUND:
	LEA	A6,FONT.TABLE		; point to first entry in font table
					;   and fall through
;select font whose entry is pointed to by A6

SELECT:	OUTFNT	FO.PHY(A6)		; output font select sequence
	ANDW	#^C<F$FNT>,FLAGS(A3)	; turn off font selection flag
	REST	A6,D7			; restore registers
	RTN				; return

;**************						internal routine
;*  OUT.FONT  *
;**************
;Function:	output ASCIZ string to list file to select font
;
;Inputs:	A6 - address of null-terminated string

OUT.FONT:
	SAVE	A0,D1			; save registers
	MOV	A6,A0			; move index to A0
10$:	MOVB	(A0)+,D1		; get byte
	BEQ	20$			; end of string
	FILOTB	PTDDB(A3)		; output byte
	BR	10$			; loop
20$:	REST	A0,D1			; restore registers
	RTN				; return

;****************
;*  FONT.TABLE  *
;****************
;Font definition table

;start-font macro

DEFINE	FONT	NAME,CART
	$FNT=.
1$$:	ASCIZ	"NAME"
	BLKB	30.-<.-1$$>
2$$:	ASCIZ	"CART"
	BLKB	10.-<.-2$$>
	ENDM

;escape sequence macro

DEFINE	FSEL	STR1,FN,STR2,STR3,STR4
	IF	NB,STR1
		BYTE	$ESC
		ASCII	"STR1"
		BYTE	FN
		ENDC
	IF	NB,STR2
		BYTE	$ESC
		ASCII	"STR2"
		ENDC
	IF	NB,STR3
		BYTE	$ESC
		ASCII	"STR3"
		ENDC
	IF	NB,STR4
		BYTE	$ESC
		ASCII	"STR4"
		ENDC
	BLKB	80.-<.-$FNT>
	ENDM

;end-font macro

DEFINE	ENDF
	IF	NE,.-$FNT-FO.ESZ,ASMERP "?Error in font definition"
	ENDM

DEFINE	DEFTBL

	IF	NDF,FONT.TABLE

	EVEN

FONT.TABLE:

;******************
;*  DEFAULT FONT  *
;******************
;Font C = Courier 10; use pitch and leading from document header/margins

	FONT	C			; FO.LOG
	FSEL				; FO.PHY
	LWORD	FO$POR!FO$RES		; FO.FLG portrait, resident
	RAD50	/      /		; FO.TBL
	WORD	10.			; FO.SIZ
	WORD	-1			; FO.LED use lpi setting
	WORD	-1			; FO.CPI use cpi setting
	ENDF

	FONT	C			; FO.LOG
	FSEL				; FO.PHY
	LWORD	FO$POR!FO$RES!FO$BLD	; FO.FLG portrait, resident, bold
	RAD50	/      /		; FO.TBL
	WORD	10.			; FO.SIZ
	WORD	-1			; FO.LED use lpi setting
	WORD	-1			; FO.CPI use cpi setting
	ENDF

	WORD	0			; ** end of table **

	ENDC
	ENDM



.