;*************************** AMUS Program Label ******************************
; Filename: BBS.M68 -> BBS.PDV                              Date: 06/11/92
; Category: AWRITE       Hash Code: 331-720-115-564      Version: 2.1A(170)
; Initials: ULTR/US      Name: DAVID PALLMANN
; Company: ULTRASOFT CORPORATION                   Telephone #: 5163484848
; Related Files: BBS.WRT (prototype AlphaWRITE document for use w/this driver)
; Min. Op. Sys.: AMOSL 1.3B/AMOS32 1.0         Expertise Level: INT
; Special: Works best with AlphaWRITE 2.1A or later.
; Description: For AlphaWRITE users who want to prepare uploadable BBS messages
;*****************************************************************************

;***************************************************************************
;*									   *
;*				     BBS				   *
;*			Bulletin Board Printer Driver			   *
;*		     (generates text without form feeds)		   *
;*									   *
;***************************************************************************
;[170] 12 June 1992 12:53	Edited by David Pallmann
;	Created from MISC.M68 for Jeff Kreider.

	OBJNAM	.PDV

	VMAJOR	=2
	VMINOR	=1
	VSUB	=1
	VEDIT	=170.
	VWHO	=0
	VWHO	=0.

;****************
;*  universals  *
;****************

	SEARCH	SYS
	SEARCH	SYSSYM
	COPY	PDVSYM

;**********************
;*  assembly options  *
;**********************
;
;	UNDTYP controls how underlining is performed.  A setting of zero
;	returns the carriage to the far left and types underscores.  A
;	setting of 1 outputs a backspace-and-underscore after each
;	character.
;
;	In the same fashion, BLDTYP controls how bolding is performed.

	UNDTYP	=0			; 0=CR method, 1=BS method
	BLDTYP	=0			; 0=CR method, 1=BS method

;***************************************
;*  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
	.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,	2		; left paper offset (centipoints)
	.OFDEF	H.LOC,	2		; horizontal location in centipoints
	.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	FLTBUF,	6		; floating pt. work buffer	
	.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

;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

;test flag bit in a word

DEFINE	BITW	SRC,DST
	MOVW	DST,D7
	ANDW	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
					; == 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	PDUNDR			; 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	IGNORE			; PDSCRN, toggle screened
	JMP	IGNORE			; 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	PRTINI			; 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
	CLRW	H.LOC(A3)		; set starting point
	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
	RTN				; return

;printer initialization

PRTINI:	BYTE	0			; ** end of printer initialization **
	EVEN

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

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

;printer shut-down

PRTCLS:	BYTE	0			; ** end of printer shut-down **
	EVEN

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

PDCHR:	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
	BCALL	PROCESS			; process bold/underscore for char
	ADDW2	CHRSIZ(A3),H.LOC(A3)	; 				
10$:	RTN				; 

;*************
;*  PROCESS  *
;*************
;Function:	Process character, handle bolding and underscoring if enabled
;		Called right after a character has been output
;
;Inputs:	D1 - character just output

PROCESS:
	BITW	#F$BLD,FLAGS(A3)	; bolding?
	BEQ	20$			;   no

;handling for bold (CR and BS style)

	IF	EQ,BLDTYP
	SAVE	A6,D1			; CR: save registers
	MOV	BLDIDX(A3),A6		; CR: index bold buffer
	MOVB	D1,(A6)+		; CR: store byte
	INC	BLDIDX(A3)		; CR: update index
	INCW	BLDSIZ(A3)		; CR: update size
	CMPW	BLDSIZ(A3),#BLDMAX-2	; CR: overflow?
	BLO	10$			; CR:   no
	CALL	BLDOFF			; CR: turn off bold
	CALL	BLDON			; CR: turn it back on
10$:	REST	A6,D1			; CR: restore registers
	IFF
	PUSHW	D1			; BS: save character
	MOVB	#'H-'@,D1		; BS: output
	FILOTB	PTDDB(A3)		; BS:   backspace
	POPW	D1			; BS: restore character
	FILOTB	PTDDB(A3)		; BS: output character again
	ENDC

20$:

;handling for underscore BS style

	IF	NE,UNDTYP
	BITW	#F$UND,FLAGS(A3)	; BS: underscore enabled?
	BEQ	30$			; BS:   no
	PUSHW	D1			; BS: save character
	MOVB	#'H-'@,D1		; BS: output
	FILOTB	PTDDB(A3)		; BS:   backspace
	MOVB	#'_,D1			; BS: output
	FILOTB	PTDDB(A3)		; BS:   underscore
	POPW	D1			; BS: restore character
