erkyrath.infocom-zcode-terps/ted/machine.src

	PAGE
	SBTTL "--- MACHINE-DEPENDENT I/O: CBM PLUS/4 ---"

	; ----------------------------
	; FETCH ASCII KEYCODE INTO [A]
	; ----------------------------

	; EXIT: ASCII IN [A] & [IOCHAR]

CYCLE	EQU	$E0		; SHORT BLINK CYCLE
CURSOR	EQU	$64		; SCREEN CODE FOR UNDERLINE

GETKEY:	TXA			; SAVE [X] & [Y]
	PHA
	TYA
	PHA

GKEY0:	LDA	#0
	STA	BLINK+LO	; SET CURSOR BLINK
	STA	BLINK+HI	; FOR A LONG CYCLE

	SEC			; GET CURSOR COORDINATES
	JSR	PLOT		; INTO [X/Y]

	STY	COLUMN		; SAVE X-POS HERE

	LDA	LOLINE,X	; GET LSB OF ROW ADDRESS
	STA	SROW+LO		; SAVE HERE
	STA	CROW+LO		; AND HERE
	LDA	HILINE,X	; GET LSB OF ROW ADDRESS
	STA	SROW+HI		; USE AS-IS FOR SCREEN RAM
	SEC			; SUBTRACT 1K
	SBC	#4		; TO GET CORRESPONDING
	STA	CROW+HI		; COLOR RAM ADDRESS

	LDA	#CURSOR
	STA	CSHAPE
	STA	(SROW),Y	; FORCE CURSOR ON
	LDA	#0
	STA	(CROW),Y	; MAKE CURSOR BLACK

GKEY1:	JSR	GETIN		; GET A KEYCODE
	TAX			; SAVE IT HERE
	LDY	COLUMN		; NEED THIS FOR LATER

	INC	BLINK+LO	; UPDATE THE
	BNE	NOBLIN		; BLINK TIMER
	INC	BLINK+HI
	BNE	NOBLIN

	LDA	#CYCLE		; RESET THE CURSOR
	STA	BLINK+HI	; FOR SHORT DUTY CYCLE

	LDA	CSHAPE		; FLIP THE CURSOR SHAPE
	CMP	#SPACE
	BEQ	SHAP0		; IF SPACE, USE CURSOR
	LDA	#SPACE		; ELSE USE SPACE
	BNE	SHAP1

SHAP0:	LDA	#CURSOR

SHAP1:	STA	CSHAPE		; UPDATE CURSOR SHAPE
	STA	(SROW),Y	; INTO SCREEN RAM

NOBLIN:	TXA			; ANY KEY PRESSED?
	BEQ	GKEY1		; NOT IF CODE WAS ZERO

	; CONVERT & MASK KEYCODE IN [A]

	CMP	#'A'		; CONVERT UNSHIFTED ALPHA
	BCC	MASK		; TO ASCII LOWER CASE
	CMP	#'Z'+1
	BCS	MASK
	ADC	#$20

MASK:	AND	#%01111111	; SCREEN OUT SHIFTS

	CMP	#EOL		; EOL?
	BEQ	TICK
	CMP	#BACKSP		; BACKSPACE?
	BEQ	TICK
	CMP	#SPACE		; ANYTHING ELSE < "SPACE"
	BCC	BADKEY		; IS BAD

	CMP	#'<'		; CHANGE "<"
	BNE	MASK0		; TO ","
	LDA	#','
	BNE	TICK

MASK0:	CMP	#'>'		; CHANGE ">"
	BNE	MASK1		; TO "."
	LDA	#'.'
	BNE	TICK

MASK1:	CMP	#'z'+1		; PASS L-C ALPHA
	BCS	BADKEY
	CMP	#'a'
	BCS	TICK

	CMP	#'Z'+1		; PASS U-C ALPHA
	BCC	TICK		; AND OTHER ASCII CHARS

BADKEY:	JSR	BOOP		; REJECT BAD KEYPRESS
	JMP	GKEY0		; AND TRY AGAIN

	; "CLICK" THE KEY

