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

;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