30$:
	ENDC

	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	MOVAHT			; 01 move to absolute horizontal tab
	STRING	ROLUP			; 02 roll up a partial line
	STRING	ROLDWN			; 03 roll down a partial line
	STRING	NEGLF			; 04 output negative line feed
	STRING	SPLPT0			; 05 special print position 0
	STRING	SPLPT1			; 06 special print position 1
	STRING	RIBSC1			; 07 print in Secondary ribbon color 1
	STRING	RIBSC2			; 08 print in Secondary ribbon color 2
	STRING	RIBSC3			; 09 print in Secondary ribbon color 3
	STRING	RIBPRM			; 10 print in Primary ribbon color
	STRING	FEDTR1			; 11 select Feeder tray 1
	STRING	FEDTR2			; 12 select Feeder tray 2
	STRING	FEDTR3			; 13 select Feeder tray 3
	STRING	FEDTR4			; 14 select Feeder tray 4
	STRING	FEDTGL			; 15 select Feeder tray 1 & then tray 2
	STRING	FEDEJT			; 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	RIBSC4			; 21 print in Secondary ribbon color 4
	STRING	RIBSC5			; 22 print in Secondary ribbon color 5
	STRING	RIBSC6			; 23 print in Secondary ribbon color 6
	STRING	RIBSC7			; 24 print in Secondary ribbon color 7
TBLEND:					; end of table
	MAXCDE=<<TBLEND-CTLTBL>/2.>	; maximum special code

;***********************
;*  Carriage Movement  *
;***********************

;Move to Absolute Horizontal Tab

MOVAHT:	BYTE	0			; 

;Return carriage home

CHOME:	BYTE	$CR,0			; 

;********************
;*  Paper Movement  *
;********************

;Roll up a partial line (positive)

ROLUP:	BYTE	0			; 

;Roll down a partial line (negative)

ROLDWN:	BYTE	0			; 

;Output a negative line feed

NEGLF:	BYTE	0			; 

;****************************
;*  Miscellaneous Commands  *
;****************************

;Print in Secondary ribbon color 1 (blue)

RIBSC1:	BYTE	0			; 

;Print in Secondary ribbon color 2 (red)

RIBSC2:	BYTE	0			; 

;Print in Secondary ribbon color 3 (yellow)

RIBSC3:	BYTE	0			; 

;Print in Primary ribbon color (black)

RIBPRM:	BYTE	0			; 

;Print in Secondary ribbon color 3 (orange)

RIBSC4:	BYTE	0			; 

;Print in Secondary ribbon color 3 (violet)

RIBSC5:	BYTE	0			; 

;Print in Secondary ribbon color 3 (green)

RIBSC6:	BYTE	0			; 

;Print in Secondary ribbon color 7 (brown)

RIBSC7:	BYTE	0			; 

;Output character at special print position 0

SPLPT0:	BYTE	0			; 

;Output character at special print position 1

SPLPT1:	BYTE	0			; 

;**********************
;*  Cut Sheet Feeder  *
;**********************

;Select feeder tray 1

FEDTR1:	BYTE	0			; 

;Select feeder tray 2

FEDTR2:	BYTE	0			; 

;Select feeder tray 3

FEDTR3:	BYTE	0			; 

;Select feeder tray 4

FEDTR4:	BYTE	0			; 

;Select feeder tray 1 & then tray 2 thereafter

FEDTGL:	BYTE	0			; 

;Select feeder eject

FEDEJT:	BYTE	0			; 

;****************************
;*  Special User Functions  *
;****************************

;Output user function 1 

USR1:	BYTE	0			; 

;Output user function 2 

USR2:	BYTE	0			; 

;Output user function 3 

USR3:	BYTE	0			; 

;Output user function 4 

USR4:	BYTE	0			; 
	EVEN				; module must end on word boundary

;************
;*  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
	CALL	UNDOFF			;   yes - turn off underscoring
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	15$			;   no
	CALL	BLDOFF			;   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
	CALL	UNDON			;   yes - turn it back on
25$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	30$			;   no
	CALL	BLDON			;   yes - turn it back on
