mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-02-09 17:51:46 +00:00
444 lines
11 KiB
NASM
444 lines
11 KiB
NASM
PAGE
|
|
STTL "--- Z-STRING HANDLERS ---"
|
|
|
|
; -----------------------
|
|
; POINT MPC TO ZSTRING IN [I], using SOFF
|
|
; -----------------------
|
|
|
|
SETSTR:
|
|
lda I+LO
|
|
sta MPCL ; save in lo part
|
|
lda I+HI
|
|
sta MPCM ; middle part
|
|
lda #0 ; clear hi part
|
|
sta MPCH ; okay, we did
|
|
asl MPCL ; *2
|
|
rol MPCM
|
|
rol MPCH
|
|
asl MPCL ; *4
|
|
rol MPCM
|
|
rol MPCH
|
|
;
|
|
; now add the offset
|
|
;
|
|
lda MPCL ; carry clear from above
|
|
adc SOFFL ; add lo part of offset
|
|
sta MPCL ; save
|
|
lda MPCM
|
|
adc SOFFM
|
|
sta MPCM
|
|
lda MPCH
|
|
adc SOFFH
|
|
sta MPCH
|
|
jmp VLDMPC ; make MPCPNT to it
|
|
|
|
|
|
ZSTEX: RTS
|
|
|
|
; -----------------------
|
|
; PRINT Z-STRING AT [MPC]
|
|
; -----------------------
|
|
PZSTR:
|
|
ldx #0
|
|
stx PSET ; ASSUME PERMANENT CHARSET
|
|
stx ZFLAG ; CLEAR BYTE FLAG
|
|
dex ; = $FF
|
|
stx TSET ; NO TEMPSET ACTIVE
|
|
PZTOP:
|
|
jsr GETZCH ; GET A Z-CHAR
|
|
bcs ZSTEX ; END OF STRING IF CARRY IS SET
|
|
sta ZCHAR ; ELSE SAVE CHAR HERE
|
|
tax ; SET FLAGS
|
|
beq BLANK ; PRINT SPACE IF CHAR = 0
|
|
cmp #4 ; IS THIS AN F-WORD?
|
|
bcc DOFREQ ; APPARENTLY SO
|
|
cmp #6 ; PERHAPS A SHIFT CODE?
|
|
bcc NEWSET ; YES, CHANGE CHARSETS
|
|
jsr GETSET ; ELSE GET CHARSET
|
|
tax ; SET FLAGS
|
|
bne SET1 ; SKIP IF NOT CHARSET #0
|
|
;
|
|
; PRINT A LOWER-CASE CHAR (CHARSET #0)
|
|
;
|
|
lda #$FA ; what to add to get offset into char table
|
|
TOASC:
|
|
sta TOASCM+1 ; modify code
|
|
lda ZCHAR ; use char as offset
|
|
clc ; make char be an index
|
|
TOASCM: adc #6 ; we just did
|
|
tax ; now use as index
|
|
lda CHARSET,X ; go get that char in charset zero
|
|
SHOVE:
|
|
jsr COUT ; SHOW THE CHAR
|
|
jmp PZTOP ; AND GRAB NEXT CHAR
|
|
;
|
|
; PRINT AN UPPER-CASE CHAR (CHARSET #1)
|
|
;
|
|
SET1:
|
|
cmp #1 ; make sure it's set #1
|
|
bne SET2 ; else must be set #2
|
|
lda #20 ; skip into Charset 1 part of table
|
|
bne TOASC ; fix just like the others
|
|
;
|
|
; PRINT FROM CHARSET #2
|
|
;
|
|
SET2:
|
|
lda ZCHAR ; retrieve the z-char
|
|
cmp #6 ; is it a special ascii char?
|
|
beq DIRECT ; yes, so do it special
|
|
lda #46 ; nothing special, just get offset
|
|
bne TOASC ; and jump
|
|
;
|
|
; DECODE A "DIRECT" ASCII CHAR
|
|
;
|
|
DIRECT:
|
|
jsr GETZCH ; FETCH NEXT Z-CHAR
|
|
asl A
|
|
asl A
|
|
asl A
|
|
asl A
|
|
asl A ; SHIFT INTO POSITION
|
|
sta ZCHAR ; AND SAVE HERE
|
|
jsr GETZCH ; GRAB YET ANOTHER Z-CHAR
|
|
ora ZCHAR ; SUPERIMPOSE THE 2ND BYTE
|
|
bne SHOVE ; AND PRINT THE RESULT
|
|
;
|
|
; PRINT A SPACE
|
|
;
|
|
BLANK:
|
|
lda #SPACE ; ASCII SPACE CHAR
|
|
bne SHOVE
|
|
|
|
; CHANGE CHARSET
|
|
|
|
NEWSET: SEC ; CONVERT THE SHIFT CODE
|
|
SBC #3 ; TO 1 OR 2
|
|
TAY
|
|
JSR GETSET ; IS MODE TEMPORARY?
|
|
BNE TOPERM ; YES, DO A PERMSHIFT
|
|
STY TSET ; ELSE JUST A TEMPSHIFT
|
|
JMP PZTOP ; AND CONTINUE
|
|
TOPERM: STY PSET ; SET PERM CHARSET
|
|
CMP PSET ; SAME AS BEFORE?
|
|
BEQ PZTOP ; YES, CONTINUE
|
|
LDA #0
|
|
STA PSET ; ELSE RESET CHARSET
|
|
BEQ PZTOP ; BEFORE LOOPING BACK
|
|
|
|
; PRINT AN F-WORD
|
|
|
|
DOFREQ: SEC
|
|
SBC #1 ; ZERO-ALIGN THE CODE
|
|
ASL A ; AND MULTIPLY TIMES 64
|
|
ASL A ; TO OBTAIN THE SEGMENT OFFSET
|
|
ASL A ; INTO THE F-WORDS TABLE
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
STA OFFSET ; SAVE OFFSET FOR LATER
|
|
JSR GETZCH ; NOW GET THE F-WORD POINTER
|
|
ASL A ; WORD-ALIGN IT
|
|
CLC ; AND
|
|
ADC OFFSET ; ADD THE SEGMENT OFFSET
|
|
;
|
|
; set up FPC to point to FWORDS table
|
|
;
|
|
ldx FWORDS+ABANK
|
|
stx FPCBNK
|
|
ldx FWORDS+HI
|
|
stx FPCH
|
|
ldx FWORDS+LO
|
|
stx FPCL
|
|
jsr ADDFPC ; add offset of the F-word
|
|
jsr FETCHB ; and get MSB of F-word
|
|
sta I+HI ; and save it
|
|
jsr NEXTFPC ; and point to LSB
|
|
jsr FETCHB ; and get it
|
|
sta I+LO ; and save it
|
|
;
|
|
; SAVE THE STATE OF CURRENT Z-STRING
|
|
;
|
|
LDA MPCH
|
|
PHA
|
|
LDA MPCM
|
|
PHA
|
|
LDA MPCL
|
|
PHA
|
|
LDA PSET
|
|
PHA
|
|
LDA ZFLAG
|
|
PHA
|
|
LDA ZWORD+HI
|
|
PHA
|
|
LDA ZWORD+LO
|
|
PHA
|
|
JSR SETFWD ; PRINT THE Z-STRING
|
|
JSR PZSTR ; IN [I]
|
|
;
|
|
; RESTORE OLD Z-STRING
|
|
;
|
|
PLA
|
|
STA ZWORD+LO
|
|
PLA
|
|
STA ZWORD+HI
|
|
PLA
|
|
STA ZFLAG
|
|
PLA
|
|
STA PSET
|
|
PLA
|
|
STA MPCL
|
|
PLA
|
|
STA MPCM
|
|
PLA
|
|
STA MPCH
|
|
LDX #$FF
|
|
STX TSET ; DISABLE TEMP CHARSET
|
|
JSR VLDMPC
|
|
JMP PZTOP ; CONTINUE INNOCENTLY
|
|
|
|
|
|
; ----------------------
|
|
; RETURN CURRENT CHARSET
|
|
; ----------------------
|
|
|
|
GETSET: LDA TSET
|
|
BPL GS
|
|
LDA PSET
|
|
RTS
|
|
GS: LDY #$FF
|
|
STY TSET
|
|
RTS
|
|
|
|
|
|
; -------------------------
|
|
; POINT [I] AT FWORD STRING
|
|
; -------------------------
|
|
|
|
SETFWD: LDA I+LO ; WORD-ALIGN THE ADDRESS
|
|
ASL A
|
|
STA MPCL
|
|
LDA I+HI
|
|
ROL A
|
|
STA MPCM
|
|
LDA #0
|
|
ROL A
|
|
STA MPCH
|
|
JMP VLDMPC
|
|
|
|
|
|
; -----------------
|
|
; FETCH NEXT Z-CHAR
|
|
; -----------------
|
|
|
|
GETZCH: LDA ZFLAG ; WHICH BYTE IS THIS?
|
|
BPL GTZ0 ; $FF = LAST
|
|
SEC ; SET CARRY TO INDICATE
|
|
RTS ; NO MORE CHARS
|
|
GTZ0: BNE GETZ1 ; NOT FIRST CHAR, EITHER
|
|
|
|
; GET A Z-WORD INTO [ZWORD], RETURN 1ST CHAR IN TRIPLET
|
|
|
|
INC ZFLAG ; UPDATE CHAR COUNT
|
|
JSR GETBYT ; GET TRIPLET AT [MPC]
|
|
STA ZWORD+HI ; INTO [ZWORD]
|
|
JSR GETBYT
|
|
STA ZWORD+LO
|
|
LDA ZWORD+HI
|
|
LSR A
|
|
LSR A ; SHIFT 1ST CHAR INTO PLACE
|
|
JMP GTEXIT ; AND RETURN IT
|
|
GETZ1: SEC
|
|
SBC #1
|
|
BNE GETZ2 ; LAST CHAR IN TRIPLET IF ZERO
|
|
LDA #2 ; ELSE
|
|
STA ZFLAG ; RESET CHAR INDEX
|
|
LDA ZWORD+LO ; GET BOTTOM HALF OF TRIPLET
|
|
STA I+LO ; MOVE HERE FOR SHIFTING
|
|
LDA ZWORD+HI ; GET TOP HALF
|
|
ASL I+LO ; SHIFT THE TOP 3 BITS OF LOWER HALF
|
|
ROL A ; INTO THE BOTTOM OF THE TOP HALF
|
|
ASL I+LO
|
|
ROL A
|
|
ASL I+LO
|
|
ROL A
|
|
JMP GTEXIT
|
|
GETZ2: LDA #0 ; SET FLAG TO INDICATE
|
|
STA ZFLAG ; END OF TRIPLET
|
|
LDA ZWORD+HI ; TEST TOP HALF OF TRIPLET
|
|
BPL GETZ3 ; CONTINUE IF NOT END OF STRING
|
|
LDA #$FF ; ELSE
|
|
STA ZFLAG ; INDICATE LAST TRIPLET IN STRING
|
|
GETZ3: LDA ZWORD+LO ; GET BOTTOM HALF OF TRIPLET
|
|
GTEXIT: AND #%00011111 ; MASK OUT GARBAGE BITS
|
|
CLC
|
|
RTS
|
|
|
|
|
|
; ---------------------------------
|
|
; CONVERT [IN] TO Z-STRING IN [OUT]
|
|
; ---------------------------------
|
|
CONZST:
|
|
lda #5 ; FILL OUTPUT BUFFER
|
|
ldx #8 ; WITH PAD CHARS ($05)
|
|
CZSL:
|
|
sta OUT,X
|
|
dex
|
|
bpl CZSL
|
|
|
|
lda #9 ; INIT
|
|
sta CONCNT ; CHAR COUNT
|
|
lda #0 ; CLEAR
|
|
sta CONIN ; SOURCE AND
|
|
sta CONOUT ; OUTPUT INDEXES
|
|
CONTOP:
|
|
ldx CONIN ; fetch source index
|
|
inc CONIN ; and update
|
|
lda IN,X ; grab an ascii char
|
|
sta ZCHAR ; save it here
|
|
bne NEXTZ ; continue if char was nz
|
|
lda #5 ; else ship out
|
|
bne CSHIP1 ; a pad char
|
|
NEXTZ:
|
|
jsr FINDCHAR ; find out where it tis
|
|
beq CSHIP ; no shift for charset zero
|
|
clc ; else do a temp-shift
|
|
adc #3 ; 4 = charset 1, 5 = charset 2
|
|
jsr CSTASH ; save the char in outbuf
|
|
cmp #5 ; charset 2?
|
|
bne CSHIP ; nope
|
|
cpx #6 ; ascii escape?
|
|
bne CSHIP ; nope
|
|
;
|
|
; Handle special Ascii escape sequence
|
|
;
|
|
txa ; get ASCII alert char (#6)
|
|
jsr CSTASH ; shove it away
|
|
;
|
|
; do 1st half of "direct"
|
|
;
|
|
lda ZCHAR ; re-fetch char
|
|
lsr A ; get upper 2 bits in lower 2 bits
|
|
lsr A
|
|
lsr A
|
|
lsr A
|
|
lsr A
|
|
jsr CSTASH
|
|
;
|
|
; SEND 2ND HALF OF "DIRECT"
|
|
;
|
|
lda ZCHAR ; get char yet again
|
|
and #%00011111 ; and get lower 5 bits
|
|
tax ; this is where it is expected
|
|
;
|
|
; SHIP Z-CHAR TO OUTPUT BUFFER
|
|
;
|
|
CSHIP:
|
|
txa ; get char
|
|
CSHIP1:
|
|
jsr CSTASH ; put char away
|
|
bne CONTOP ; do again
|
|
;
|
|
; FINDCHAR - look through the charset table for the character. If found,
|
|
; figger out which shift it is. If not found, return charset 2,
|
|
; character #6.
|
|
; Enter:
|
|
; [A] = Char we are looking for
|
|
; Returns:
|
|
; [A] = Charset (0-2)
|
|
; [X] = Character # (6-31)
|
|
;
|
|
FINDCHAR:
|
|
ldx #0 ; start at first char, first set
|
|
ldy #78 ; there are 78 characters
|
|
FNDCL:
|
|
cmp CHARSET,X ; found it?
|
|
beq FNDCLX ; yes
|
|
inx ; next char
|
|
dey ; count char
|
|
bne FNDCL ; go check next char
|
|
;
|
|
; not found in table, use ASCII escape sequence
|
|
;
|
|
lda #2 ; escape sequence is char set 2
|
|
ldx #6 ; character 6
|
|
rts ; and done
|
|
FNDCLX:
|
|
txa ; put here for compares/action
|
|
ldy #0 ; this is char set 0
|
|
ldx #$FA ; what to "subtract" to get +6
|
|
cmp #26 ; how we doin'?
|
|
bcc FNDCHX ; all done
|
|
iny ; char set 1
|
|
ldx #20 ; char set 1 offset
|
|
cmp #52 ; well?
|
|
bcc FNDCHX ; must be char set 1
|
|
ldx #46 ; for char set 2 setting up
|
|
iny ; must be char set 2 then
|
|
FNDCHX:
|
|
stx FNDCHM+1 ; what to subtract to get offset
|
|
sec ; doing subtract
|
|
FNDCHM: sbc #6 ; make good offset
|
|
tax ; put here for return
|
|
tya ; and here to set flag
|
|
rts
|
|
;
|
|
; CSTASH - put the char in OUT. If we run out of room don't return, just
|
|
; jump to ZCRUSH as final destination
|
|
; [A] - char to be put away
|
|
;
|
|
CSTASH:
|
|
ldy CONOUT ; fetch output index
|
|
sta OUT,Y ; send the shift char
|
|
inc CONOUT ; update index
|
|
dec CONCNT ; and char count
|
|
bne CSTX ; plenty more room
|
|
pla ; get rid of return spot
|
|
pla ; fine
|
|
jmp ZCRUSH ; if out of room, crush 'em!
|
|
CSTX:
|
|
rts
|
|
; ----------------------
|
|
; CRUSH Z-CHARS IN [OUT], mushing them into small 5 bit pieces
|
|
; ----------------------
|
|
ZCRUSH:
|
|
LDA OUT+1 ; GET 2ND Z-CHAR
|
|
ASL A ; SHIFT BITS INTO POSITION
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
ROL OUT ; ALONG WITH 1ST Z-CHAR
|
|
ASL A
|
|
ROL OUT
|
|
ORA OUT+2 ; SUPERIMPOSE 3RD Z-CHAR
|
|
STA OUT+1
|
|
LDA OUT+4 ; GET 5TH Z-CHAR
|
|
ASL A ; SHIFT BITS
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
ROL OUT+3 ; ALONG WITH 4TH Z-CHAR
|
|
ASL A
|
|
ROL OUT+3
|
|
ORA OUT+5 ; SUPERIMPOSE 6TH Z-CHAR
|
|
TAX ; SAVE HERE
|
|
LDA OUT+3 ; GRAB 4TH Z-CHAR
|
|
STA OUT+2 ; MOVE CRUSHED Z-WORD
|
|
STX OUT+3 ; INTO PLACE
|
|
LDA OUT+7 ; GET 8TH Z-CHAR (EZIP)
|
|
ASL A ; SHIFT BITS
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
ROL OUT+6 ; ALONG WITH 7TH Z-CHAR
|
|
ASL A
|
|
ROL OUT+6
|
|
ORA OUT+8 ; SUPERIMPOSE 9TH Z-CHAR
|
|
STA OUT+5 ; SAVE HERE
|
|
LDA OUT+6 ; GRAB 7TH Z-CHAR
|
|
ORA #%10000000 ; SET HIGH BIT
|
|
STA OUT+4 ; MOVE CRUSHED Z-WORD INTO PLACE
|
|
RTS
|
|
|
|
END
|
|
|