.proc zzzzz2
; DUMMY PROCEDURE
;
 .REF SAVCRD,READY,C3COPY
 .DEF YTOP,CYDEC,CHECKX,XPAGE
INTERL .EQU 5
YTOP: JSR READY ; WAIT FOR VGP
 JSR SAVCRD ; SAVE POSITION
; SET Y POSITION TO TOP OF SCREEN
 LDA C3COPY ; GET INTERLACED STATUS
 ROR A ; WHICH IS IN BIT 1 OF C3COPY
 EOR #1
 AND #1 ; NZ IF INTERLACED
 STA INTERL
 LDA C3COPY
 AND #3 ; MASK OFF INTERLACED,UK/US MODE BITS
 ASL A
 TAY
 LDA YUPTOP,Y
 STA YLSB
 INY
 LDA YUPTOP,Y
 STA YMSB
 LDA C3COPY ; GET PAGE TO BE OPERATED UPON (I.E. THE DISPLAYED PAGE)
 AND #20 ; BIT 5 OF C3COPY
 BEQ PAGE0
 LDA #2
PAGE0: STA XPAGE
 RTS
;
XPAGE .BYTE 0 ; STORES THE MS BIT OF VGP X REG
;
YUPTOP: .WORD 416. ; US INTERLACED
 .WORD 512. ; UK INTERLACED
 .WORD 208. ; US NON-INTERLACED
 .WORD 256. ; UK NON-INTERLACED
;
CYDEC: LDA YLSB ; DECREMENT Y POSITION
 BNE DYL
 DEC YMSB
DYL: DEC YLSB
 RTS
;
CHECKX: LDA XMSB
 EOR XPAGE
 AND #2 ; OFF RHS OF SCREEN ?
 BEQ NODEC
 JSR CYDEC ; IF SO, DECREMENT Y POSITION &
 LDA #0 ; RESET X POSITION
 STA XLSB
 LDA XPAGE
 STA XMSB
 LDA YMSB
 AND #8
NODEC: RTS
;
; DUMP TO PRINTER ROUTINE
 .proc dump,3
; dump (printer_type,interface_type,interface_slot :integer)
; printer_type 0:mx80, 1:mx82, 2:fx80
; interface_type 0:grappler, 1:grappler+, 2:epson
; interface_slot 1 through 5
;
PTYPE .EQU 2
ITYPE .EQU 3
ISLOT .EQU 4
INTERL .EQU 5
IBASE .EQU 6
IBASE1 .EQU 8
YTEMP .EQU 10.
DOTS .EQU 12.
 .REF RESCRD,GSETUP,GETCOL,YTOP,CYDEC,COLOR,XPAGE
 pop RETURN
 PLA ; GET SLOT
 STA ISLOT
 PLA
 PLA ; GET INTERFACE TYPE
 STA ITYPE
 PLA
 PLA ; GET PRINTER TYPE
 STA PTYPE
 PLA
 push RETURN
;
; CHECK SLOT NO. AND SET UP BASE POINTERS
;
 LDA ISLOT ; MUST NOT EQUAL 0.
 BEQ BAD
 CMP #SLOT ; MUST NOT EQUAL VGP SLOT NO.
 BEQ BAD
 CMP #6 ; MUST BE LESS THAN 6
 BCC GOOD
BAD: RTS
GOOD: ORA #0C0
 STA IBASE1+1
 ASL A
 ASL A
 ASL A
 ASL A ; MULTIPLY SLOT * 16
 ORA #80
 STA IBASE
 LDA #0C0
 STA IBASE+1
 LDA #0
 STA IBASE1
;
 JSR YTOP ; SAVE POSITION & SET Y TO TOP OF SCREEN
;
; SET UP PRINTER
;
 LDx #8 ; set lf space to 8/72"
 JSR Lfsize
OUTCR0: LDA #0D ; SEND RETURN TO START OFF OK
 JSR LPRINT