30$:	CLRW	H.LOC(A3)		; 				
	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
	MOVW	#1,OUTCOL(A3)		; reset column
	CLRW	H.LOC(A3)		; clear horizontal position
	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

	IF	NE,UNDTYP
UNDOFF:					; BS: 
	IFF
	BITW	#F$UND,FLAGS(A3)	; CR: did we turn it on or off?
	BNE	UNDON			; CR:   on
					; CR:
UNDOFF:	SAVE	D0-D1			; CR: save registers
	MOVW	OUTCOL(A3),UNDEND(A3)	; CR: store end column
	CMMW	UNDSTA(A3),UNDEND(A3)	; CR: anything to underscore?
	BEQ	40$			; CR:  no
	MOVB	#$CR,D1			; CR: go back to
	FILOTB	PTDDB(A3)		; CR:   start of line
	CLR	D0			; CR: get
	MOVW	UNDSTA(A3),D0		; CR:   starting column
	DECW	D0			; CR: subtract one
	BEQ	20$			; CR:   at start of line
	MOVB	#40,D1			; CR: load a space
10$:	FILOTB	PTDDB(A3)		; CR: output a space
	SOB	D0,10$			; CR: loop
20$:	MOVB	#'_,D1			; CR: load an underscore
30$:	CMMW	UNDSTA(A3),UNDEND(A3)	; CR: done?
	BHIS	40$			; CR:   yes
	FILOTB	PTDDB(A3)		; CR: output an underscore
	INCW	UNDSTA(A3)		; CR: update column
	BR	30$			; CR: loop
40$:	REST	D0-D1			; CR: restore registers
	ENDC

	RTN				; return

UNDON:	MOVW	OUTCOL(A3),UNDSTA(A3)	; remember underscore starting column
	RTN				; 

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

PDBOLD:	XORW	#F$BLD,FLAGS(A3)	; flip bold flag

	IF	NE,BLDTYP
BLDOFF:					; BS: 
	IFF
	BITW	#F$BLD,FLAGS(A3)	; CR: did we turn it on or off?
	BNE	BLDON			; CR:   on
					; CR:
BLDOFF:	SAVE	A0,D0-D1		; CR: save registers
	MOV	BLDIDX(A3),A6		; CR: mark end
	CLRB	@A6			; CR:   of bold buffer
	MOVW	OUTCOL(A3),BLDEND(A3)	; CR: store end column
	TSTW	BLDSIZ(A3)		; CR: anything to bold?
	BEQ	40$			; CR:   no
	MOVB	#$CR,D1			; CR: go back to
	FILOTB	PTDDB(A3)		; CR:   start of line
	CLR	D0			; CR: get
	MOVW	BLDSTA(A3),D0		; CR:   starting column
	DECW	D0			; CR: subtract one
	BEQ	20$			; CR:   at start of line
	MOVB	#40,D1			; CR: load a space
10$:	FILOTB	PTDDB(A3)		; CR: output a space
	SOB	D0,10$			; CR: loop
20$:	LEA	A0,BLDTXT(A3)		; CR: index bold buffer
30$:	CMMW	BLDSTA(A3),BLDEND(A3)	; CR: done?
	BHIS	40$			; CR:   yes
	MOVB	(A0)+,D1		; CR: get character
	FILOTB	PTDDB(A3)		; CR:   and output it
	INCW	BLDSTA(A3)		; CR: update column
	BR	30$			; CR: loop
40$:	REST	A0,D0-D1		; CR: restore registers
	ENDC
	RTN				; return

BLDON:	MOVW	OUTCOL(A3),BLDSTA(A3)	; remember bold starting column
	LEA	A6,BLDTXT(A3)		; 
	MOV	A6,BLDIDX(A3)		; 
	CLRW	BLDSIZ(A3)		; 
	RTN				; 

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

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

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

20$:	RTN				; return

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

PDSLPI:	CMP	D2,#6			; valid lines per inch setting?
	BEQ	10$			;   yes
	CMP	D2,#8.			; valid lines per inch setting?
	BNE	20$			;   no

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

20$:	RTN				; return

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

PDMTM:	MOVW	TOPMGN(A3),V.LOC(A3)	; pretend we're there already
	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
	MOVW	D2,LFTOFF(A3)		; save left paper offset
	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
	CALL	UNDOFF			;   yes - turn it off
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	15$			;   no
	CALL	BLDOFF			;   yes - turn it off
