newwrite

.PAG 'WRITE 01/18/83'
; CASSETTE INFO - FSBLK IS BLOCK COUNTER FOR RECORD
;       FSBLK = 2 -FIRST HEADER
;             = 1 -FIRST DATA
;             = 0 -SECOND DATA
;
; WRITE - TOGGLE WRITE BIT ACCORDING TO LSB IN OCHAR
;
WRITE	LDA OCHAR       ;SHIFT BIT TO WRITE INTO CARRY
	LSR A
	.IFE SYSTEM <
	LDA #242        ;...C CLR WRITE SHORT
WRT1	LDX #0          ;SET AND STORE TIME
	BCC WRTX
WRTW	LDA #146        ;...C SET WRITE LONG
WRTW1	LDX #1
>
	.IFN SYSTEM <
	LDA #96         ;...C CLR WRITE SHORT
WRT1	LDX #0          ;SET AND STORE TIME
	BCC WRTX
WRTW	LDA #176        ;...C SET WRITE LONG
	LDX #0
>
WRTX	STA CIA+TBLO
	STX CIA+TBHI
	LDA #$19        ;TURN THE TIMER ON
	STA CIA+CRB
	LDA CIA+ICR     ;CLEAR THE  6526
	LDA TPI1+AIR    ;CLEAR 6525 PRIORITY IRQ
	STA TPI1+AIR
;
	LDA TPI1+PB     ;TOGGLE WRITE BIT
	EOR #$20        ;BIT #5
	STA TPI1+PB
	AND #$20        ;LEAVE ONLY WRITE BIT
	RTS
;
; WRTN - CALLED AT THE END OF EACH BYTE
;   TO WRITE A LONG RER    REZ
;              HHHHHHLLLLLLHHHLLL...
;
WRTN	LDA RER         ;CHECK FOR ONE LONG
	BNE WRTN1
	.IFE SYSTEM <
	LDA #82         ;WRITE A LONG BIT
	LDX #2
>
	.IFN SYSTEM <
	LDA #16         ;WRITE A LONG BIT
	LDX #1
>
	JSR WRTX
	BNE WRT3
	INC RER
	LDA PRP         ;IF END OF BLOCK(BIT SET BY WRTL3)...
	BPL WRT3        ;...NO END CONTINUE
	JMP WRNC        ;...END ...FINISH OFF
;
WRTN1	LDA REZ         ;CHECK FOR A ONE BIT
	BNE WRTN2
	JSR WRTW
	BNE WRT3
	INC REZ
	BNE WRT3
;
WRTN2	JSR WRITE
	BNE WRT3        ;ON BIT LOW EXIT
	LDA FIRT        ;CHECK FOR FIRST OF DIPOLE
	EOR #1
	STA FIRT
	BEQ WRT2        ;DIPOLE DONE
	LDA OCHAR       ;FLIPS BIT FOR COMPLEMENTARY RIGHT
	EOR #1
	STA OCHAR
	AND #1          ;TOGGLE PARITY
	EOR PRTY
	STA PRTY
WRT3	JMP PREND       ;RESTORE REGS AND RTI EXIT
;
WRT2	LSR OCHAR       ;MOVE TO NEXT BIT
	DEC PCNTR       ;DEC COUNTER FOR # OF BITS
	LDA PCNTR       ;CHECK FOR 8 BITS SENT...
	BEQ WRT4        ;...IF YES MOVE IN PARITY
	BPL WRT3        ;...ELSE SEND REST
;
WRTS	JSR NEWCH       ;CLEAN UP COUNTERS
	CLI             ;ALLOW FOR INTERRUPTS TO NEST
	LDA CNTDN       ;ARE WE WRITING HEADER COUNTERS?...
	BEQ WRT6        ;...NO
; WRITE HEADER COUNTERS (9876543210 TO HELP WITH READ)
	LDX #0          ;CLEAR BCC
	STX CDATA
WRTS1	DEC CNTDN
	LDX FSBLK       ;CHECK FOR FIRST BLOCK HEADER
	CPX #2
	BNE WRT61       ;...NO
	ORA #$80        ;...YES MARK FIRST BLOCK HEADER
WRT61	STA OCHAR       ;WRITE CHARACTERS IN HEADER
	BNE WRT3
;
WRT6	JSR CMPSTE      ;COMPARE START:END
	BCC WRT7        ;NOT DONE
	BNE WRTL3       ;GO MARK END
	INC SAS         ; OVERFLOW FOR BNE ENDING
	LDA CDATA       ;WRITE OUT BCC
	STA OCHAR
	BCS WRT3        ;JMP
;
WRTL3	SEC             ;FLAG PRP FOR END OF BLOCK
	ROR PRP         ;REPLACE SAH WITH PRP
	BMI WRT3        ; JMP