;
; END OF SET UP , MAIN DUMP LOOP
;
DUMPLP: LDA #1B ; SET PRINTER TO ACCEPT GRAPHICS LINE
 JSR LPRINT
 lda #4B ; 'K
 LDY PTYPE
 beq gmx80
 cpy #5
 beq gfx80
 DEY
 DEY
 bne gmx82
GMX80: JSR LPRINT ; MX80: ESCAPE K $E0 $01
 LDA #0E0
 JSR LPRINT
 LDA #1
 BPL GLAST
GFX80: LDA #2A ; FX80: ESCAPE * $05 $00 $02
 JSR LPRINT
 LDA #5
GMX82: JSR LPRINT ; MX82: ESCAPE K $00 $02
 LDA #0
 JSR LPRINT
 LDA #2
GLAST: JSR LPRINT
;
; OK NOW SET THE VGP
;
 LDA YLSB
 STA YTEMP
 LDA YMSB
 STA YTEMP+1 ; SAVE Y POSITION
 LDA #0 ; RESET X POSITION
 STA XLSB
 LDA XPAGE
 STA XMSB
;
; NOW OUTPUT A HORIZONTAL LINE (8 NEEDLES HIGH)
;
LINELP: LDA YTEMP+1 ; RESTORE Y POSITION
 STA YMSB
 LDA YTEMP
 STA YLSB
 LDX #8 ; GET 8 DOTS
GETDOT: JSR CYDEC ; DECREMENT Y POSITION
 JSR GSETUP
 JSR GETCOL ; GET THE SCREEN COLOUR
 BIT COLOR ; MONOCHROME OR COLOUR ?
 BMI ISCOL
 ORA #6
ISCOL: CMP #7 ; 7 IS BLACK
 BEQ COLOFF
 SEC
 ROL DOTS
 SEC
 BCS COLEX
COLOFF: ASL DOTS
 CLC
COLEX: LDA INTERL ; INTERLACED
 BNE COLINT
 ROL DOTS
 DEX
COLINT: DEX
 BNE GETDOT
;
 LDA DOTS
 JSR LPRINT ; PRINT THE PATTERN IN DOTS
;
 INC XLSB ; INCREMENT X POSITION AND TEST FOR END OF LINE
 BNE NIXM
 INC XMSB
NIXM: LDA PTYPE
 beq emx80
 cmp #2 ; rx80 ?
 BNE NMX80
emx80: LDA XMSB ; IF MX80 THEN END IS @ $1E0
 AND #1
 BEQ LINELP
 LDA XLSB
 CMP #0E0
 BNE LINELP
 BEQ XLINE
NMX80: LDA XMSB ; ELSE, END IS @ $200
 EOR XPAGE
 AND #2
 BEQ LINELP
;
XLINE: LDA #0A ; OUTPUT LF TO PRINTER
 JSR LPRINT
 LDA YLSB
 ORA YMSB ; IS Y POSITION 0 ?
 BEQ DEXIT
 JMP DUMPLP
;
DEXIT: JSR RESCRD ; IF SO, THATS IT
 LDx #0C ; RESET LINE SPACE TO 12/72"
;
lfsize: lda #1B ; set lf size to n/72"
 JSR LPRINT
 LDA #41
 JSR LPRINT
 txa
 jsr lprint
 lda ptype ; if mx series then
 cmp #2
 bcs xdump
 lda #1B ; output esc '3 to fix lf size
 jsr lprint
 lda #33
;
; LPRINT - PRINT ROUTINE
;
LPRINT: PHA ; SAVE CHAR TO BE OUTPUT
 LDY ITYPE
 BEQ LGRAPP
 DEY
 BEQ LGPLUS
EPSON: LDY #1
EPLP: LDA @IBASE1,Y
 BMI EPLP ; WAIT FOR PRINTER NOT BUSY
 PLA
 DEY
 STA @IBASE,Y ; THEN SEND CHAR
 RTS