TICK:	STA	IOCHAR		; SAVE KEYCODE HERE

	LDA	#SPACE
	STA	(SROW),Y	; ERASE CURSOR
	LDA	#WHITE
	STA	(CROW),Y	; MAKE SURE COLOR RAM IS WHITE

	LDA	#0		; LSB CLICK FREQ
	STA	V1FLSB
	LDA	#7		; MSB CLICK FREQ W/BIT 2 SET
	STA	BITMAP
	LDA	#$1F		; VOICE #1, FULL VOLUME
	STA	VOLUME

	LDX	#0		; A SHORT DELAY ...
	LDY	#5
TICK0:	DEX
	BNE	TICK0
	DEY
	BNE	TICK0
	STY	VOLUME		; ... THEN SHUT OFF SOUND

	PLA			; RESTORE [X] & [Y]
	TAY
	PLA
	TAX
	LDA	IOCHAR		; RESTORE CODE INTO [A]
	RTS

	; -------------------------
	; OUTPUT AN ASCII CHARACTER
	; -------------------------

LETTER:	CMP	#'a'		; LOWER-CASE?
	BCC	LET0		; NO, CONTINUE
	AND	#%01011111	; ELSE MASK FOR LOWER-CASE
	JMP	CHROUT

LET0:	CMP	#'A'		; UPPER-CASE?
	BCC	LETEX
	CMP	#'Z'+1
	BCS	LETEX
	ORA	#%00100000	; MAKE UPPER

LETEX:	JMP	CHROUT

	; -----------------
	; PRINT CHAR IN [A]
	; -----------------

CHAR:	STA	IOCHAR		; SAVE HERE
	TXA			; SAVE [X] AND [Y]
	PHA
	TYA
	PHA

	SEC			; GET CURSOR X- AND Y-POS
	JSR	PLOT		; INTO [Y] AND [X], RESPECTIVELY
	TYA
	CMP	#40		; STRIP OFF THE
	BCC	CHKEOL		; LOGICAL LINE OFFSET
	SBC	#40		; UPDATE [Y] IF NECESSARY
	TAY

CHKEOL:	LDA	IOCHAR		; RESTORE CHAR
	CMP	#EOL		; IS IT EOL?
	BEQ	OUTEOL		; YES, SPECIAL HANDLING

	; HANDLE A NON-EOL CHAR

	CPX	#YSIZE-1	; ON LAST SCREEN LINE?
	BCC	NOSCRL		; NO, NO SCROLL NEEDED
	CPY	#XSIZE		; LAST CHAR ON LINE?
	BCC	NOSCRL		; NO, DON'T SCROLL

	; SCROLL THE SCREEN

DOSCRL:	DEX			; PUSH CURSOR UP ONE LINE
	CLC
	JSR	PLOT		; RESET THE CURSOR

	LDX	SLINE		; GET CURRENT SCROLL LINE

SRL0:	CPX	#YSIZE
	BEQ	SRL2		; SCROLL DONE

	LDA	LOLINE,X	; GET ADDR OF DEST LINE
	STA	LTO+LO		; INTO [LTO]
	LDA	HILINE,X
	STA	LTO+HI

	INX
	LDA	LOLINE,X	; GET ADDR OF SOURCE LINE
	STA	LFROM+LO	; INTO [LFROM]
	LDA	HILINE,X
	STA	LFROM+HI

	LDY	#XSIZE
SRL1:	LDA	(LFROM),Y	; MOVE SOURCE LINE
	STA	(LTO),Y		; TO DEST LINE
	DEY
	BPL	SRL1

	BMI	SRL0		; LOOP TILL [X] = YSIZE

SRL2:	LDX	#XSIZE
	LDA	#SPACE
SRL3:	STA	SCREEN+960,X	; CLEAR LAST LINE
	DEX			; OF SCREEN RAM
	BPL	SRL3

NOSCRL:	LDA	IOCHAR		; RESTORE CHAR
	JSR	LETTER		; OFF TO THE SCREEN!
	PLA			; RESTORE [X] AND [Y]
	TAY
	PLA
	TAX
	RTS

	; HANDLE EOL

