; Filename: BBS.M68 -> BBS.PDV Date: 06/11/92

;*************************** 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 us
er 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