LGPLUS: INY
LGPLP: LDA @IBASE,Y
 EOR #2
 AND #0E
 BNE LGPLP ; WAIT FOR NOT BUSY
 LDY #20
WGP: DEY
 BNE WGP ; WAIT A BIT MORE (FOR ACK TIME)
 INY
 PLA
 STA @IBASE,Y ; OUTPUT CHARACTER
 INY
 STA @IBASE,Y ; STROBE ON
 LDY #4
 STA @IBASE,Y ; STROBE OFF
xdump: RTS
LGRAPP: INY
LGRLP: LDA @IBASE,Y
 EOR #3
 AND #7
 BNE LGRLP ; WAIT FOR NOT BUSY
 LDY #20
WRP: DEY
 BNE WRP ; WAIT SOME MORE
 INY
 PLA
 STA @IBASE,Y ; OUTPUT CHARACTER
 RTS
;
; RUN LENGTH ENCODE / DECODE ROUTINES
; TO SUPPORT DISK SAVE / LOAD PROGRAMS
;
; INITIALISE POSITION AND VARIABLES FOR CODE ROUTINES
 .proc code_init
;
 .DEF DCOUNT,DOTS,CODEND
 .REF YTOP,CYDEC,XPAGE
 JSR YTOP ; SET Y POSITION TO TOP OF SCREEN
 JSR CYDEC ; DECREMENT Y POSITION
 LDY #0
 STY XLSB
 LDA XPAGE
 STA XMSB ; RESET X POSITION
 STY DCOUNT
 STY CODEND
 DEY
 STY DOTS ; SET DOTS TO 0FF
 RTS
;
DCOUNT .BYTE 0
DOTS .BYTE 0
CODEND .BYTE 8
;
; ENCODE FUNCTION
 .func encode,1
; encode (var 512_byte_buffer)
;
BPTR .EQU 2 ; POINTER TO THE BUFFER
BCOUNT .EQU 4 ; BUFFER COUNT
SAVCOL .EQU 6 ; TEMP COLOUR SAVE
 .REF DCOUNT,DOTS,CODEND,RESCRD
 .REF GSETUP,GETCOL,READY,CYDEC,CHECKX,XPAGE
 pop RETURN
 PLA ; DESTACK 4 BYTES BECAUSE ITS A FUNCTION
 PLA
 PLA
 PLA
 pop BPTR ; GET BUFFER POINTER
 LDA #0
 STA BCOUNT
 STA BCOUNT+1 ; RESET BUFFER COUNT
;
ENCDLP: LDA DCOUNT ; BYTE LEFT OVER FROM LAST TIME ?
 BNE WRIT20 ; YES STORE IT
 LDA CODEND ; HAVE WE FINISHED ALREADY ?
 BNE NOTRES ; IF YES, FORGET IT
 JSR CHECKX ; OFF THE BOTTOM OF THE SCREEN ?
 BNE FINISH ; IF SO, QUIT
 JSR GSETUP
 JSR GETCOL ; GET COLOUR FROM THE SCREEN
 STA SAVCOL ; TEMP STORE
 LDA #0
 STA DOTS ; RESET DOTS COUNT
;
ENCLP1: INC DOTS ; INCREMENT COUNT OF SAME COLOUR POINTS
 BEQ ESTORE ; IF MAXIMUM NO. OF DOTS THE SAME, STORE
 INC XLSB ; INCREMENT X POSITION
 BNE NOXMSB
 INC XMSB
 LDA XMSB ; OFF RHS OF SCREEN ?
 EOR XPAGE
 AND #2
 BNE ESTORE ; IF SO STORE WHAT WE HAVE
NOXMSB: LDA XLSB
 AND #7
 TAY
 BNE NOSCAN ; IF COLOUR REGS STILL VALID
 LDA #0F ; ELSE INITIATE COLOUR SCAN
 STA CMD
 JSR READY