OUTEOL:	CPX	#YSIZE-1	; LAST SCREEN LINE?
	BCC	NOSCRL		; NO, DON'T SCROLL
	BCS	DOSCRL		; ELSE SCROLL

	; ---------------------
	; FETCH A LINE OF INPUT
	; ---------------------

	; ENTRY: ABS ADDR OF READ BUFFER IN [ARG1]
	; EXIT: # CHARS READ IN [A]

INPUT:	JSR	LINOUT		; FLUSH [LBUFF]

	LDY	#0
	STY	LINCNT		; RESET LINE COUNT
	STY	NDX		; AND KEY QUEUE

INLOOP:	JSR	GETKEY		; GET ASCII INTO [A] AND [IOCHAR]

	CMP	#EOL		; EOL?
	BEQ	ENDLIN		; LINE DONE IF SO
	CMP	#BACKSP		; BACKSPACE?
	BEQ	BACKUP		; SPECIAL HANDLING

	STA	LBUFF,Y		; ELSE ADD CHAR TO INPUT BUFFER
	INY			; NEXT POSITION IN LINE

SHOWIT:	JSR	CHAR		; SEND TO SCREEN

	CPY	#77		; 2 SCREEN LINES FULL?
	BCC	INLOOP		; NO, GET ANOTHER CHAR

	; HANDLE LINE OVERFLOW

NOMORE:	JSR	GETKEY
	CMP	#EOL		; IF EOL,
	BEQ	ENDLIN		; WRAP UP THE LINE
	CMP	#BACKSP		; BACKSPACE
	BEQ	BACKUP		; IS OKAY TOO
	JSR	BOOP		; ELSE COMPLAIN
	JMP	NOMORE		; AND INSIST

	; HANDLE BACKSPACE

BACKUP:	DEY			; BACK UP THE POINTER
	BPL	SHOWIT		; SEND BS IF NOT START OF LINE
	JSR	BOOP		; ELSE SCREAM WITH PAIN
	LDY	#0		; RESET POINTER
	BEQ	INLOOP		; AND WAIT FOR SOMETHING BETTER

	; HANDLE END OF LINE

ENDLIN:	STA	LBUFF,Y		; SHIP EOL TO BUFFER
	INY			; UPDATE INDEX
	STY	LINLEN		; SAVE HERE FOR "READ"
	STY	PRLEN		; AND HERE FOR "PPRINT"
	JSR	CHAR		; AND SEND EOL TO SCREEN

	; MOVE [LBUFF] TO [ARG1] W/LC CONVERSION

LEX1:	LDA	LBUFF-1,Y	; GET A CHAR FROM [LBUFF]
	CMP	#'A'		; IF CHAR IS ALPHA,
	BCC	LEX2		; CONVERT TO LOWER CASE
	CMP	#'Z'+1
	BCS	LEX2
	ADC	#$20
LEX2:	STA	(ARG1),Y	; MOVE CHAR TO INPUT BUFFER AT [ARG1]
	DEY			; LOOP TILL
	BPL	LEX1		; ALL CHARS MOVED

	JSR	PPRINT		; SCRIPT [LBUFF] IF ENABLED

	LDA	LINLEN		; RESTORE # CHARS
	RTS			; INTO [A]

	; -----------------------
	; DIRECT PRINT LINE [X/A]
	; -----------------------

	; ENTRY: STRING ADDRESS IN [X/A] (LSB/MSB)
	;        STRING LENGTH IN [Y]

DLINE:	STX	STRING+LO	; DROP STRING ADDRESS
	STA	STRING+HI	; INTO DUMMY OPERAND BYTES
	LDX	#0		; INIT BYTE-FETCHING INDEX

DOUT:	DB	$BD		; 6502 "LDA nnnn,X" OPCODE
STRING:	DW	$0000		; DUMMY OPERAND BYTES
	JSR	CHAR
	INX
	DEY			; STRING DONE?
	BNE	DOUT		; NO, KEEP PRINTING
	RTS

	; -----------------------
	; SEND [LBUFF] TO PRINTER
	; -----------------------

	; ENTRY: LENTH OF LINE IN [PRLEN]

