mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-02-08 09:11:27 +00:00
493 lines
8.9 KiB
Plaintext
493 lines
8.9 KiB
Plaintext
|
|
PAGE
|
|
SBTTL "--- MACHINE-DEPENDENT I/O: APPLE II ---"
|
|
|
|
; ----------------------------
|
|
; FETCH ASCII KEYCODE INTO [A]
|
|
; ----------------------------
|
|
|
|
; EXIT: ASCII IN [A] & [IOCHAR]
|
|
|
|
GETKEY: CLD
|
|
TXA ; SAVE [X] & [Y]
|
|
PHA
|
|
TYA
|
|
PHA
|
|
|
|
GKEY0: JSR RDKEY ;GET A CHAR
|
|
|
|
;CHECK TO MAKE SURE KEY IS VALID, ONLY ACCEPT IT IF IT IS
|
|
|
|
AND #$7F ;SCREEN OUT SHIFTS
|
|
CMP #EOL ;CHECK FOR GOOD (BAD) CHAR
|
|
BNE GK0
|
|
JMP OK
|
|
GK0: CMP #BACKSP
|
|
BNE GK5
|
|
JMP OK
|
|
GK5: CMP #ARROW
|
|
BNE GK1
|
|
JMP OK
|
|
|
|
; CHECK FOR "ARROWS", CONVERT FOR USE (EZIP)
|
|
; ALSO : CHANGE <_>)@%^&*( TO ,-.0256789
|
|
|
|
GK1: LDX #ENDKEY ; GET LENGTH OF LIST
|
|
GK2: CMP HAVE,X ; CHECK AGAINST LIST OF UNWANTED KEYS
|
|
BEQ GK3 ; FOUND IT
|
|
DEX
|
|
BPL GK2 ; CHECK THEM ALL
|
|
BMI GK4 ; NOT FOUND, CONTINUE OTHER CHECKS
|
|
GK3: LDA WANT,X ; GET KEY TO USE INSTEAD
|
|
BNE OK ; JMP
|
|
|
|
GK4: CMP #SPACE ; NO CTRL CHARS ACCEPTABLE
|
|
BCC BADKEY ; IF < SPACE, BAD
|
|
CMP #$2B
|
|
BEQ BADKEY
|
|
|
|
CMP #$3C
|
|
BCC OK
|
|
CMP #$3F
|
|
BEQ OK
|
|
|
|
MASK0: CMP #'z'+1 ;PICK OUT LETTERS NOW
|
|
BCS BADKEY ;IF > BAD
|
|
CMP #'a'
|
|
BCS OK ;IF > OK
|
|
CMP #'A'
|
|
BCC BADKEY
|
|
CMP #'Z'+1
|
|
BCC OK ;IF < OK
|
|
|
|
BADKEY: JSR BOOP ;BAD KEY, GIVE WARNING NOISE
|
|
JMP GKEY0 ;TRY AGAIN
|
|
|
|
OK: STA IOCHAR ;HOLD ON TO IT
|
|
|
|
ADC RNUM1 ;FUTZ WITH RANDOM
|
|
STA RNUM1
|
|
EOR RNUM2
|
|
STA RNUM2
|
|
|
|
PLA ; RESTORE
|
|
TAY ; EVERYTHING
|
|
PLA
|
|
TAX
|
|
LDA IOCHAR ; GET CHAR INTO [A]
|
|
RTS ; AND RETURN IT
|
|
|
|
HAVE: DB $3C,$5F,$3E,$29,$40,$25,$5E,$26,$2A,$28
|
|
WANT: DB $2C,$2D,$2E,$30,$32,$35,$36,$37,$38,$39
|
|
ENDKEY EQU $-WANT-1
|
|
|
|
|
|
; -----------------
|
|
; PRINT CHAR IN [A]
|
|
; -----------------
|
|
|
|
CHAR: STA IOCHAR ; SAVE HERE
|
|
TXA ; SAVE [X] AND [Y]
|
|
PHA
|
|
TYA
|
|
PHA
|
|
|
|
LDA IOCHAR
|
|
CMP #$61 ; (L)
|
|
BCC CHAR1 ;LESS THAN a
|
|
CMP #$7B ; (L)
|
|
BCS CHAR1 ;GREATER THAN z
|
|
LDX COL80
|
|
BNE CHAR1 ;ONLY CONVERT IF 40 COLUMN
|
|
AND #%11011111 ;STRIP LOWER CASE BIT
|
|
|
|
CHAR1: ORA #%10000000 ;SET BIT 7 SO WILL BE NORMAL IF WANTED
|
|
JSR MCOUT
|
|
|
|
PLA ; RESTORE [X] AND [Y]
|
|
TAY
|
|
PLA
|
|
TAX
|
|
RTS
|
|
|
|
; ---------------------
|
|
; FETCH A LINE OF INPUT
|
|
; ---------------------
|
|
|
|
; ENTRY: ABS ADDR OF READ BUFFER IN [ARG1]
|
|
; EXIT: # CHARS READ IN [A]
|
|
|
|
INPUT: JSR LINOUT ; FLUSH [LBUFF]
|
|
|
|
LDY WTOP
|
|
STY LINCNT ; RESET LINE COUNT
|
|
INC LINCNT ; 1 FOR THIS LINE
|
|
LDY #0 ; AND CHAR COUNT
|
|
|
|
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
|
|
CMP #ARROW ; LEFT ARROW (BACKSPACE)?
|
|
BEQ BACKUP
|
|
|
|
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
|
|
CMP #ARROW ; BACKSPACE
|
|
BEQ BACKUP
|
|
JSR BOOP ; ELSE COMPLAIN
|
|
JMP NOMORE ; AND INSIST
|
|
|
|
; HANDLE BACKSPACE
|
|
|
|
BACKUP: DEY ; BACK UP THE POINTER
|
|
BMI BBAD
|
|
LDA #$08 ;BACKSP STRANGE SO DO 082008
|
|
JSR CHAR
|
|
LDA #$20
|
|
JSR CHAR
|
|
LDA #$08
|
|
BNE SHOWIT ;JMP
|
|
|
|
BBAD: JSR BOOP ; ELSE SCREAM WITH PAIN
|
|
LDY #0 ; RESET POINTER
|
|
BEQ INLOOP ; AND WAIT FOR SOMETHING BETTER
|
|
|
|
; HANDLE END OF LINE
|
|
|
|
ENDLIN: LDA #$8D ; (MUST BE $8D FOR PRINTER Le 5/8/85)
|
|
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
|
|
|
|
LEX0: LDA LBUFF-1,Y ; GET A CHAR FROM [LBUFF]
|
|
|
|
LEX1: CMP #'A' ; IF CHAR IS ALPHA,
|
|
BCC LEX2 ; CONVERT TO LOWER CASE
|
|
CMP #'Z'+1
|
|
BCS LEX2
|
|
ADC #$20
|
|
|
|
LEX2: AND #$7F ; HIGH BIT OFF
|
|
STA (ARG1),Y ; MOVE CHAR TO INPUT BUFFER AT [ARG1]
|
|
DEY ; LOOP TILL
|
|
BNE LEX0 ; ALL CHARS MOVED
|
|
|
|
JSR PPRINT ; SCRIPT [LBUFF] IF ENABLED
|
|
|
|
LDA LINLEN ; RESTORE # CHARS
|
|
|
|
LDX COL80
|
|
BNE LEX3 ; 80 COL.
|
|
CMP #40
|
|
BCC LEX3
|
|
INC LINCNT ; USED 2 LINES
|
|
|
|
LEX3: 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 BYTES
|
|
|
|
LDX #0 ; INIT CHAR-FETCH INDEX
|
|
|
|
DOUT: DB $BD ; 6502 "LDA nnnn,X" OPCODE
|
|
STRING: DW $0000 ; DUMMY OPERAND BYTES
|
|
|
|
JSR CHAR
|
|
INX
|
|
DEY ; LOOP TILL
|
|
BNE DOUT ; OUT OF CHARS
|
|
RTS
|
|
|
|
; -----------------------
|
|
; SEND [LBUFF] TO PRINTER
|
|
; -----------------------
|
|
|
|
; ENTRY: LENTH OF LINE IN [PRLEN]
|
|
|
|
PLEAV: RTS
|
|
|
|
PPRINT: LDA SCRIPT ; SCRIPTING INTERNALLY ENABLED?
|
|
BEQ PLEAV ; NO, SCRAM IMMEDIATELY
|
|
|
|
LDA ZBEGIN+ZSCRIP+1 ; CHECK SCRIPT FLAG
|
|
AND #%00000001 ; SCRIPTING ON?
|
|
BEQ PLEAV ; NO, EXIT
|
|
|
|
LDA CSW+LO ;SAVE NORMAL OUTPUT HOOK
|
|
PHA
|
|
LDA CSW+HI
|
|
PHA
|
|
|
|
LDA CH ;SAVE CURRENT CURSOR POSITION
|
|
PHA
|
|
LDA EH ; IF 80 COL
|
|
PHA
|
|
|
|
LDA ALTCSW+LO ;LOAD SCRIPTING HOOK
|
|
STA CSW+LO
|
|
LDA ALTCSW+HI
|
|
STA CSW+HI
|
|
|
|
LDA #0
|
|
STA CH
|
|
STA EH
|
|
|
|
IF 0
|
|
|
|
;PRINTER INIT SEQUENCE FROM OLD ZIP (I DON'T KNOW)
|
|
|
|
LDA PSTAT ;CHECK PRINTER STATUS
|
|
CMP #1
|
|
BNE PP4 ;OPEN, ONLY DO ONCE
|
|
|
|
INC PSTAT ;SET TO DONE
|
|
|
|
PP0: LDA #$89 ;OUTPUT PRINTER SETUP SEQUENCE
|
|
JSR MCOUT ; <CTRL-I>
|
|
LDA CSW+HI
|
|
STA ALTCSW+HI
|
|
LDA CSW+LO
|
|
STA ALTCSW+LO
|
|
|
|
; (SETTING BYTE $779 REMOVED - UNNECCESARY COMPLICATION)
|
|
; (HANDLED BY THE ^I 80N Le 5/8/85)
|
|
|
|
LDA #$B8 ; 8 (80 COL WIDE)
|
|
JSR MCOUT
|
|
LDA #$B0 ; 0
|
|
JSR MCOUT
|
|
LDA #$CE ; N (LF AFTER CR)
|
|
JSR MCOUT
|
|
LDA #$8D ; <CR> (GUY AT APPLE SAID THIS A GOOD IDEA)
|
|
JSR MCOUT
|
|
|
|
ENDIF
|
|
|
|
PP4: LDY #0
|
|
PP5: LDA LBUFF,Y ;GET A CHAR TO SEND OUT
|
|
JSR MCOUT
|
|
INY
|
|
DEC PRLEN ;LINE COUNT
|
|
BNE PP5 ;PRINT WHOLE LINE
|
|
|
|
;ALL DONE, RESET TO NORMAL AND LEAVE
|
|
|
|
PLA ;RETRIEVE CURRENT CURSOR POSITION
|
|
STA EH
|
|
PLA
|
|
STA CH
|
|
PLA
|
|
STA CSW+HI
|
|
PLA
|
|
STA CSW+LO
|
|
|
|
PEX: RTS
|
|
|
|
|
|
SLOTM: DB EOL
|
|
DB "Printer Slot 1-7: "
|
|
SLOTML EQU $-SLOTM
|
|
|
|
PSTAT: DB 0 ;SET TO CLEAR WHEN BOOT,
|
|
;I PUT IT HERE SO RESTART WON'T ALTER
|
|
ALTCSW: DB 0,0 ;(WORD) PRINTER COUT
|
|
|
|
; ------------
|
|
; PRINTER INIT
|
|
; ------------
|
|
|
|
PCHK: LDX #LOW SLOTM ;ASK WHICH SLOT PRINTER IS IN
|
|
LDA #HIGH SLOTM
|
|
LDY #SLOTML
|
|
JSR DLINE
|
|
|
|
LDA #0 ;ACTUALLY SLOT 1
|
|
JSR DODEF ;DISPLAY IT AS DEFAULT
|
|
|
|
JSR GETKEY
|
|
CMP #EOL
|
|
BEQ PC2 ;USE DEFAULT
|
|
SEC
|
|
SBC #"0"
|
|
CMP #8 ;1-7
|
|
BCS PCHK ;OOPS
|
|
BCC PC3 ;SKIP AROUND DEFAULT
|
|
PC2: LDA #1 ;WHICH IS 1
|
|
PC3: CLC
|
|
ADC #$C0
|
|
STA ALTCSW+HI
|
|
|
|
JSR PISSER ;SEND <CR> TO SCREEN FOR NEATNESS
|
|
|
|
INC PSTAT ;SET TO ON
|
|
|
|
LDA CSW+LO ;SAVE NORMAL OUTPUT HOOK
|
|
PHA
|
|
LDA CSW+HI
|
|
PHA
|
|
LDA ALTCSW+LO ;LOAD SCRIPTING HOOK
|
|
STA CSW+LO
|
|
LDA ALTCSW+HI
|
|
STA CSW+HI
|
|
|
|
PP0: LDA #$89 ; OUTPUT PRINTER SETUP SEQUENCE
|
|
JSR MCOUT ; START WITH COMMAND CHAR <CTRL-I>
|
|
LDA #$B8 ; 8 (80 COL WIDE)
|
|
JSR MCOUT
|
|
LDA #$B0 ; 0
|
|
JSR MCOUT
|
|
LDA #$CE ; N (LF AFTER CR)
|
|
JSR MCOUT
|
|
|
|
LDA CSW+LO ; SAVE REAL PRINTER OUTPUT
|
|
STA ALTCSW+LO ; LOC. FOR NEXT TIME
|
|
LDA CSW+HI
|
|
STA ALTCSW+HI
|
|
|
|
PLA ; RESET NORMAL OUTPUT
|
|
STA CSW+HI
|
|
PLA
|
|
STA CSW+LO
|
|
|
|
RTS
|
|
|
|
|
|
; ------------
|
|
; SPLIT SCREEN
|
|
; ------------
|
|
|
|
; SPLIT SCREEN AT LINE [ARG1]
|
|
; DISABLE SPLIT IF [ARG1] = 0
|
|
; IGNORE IF SPLIT ALREADY ENABLED OR [ARG1] >= 20
|
|
|
|
ZSPLIT: LDA ZBEGIN+ZMODE
|
|
AND #%00100000 ;CHECK IF ENABLED
|
|
BEQ ZSPOUT ;NOT, LEAVE
|
|
|
|
LDA ARG1+LO ;GET # OF LINES FOR SCREEN
|
|
BEQ NORL ;IF 0 THEN RESTORE SCREEN
|
|
LDX SPSTAT ;CHECK IF ALREADY ENABLED
|
|
BNE ZSPOUT ;IT IS
|
|
CMP #20 ;IS SPLIT REALLY = WHOLE SCREEN
|
|
BCS ZSPOUT ;YES, IGNORE
|
|
|
|
PHA
|
|
CLC
|
|
ADC #1 ;ONE LINE ADDITIONAL TO SIZE GIVEN
|
|
;TO MAKE UP FOR STATUS LINE
|
|
STA WBOTM ;TEMPORARILY FOR TOP SCREEN CLEAR
|
|
STA SPSTAT ;NON ZERO = SCREEN IS SPLIT
|
|
JSR HOME ;CLEAR FROM TOP TO BOTTOM (OF TOP SCREEN)
|
|
LDA #$18 ;RESTORE BOTTOM FOR SCROLL
|
|
STA WBOTM
|
|
PLA ;GET @ OF LINES AGAIN
|
|
CLC
|
|
ADC #1 ;ADD 1
|
|
STA WTOP ;MAKE THAT THE TOP OF THE SECOND SCREEN
|
|
LDA #1
|
|
STA CH
|
|
STA EH
|
|
LDA #$16
|
|
STA CV ;RESTORE CURSOR AFTER HOME CALL
|
|
JMP PISSER ;<CR> TO MAKE CV WORK
|
|
ZSPOUT: RTS
|
|
|
|
NORL: ;RESTORE SCREEN TO FULL SCREEN MODE
|
|
|
|
LDA #1 ;PUT CURSOR AT TOP OF SCREEN
|
|
STA WTOP ;RESTORE FULL SCREEN ALIGNMENT
|
|
LDA #0
|
|
STA LINCNT
|
|
STA SPSTAT ;FLAG NOT SPLIT
|
|
RTS
|
|
|
|
; ------
|
|
; SCREEN
|
|
; ------
|
|
|
|
; GO TO TOP WINDOW (TOP OF SCREEN) IF [A] = 1
|
|
; GO TO BOTTOM OF SCREEN IF [A] = 0
|
|
; IGNORE IF SPLIT NOT ENABLED OR [A] <> 0 OR 1
|
|
|
|
; FLAG SPLITF WILL BE SET FOR OUTPUT TO DETERMINE
|
|
; IF AND WHICH WINDOW TO DISPLAY TO
|
|
; (0=BOTTOM 1=TOP)
|
|
|
|
|
|
ZSCRN: LDA ZBEGIN+ZMODE
|
|
AND #%00100000 ;CHECK IF ENABLED
|
|
BEQ ZSPOUT ;NOT, LEAVE
|
|
|
|
LDA SPSTAT ;CHECK IF SCREEN IS SPLIT
|
|
BEQ ZSPOUT ;NO, SO JUST LEAVE
|
|
LDA ARG1+LO ;CHECK WHICH WINDOW
|
|
BNE SCRN1 ;TOP SCREEN
|
|
|
|
STA SPLITF ;SET FLAG TO SPLIT SCREEN (0)
|
|
LDA #01 ;PUT CURSOR AT BOTTOM OF SCREEN
|
|
STA CH
|
|
STA EH
|
|
LDA #$16
|
|
STA CV
|
|
BNE SCRNP ;JMP TO <CR> RTN
|
|
SCRN1: CMP #01
|
|
BNE ZSPOUT ;INVALID SCREEN ID
|
|
STA SPLITF ;SET FLAG TO UNSCROLLING SCREEN (1)
|
|
|
|
LDA #0
|
|
STA CH
|
|
STA EH
|
|
STA CV ;ALIGN AT TOP OF SCREEN
|
|
SCRNP: JMP PISSER ;CALL <CR> RTN TO SET CURSOR (+ LEAVE)
|
|
|
|
|
|
; ---------
|
|
; RAZZ USER
|
|
; ---------
|
|
|
|
BOOP EQU BELL ;MONITOR BELL
|
|
|
|
; ------------
|
|
; CLEAR SCREEN
|
|
; ------------
|
|
|
|
CLS EQU HOME ;CLEAR & HOME CURSOR
|
|
|
|
PISSER: LDA COL80 ;SEND APPROPRIATE <RET> TO SCREEN
|
|
BEQ PISS ;IF = 0 THEN 40 COL.
|
|
LDA #$0D
|
|
BNE PIS ;JMP
|
|
PISS LDA #$8D
|
|
PIS JMP MCOUT
|
|
|
|
END
|
|
|