NOSCAN: JSR GETCOL ; GET NEXT POINT COLOUR
 CMP SAVCOL ; COMPARE WITH 1ST COLOUR
 BEQ ENCLP1 ; LOOP UNTIL DIFFERENT
;
ESTORE: LDA DOTS
 BEQ WRITFF
 CMP #4 ; IF LESS THAN 4, STORE AS SINGLE BYTE
 BCS WRIT17
 ROR A
 ROR A
 ROR A ; ROTATE TO 2 MS BITS
 AND #0C0
 ORA SAVCOL
 BNE WRTBYT ; AND STORE SINGLE BYTE
;
WRIT20: LDX #0 ; CLEAR DCOUNT
 STX DCOUNT
 BEQ WRTBYT ; AND STORE SECOND BYTE
;
WRITFF: LDA #0FF
WRIT17: STA DCOUNT
 LDA SAVCOL ; GET COLOUR
;
WRTBYT: LDY #0
 STA @BPTR,Y
 INC BPTR
 BNE ENNINC ; INCREMENT BUFFER POINTER
 INC BPTR+1
ENNINC: INC BCOUNT ; INCREMENT COUNT
 BNE ENCDLP
 INC BCOUNT+1
 LDA BCOUNT+1
 AND #2
 BEQ ENCDLP
 BNE NOTRES
;
FINISH: STA CODEND ; SET CODEND NZ TO MARK FINISH
 JSR RESCRD ; RESTORE VGP POSITION
NOTRES: push BCOUNT ; RETURN NO. OF BYTES IN BUFFER
 push RETURN
 RTS ; RETURN TO PASCAL
;
; DECODE ROUTINE
 .proc decode,1
; decode (var 512_byte_buffer)
;
BPTR .EQU 2
BCOUNT .EQU 4
 .REF DOTS,CODEND,RESCRD,READY,CYDEC,PUTCOL,CHECKX,XPAGE
 pop RETURN
 pop BPTR ; GET BUFFER POINTER
 push RETURN
 LDA CODEND
 BNE BYEBYE ; FORGET IT IF CODEND IS NZ
 LDA #0 ; RESET COUNT
 STA BCOUNT
 STA BCOUNT+1
DECDLP: LDY #0
 LDA @BPTR,Y ; GET NEXT BYTE FROM THE BUFFER
 INC BPTR
 BNE NIBPTR ; INCREMENT BUFFER POINTER
 INC BPTR+1
NIBPTR: INC BCOUNT
 BNE NIBCNT ; INCREMENT COUNT
 INC BCOUNT+1
NIBCNT: LDX DOTS
 STA DOTS ; SWAP NEW FOR OLD
 CPX #40 ; VALID OLD VALUE ?
 BCC RDPAIR ; YES IF < 40
 CMP #40 ; IS NEW BYTE SINGLE ?
 BCC ENDCHK ; IF NOT GET NEXT BYTE
 TAX ; SAVE COLOUR
 ROL A
 ROL A ; SHIFT NO. INTO LS 2 BITS
 ROL A
 AND #3
RDPAIR: SEC ; SUBTRACT 1
 SBC #1
 STA DELTAX ; SET VECTOR LENGTH
 STX TEMP1
 LDY #2
 JSR PUTCOL
 LDA #10
 STA CMD ; AND PLOT THE VECTOR
 SEC
 ROR DOTS ; SET OLD BYTE INVALID
 JSR READY ; WAIT FOR COMPLETION
 INC XLSB ; INCREMENT X POSITION
 BNE ENDCHK
 INC XMSB
 JSR CHECKX
 BEQ ENDCHK
 STA CODEND ; SET CODEND NZ TO MARK FINISH
 JMP RESCRD ; FINISH BY RESTORING VGP POSITION
ENDCHK: LDA BCOUNT+1
 AND #2
 BEQ DECDLP ; LOOP UNTIL BUFFER EMPTY
BYEBYE: RTS ; RETURN TO PASCAL