;
WRT7	LDY #0          ;GET NEXT CHARACTER
	LDA (SAL)Y
	STA OCHAR       ;STORE IN OUTPUT CHARACTER
	EOR CDATA       ;UPDATE BCC
	STA CDATA
	JSR INCSAL      ;INCREMENT FETCH ADDRESS
	BNE WRT3        ;BRANCH ALWAYS
;
WRT4	LDA PRTY        ;MOVE PARITY INTO OCHAR...
	EOR #1
	STA OCHAR       ;...TO BE WRITTEN AS NEXT BIT
WRTBK	JMP PREND       ;RESTORE REGS AND RTI EXIT
;
WRNC	DEC FSBLK       ;CHECK FOR END
	BNE WREND       ;...BLOCK ONLY
	JSR TNOF        ;...WRITE, SO TURN OFF MOTOR
WREND	LDA #80         ;PUT 80 CASSETTE SYNCS AT END
	STA SHCNL
	SEI
	LDA #<WRTZ
	STA CINV
	LDA #>WRTZ
	STA CINV+1
	JMP WRTBK
;
	.IFE SYSTEM <
WRTZ	LDA #34         ;WRITE LEADING ZEROS FOR SYNC
	CLC
	JSR WRTW1
>
	.IFN SYSTEM <
WRTZ	LDA #120        ;WRITE LEADING ZEROS FOR SYNC
	CLC
	JSR WRT1
>
	BNE WRTBK
	DEC SHCNL       ;CHECK IF DONE WITH LOW SYNC...
	BNE WRTBK       ;...NO
	JSR NEWCH       ;...YES CLEAR UP COUNTERS
	DEC SHCNH       ;CHECK IF DONE WITH SYNC...
	BPL WRTBK       ;...NO
	LDA #<WRTN
	STA CINV
	LDA #>WRTN
	STA CINV+1
	CLI
	INC SHCNH       ;ZERO SHCNH
	LDA FSBLK       ;IF DONE THEN...
	BEQ STKY        ;...GOTO SYSTEM RESTORE
	JSR RD300
	LDX #9          ;SET UP FOR HEADER COUNT
	STX CNTDN
	STX PRP         ;CLEAR END-OF-BLOCK MARK
	JMP WRTS
;
TNIF	PHP             ;CLEAN UP INTERRUPTS AND RESTORE PIA'S
	SEI
	JSR TNOF        ;TURN OFF MOTOR
	LDA #%00010011  ;CLEAR POSSIBLE INTERRUPT
	STA CIA+ICR
;
; RESTORE DEFAULTS
;
;
;RESTORE 60HZ INTERRUPTS
;
	LDA #%11111
	STA TPI1+MIR
;
	LDA OLDINV+1    ;CHECK IF WE SHOULD
	BEQ TNEND
	LDA CASSVO
	STA DFLTN
	LDA ASERVO
	STA DFLTO
	STA CINV+1      ;...RESTORE INDIRECT
	LDA OLDINV+2
	STA I6509
	LDA OLDINV
	STA CINV
TNEND	PLP
	RTS
;
STKY	JSR TNIF        ;GO RESTORE SYSTEM INTERRUPTS
	BEQ WRTBK       ;CAME FOR CASSETTE IRQ SO RTI
;
;TURN CASSETTE MOTOR OFF
;
TNOF	LDA TPI1+PB
	ORA #$40        ;BIT #6 HI
	STA TPI1+PB
	RTS
.PAG 'TEMPORARIES'
;EQUATE SCREEN EDITOR TEMPORARILY
;
CINT	=$E000+4
LP2	=$E003+4
LOOP5	=$E006+4
PRT	=$E009+4
SCNKEY	=$E00F+4
KEY	=$E00F+4
FUNKEY	=$E022
;
; NO ROUTINES IN 8032 SCREEN EDITOR
;
SCRORG	=$E00C+4
PLOT	=$E015+4
IOBASE	=$E018+4
ESCRTS	=$E01B+4
;
RD300	LDA STAH
	STA SAH
	LDA STAL
	STA SAL
	LDA STAS
	STA SAS
	STA I6509       ;POINT INDIRECT
	RTS
;
CMPSTE	SEC
	LDA SAL
	SBC EAL
	LDA SAH
	SBC EAH
	LDA SAS
	SBC EAS
	RTS
;
INCSAL	INC SAL
	BNE INCR20
	INC SAH
INCR10	BNE INCR20
	INC SAS
	INC I6509       ;CHANGE INDIRECT
	LDA #$02        ;SKIP $0000 AND $0001
	STA SAL
INCR20	RTS
.END