PPRINT:	LDA	SCRIPT		; SCRIPTING INTERNALLY ENABLED?
	BEQ	PEX		; NO, SCRAM IMMEDIATELY

	LDA	ZBEGIN+ZSCRIP+1	; CHECK SCRIPT FLAG
	AND	#%00000001	; SCRIPTING ON?
	BEQ	PP3		; NO, CHECK FOR "UNSCRIPT"

	LDA	PSTAT		; CHECK PRINTER STATUS
	BMI	PEX		; CAN'T OPEN IF NEGATIVE
	BNE	PP1		; ALREADY OPEN, SCRIPT THE LINE

	; OPEN THE PRINTER FOR OUTPUT

;	LDA	FAST		; FAST-READ ENGAGED?
;	BEQ	PP0		; NO, IGNORE
;	JSR	FOFF		; ELSE DISENGAGE
;	LDA	#8
;	JSR	DOPEN		; AND RESET THE DRIVE

PP0:	INC	PSTAT		; SET STATUS TO "PRINTER OPENED" (1)

	LDA	#4		; LOGICAL FILE #4
	TAX			; DEVICE #4
	LDY	#7		; ALLOW UPPER/LOWER CASE
	JSR	SETLFS		; SET UP LOGICAL FILE
	LDA	#0
	JSR	SETNAM		; NO FILENAME REQUIRED
	JSR	OPEN		; OPEN THE CHANNEL
	BCC	PP1		; OPEN OKAY IF CARRY CLEAR

PPERR:	LDA	#$FF		; ELSE SET PRINTER STATUS
	STA	PSTAT		; TO "CAN'T OPEN"
	BNE	PP5		; AND SIMULATE AN "UNSCRIPT"

PP1:	LDX	#4		; SET PRINTER CHANNEL
	JSR	CHKOUT		; TO "OUTPUT"
	BCS	PPERR		; ERROR IF CARRY SET

	LDY	#0		; INIT INDEX
PP2:	LDA	LBUFF,Y
	JSR	LETTER
	BCS	PPERR		; ERROR IF CARRY SET
	INY
	DEC	PRLEN
	BNE	PP2

	BEQ	PEX		; RESET & RETURN

	; CHECK FOR "UNSCRIPT"

PP3:	LDA	PSTAT		; CHECK PRINTER STATUS
	BEQ	PEX		; EXIT IF PRINTER WAS OFF
	BMI	PEX		; OR UNOPENABLE

PP4:	LDA	#0		; RESET PRINTER STATUS FLAG
	STA	PSTAT		; TO "CLOSED"

	; ENTRY FOR PRINTER ERROR

PP5:	LDA	#4
	JSR	CLOSE		; CLOSE THE PRINTER CHANNEL

;	LDA	FAST		; FAST-READ AVAILABLE?
;	BEQ	PEX		; NO, EXIT
;	LDA	#8		; ELSE
;	JSR	DOPEN		; RESET BOOT DRIVE
;	JMP	FINIT		; RE-ENGAGE FAST-READ & RETURN

PEX:	JMP 	CLRCHN

	; ------------
	; SPLIT SCREEN
	; ------------

	; SPLIT SCREEN AT LINE [ARG1]
	; DISABLE SPLIT IF [ARG1] = 0
	; IGNORE IF SPLIT ALREADY ENABLED OR [ARG1] >= 20

ZSPLIT:	LDX	ARG1+LO		; IF [ARG1] = 0,
	BEQ	OFFSPL		; TURN OFF SPLIT SCREEN

	LDA	SPSTAT		; SPLIT ALREADY ENABLED?
	BNE	SPLEX		; IGNORE REQUEST IF SO

	CPX	#20		; IF [ARG1] >= 20,
	BCS	SPLEX		; IGNORE

	INX
	STX	SLINE		; ELSE SET NEW SPLIT LINE
	STX	SPSTAT		; SET "SPLIT ENABLED" FLAG

SPL0:	LDA	LOLINE,X	; MAKE [LFROM] POINT TO
	STA	LFROM+LO	; LINE [X] IN WINDOW
	LDA	HILINE,X
	STA	LFROM+HI

	LDY	#XSIZE		; CLEAR LINE [X]
	LDA	#SPACE