15$:	MOVW	LFTOFF(A3),D6		; convert lpo
	CALL	TAB.CENTIPOINTS		; move there
	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	20$			;   no
	CALL	UNDON			;   yes - turn it back on
20$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	30$			;   no
	CALL	BLDON			;   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:
	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

	CLR	D0			; copy
	MOVW	D6,D0			;   position -> D0
	SUBW	H.LOC(A3),D0		; subtract previous position
	BMI	20$			; negative: do nothing
	BEQ	20$			; zero: do nothing
	ADDW	D0,H.LOC(A3)		; update horizontal location

	CLR	D3			; 				
	MOVW	CHRSIZ(A3),D3		; 				

	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$:	CMPW	D0,D3			; room for another space?
	BLO	15$			;   no - exit loop
	FILOTB	PTDDB(A3)		; output space
	INCW	OUTCOL(A3)		; update column
	CALL	PROCESS			; handle bold/underscore
	SUBW	D3,D0			; decrement remainder count
	BR	10$			; loop

15$:	ASR	D3			; divide size of a character in half
	CMPW	D0,D3			; more than half a char space left?
	BLO	20$			;   no				
	FILOTB	PTDDB(A3)		; output another space		
	INCW	OUTCOL(A3)		; update ouput column count	
	CALL	PROCESS			; handle bold/underscore	

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$:	CLRW	H.LOC(A3)		; reset
	MOVW	#1,OUTCOL(A3)		;   column
	REST	D1-D2			; restore registers
	RTN				; return

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

PDFONT:	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
	MOVW	D6,LFTOFF(A3)		; set left paper offset
	RTN				; return

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

PDFSIZ:	RTN				; return

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

PDITAL:	RTN				; return

;************
;*  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
	CALL	BLDOFF			;   no - turn it off
	BR	PDFUND			; 

PDFBON:	BITW	#F$BLD,FLAGS(A3)	; is bold already on?
	BNE	PDFUND			;   yes
	CALL	BLDON			;   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
	CALL	UNDOFF			;   no - turn it off
	BR	PDFRTN			; 

PDFUON:	BITW	#F$UND,FLAGS(A3)	; is underscore already on?
	BNE	PDFRTN			;   yes
	CALL	UNDON			;   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			
	MOVW	CHRSIZ(A3),D7		;   of a character		
	MUL	D6,D7			; D6 := column * char_size in cpts

	ADDW	LFTOFF(A3),D6		; add in left paper offset
	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
	CALL	UNDOFF			;   yes - turn off underscoring
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	20$			;   no
	CALL	BLDOFF			;   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
	CLRW	H.LOC(A3)		; 
	MOVW	#1,OUTCOL(A3)		; reset column
	BR	10$			; loop
20$:	REST	D1			; 

;set horizontal location to match D1 (points)

PDM.H:	MOVW	D1,D6			; 
	CALL	TAB.POINTS		; 

PDMRTN:	BITW	#F$UND,FLAGS(A3)	; are we underscoring?
	BEQ	10$			;   no
	CALL	UNDON			;   yes - turn it back on
10$:	BITW	#F$BLD,FLAGS(A3)	; are we bolding?
	BEQ	20$			;   no
	CALL	BLDON			;   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:	MOVB	#'C,D1			; everything goes to Courier
	RTN				; return

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

PDOTSC:	SAVE	D1			; save registers
	LEA	A6,SPCTBL		; 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

SPCTBL:	BYTE	C$NXB,32.		; non-exandable space
	BYTE	C$DEG,'o		; degree symbol
	BYTE	C$PAR,'P		; paragraph symbol
	BYTE	C$DAG,'t		; dagger
	BYTE	C$SEC,'s		; section symbol
	BYTE	C$CNT,'c		; cent sign
	BYTE	C$QTR,'q		; 1/4
	BYTE	C$HAF,'h		; 1/2
	BYTE	C$TM ,'t		; trademark symbol
	BYTE	C$CPY,'c		; copyright symbol
	BYTE	C$REG,'r		; registered symbol
	BYTE	C$STR,'*		; star
	BYTE	C$BLT,'o		; bullet
	BYTE	C$EMD,'-		; em dash
	BYTE	C$END,'-		; en dash
	BYTE	C$RTN,'<		; RETURN keycap
	BYTE	0			; ** end of table **
	EVEN

;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
	CALL	PROCESS			; handle bold/underscore
	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

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 **

	END

.