SPL1:	STA	(LFROM),Y
	DEY
	BPL	SPL1

	DEX			; DONE ALL LINES?
	BNE	SPL0		; LOOP TILL WINDOW CLEARED
	STX	LINCNT		; RESET LINE COUNT TO ZERO

SPCALC:	LDA	#YSIZE-1	; CALCULATE # LINES TO SCROLL
	SEC			; BEFORE "MORE" APPEARS:
	SBC	SLINE		; LMAX = YSIZE-SLINE-1
	STA	LMAX
	DEC	LMAX

SPLEX:	RTS

	; --------------------
	; DISABLE SPLIT SCREEN
	; --------------------

OFFSPL:	JSR	TOBOT

SPLOFF:	LDX	#1
	STX	SLINE		; SPLIT AT LINE 1
	DEX			; = 0
	STX	SPSTAT		; TURN OFF STATUS FLAG
	STX	LINCNT		; RESET LINE COUNT
	LDA	#21
	STA	LMAX		; SET MAXIMUM LINE SCROLL
	LDA	#%01000000
	STA	LINKEN		; DISABLE LINE LINKING
	RTS

	; ------
	; SCREEN
	; ------

	; GO TO TOP WINDOW IF [A] = 0
	; GO TO BOTTOM IF [A] = 1
	; IGNORE IF SPLIT NOT ENABLED OR [A] <> 0 OR 1

ZSCRN:	LDA	SPSTAT		; IF SPLIT NOT ENABLED,
	BEQ	SPLEX		; IGNORE REQUEST

	LDA	ARG1+LO		; IF [ARG1] = 0,
	ORA	ARG1+HI
	BEQ	TOBOT		; GO TO BOTTOM WINDOW
	CMP	#1		; IF [ARG1] <> 1,
	BNE	SPLEX		; IGNORE THE REQUEST

	; SET TO TOP WINDOW

TOTOP:	LDX	#21		; TEMPORARILY RESET
	STX	LMAX		; [LMAX] TO KILL "MORE"
	LDX	#1		; Y-POS = 1
	BNE	DOSCRN

	; SET TO BOTTOM WINDOW

TOBOT:	JSR	SPCALC		; RE-CALC [LMAX]
	LDX	#23		; Y-POS = 23

DOSCRN:	LDY	#0		; X-POS = 0
	STY	LINCNT		; RESET LINE COUNT
	CLC
	JMP	PLOT		; SET CURSOR TO X=[Y], Y=[X]

	; ---------
	; RAZZ USER
	; ---------

BOOP:	LDA	#0		; LSB BOOP FREQ
	STA	V1FLSB
	LDA	#4
	STA	BITMAP		; MSB FREQ W/BIT 2 SET
	LDA	#$1F
	STA	VOLUME		; VOICE #1, FULL VOLUME

	LDA	#252
	STA	TIME
BOOPL:	LDA	TIME		; WAIT 6 JIFFIES
	BNE	BOOPL

	STA	VOLUME		; SOUND OFF
	RTS

	; ------------------------
	; CLEAR SCREEN & COLOR RAM
	; ------------------------

CLS:	LDA	#WHITE		; SET FOREGROUND COLOR
	STA	COLOR		; TO WHITE
	LDA	#147		; "CLEAR SCREEN" CHAR
	JSR	CHROUT

	LDY	#0		; CURSOR TO (0,1)
	LDX	#1
	CLC
	JSR	PLOT

	JMP 	SPLOFF		; DISABLE SPLIT SCREEN

	; -------------------
	; LINE ADDRESS TABLES
	; -------------------

LOLINE:	DB	$00,$28,$50,$78,$A0,$C8,$F0,$18
	DB	$40,$68,$90,$B8,$E0,$08,$30,$58
	DB	$80,$A8,$D0,$F8,$20,$48,$70,$98
	DB	$C0

HILINE:	DB	$0C,$0C,$0C,$0C,$0C,$0C,$0C
	DB	$0D,$0D,$0D,$0D,$0D,$0D
	DB	$0E,$0E,$0E,$0E,$0E,$0E,$0E
	DB	$0F,$0F,$0F,$0F,$0F

	END