Apple-1-SW/apple1-worple
1
0
Fork 0
mirror of https://github.com/JeffJetton/apple1-worple.git synced 2025-03-17 02:29:34 +00:00
Code Issues Packages Projects Releases Wiki Activity
apple1-worple/worple.asm
Jeff Jetton 8f4e597db5 Initial commit
2022-05-14 10:48:07 -05:00

404 lines
15 KiB
NASM
Raw Permalink Blame History

;-----------------------------------------------------------------------------
;
; "Worple" -- A Wordle-Style Game for the Apple I
;
; Jeff Jetton (inspired by a Javascript game by Josh Wardle)
; Feb/Mar 2022
;
; Written for the dasm assembler, but should work with tweaks for others
;
;-----------------------------------------------------------------------------
processor 6502
; Constants -----------------------------------------------------------------
KBD equ $D010 ; Location of input character from keyboard
KBDCR equ $D011 ; Keyboard control: Indicator that a new input
; character is ready
ECHO equ $FFEF ; WozMon routine to display register A char
WOZMON equ $FF1F ; Entry point back to WozMonitor
NULL equ $00 ; String terminator
CR equ $0D ; Carriage return ASCII value
ESC equ $1B ; Escape key ASCII value
BACKSP equ '_ ; Yup. This is what the backspace key generates.
MAXGUES equ '6 ; Guesses are tracked as ASCII numbers, not ints!
BUFFER equ $0200 ; Text buffer for user input
; Zero-page variables -------------------------------------------------------
seg.u VARS
org $0000
APACK ds 4 ; Workspace for packed version of answer
HINTWK ds 5 ; Workspace for building hint string--starts as copy of ANSWER
RAND ds 2 ; Pointer to a word in the list, constantly cycled in the
; key-polling routine to "randomly" pick one each game
COUNTER ds 1 ; Zero-page counter to use when X & Y are occupied in EVALUATE
TXTPTR ds 2 ; Two-byte pointer to char in a text string. Used by PRINT
; Main program --------------------------------------------------------------
seg CODE
org $0300
; Init the program
cli ; No interrupts (just to be safe)
cld ; BCD mode off
jsr INITRND ; Set RAND pointer to beginning of word list
; Show welcome message and ask if user wants instructions
jsr PRINT
dc CR
dc "WORPLE!"
dc CR
dc CR
dc "INSTRUCTIONS (Y/N)? "
dc NULL
jsr GETLINE ; Ask user for a string in input text
lda BUFFER ; Put first character of that string in A
cmp #'Y ; Is it Y?
beq INSTR ; Yes, show instructions
jmp NEWGAME ; Too far for a branch :-(
INSTR jsr PRINT
dc "YOU HAVE SIX TURNS TO GUESS MY 5-LETTER"
dc CR
dc "WORD. I'LL GIVE YOU HINTS AFTER EACH:"
dc CR
dc CR
dc " * = LETTER IN CORRECT PLACE"
dc CR
dc " ? = RIGHT LETTER, WRONG PLACE"
dc CR
dc " - = NOT IN WORD"
dc CR
dc NULL
NEWGAME jsr PRINT
dc CR
dc NULL
lda #'0 ; Init GNUM (guess number) to ASCII "0"
sta GNUM ; We store this directly in the prompt text
; jsr INITRND ; Uncomment to debug (always pick 1st word)
jsr UNPACK ; Unpack into ANSWER whatever RAND now points to
NXTTURN inc GNUM ; Next guess number
PROMPT jsr PRINT ; Display prompt...
dc "GUESS #"
GNUM dc 'N ; Current guess # is embedded here
dc ": "
dc NULL
jsr GETLINE ; Get player guess
cpx #5 ; User typed exactly five chars + CR?
beq EVALUAT ; Yes
cpx #0 ; No chars?
beq PROMPT ; Yes, just redo prompt without err msg
jsr PRINT ; Display error message amd try again
dc " ENTER 5 LETTERS"
dc CR
dc NULL
jmp PROMPT
EVALUAT SUBROUTINE ; Build hint string. The workspace keeps track
; of which letters in the ANSWER we've matched
; to already, in some way or another.
lda #0
sta COUNTER ; Track number of matches in COUNTER
ldx #4
.exalp lda ANSWER,X
cmp BUFFER,X ; Exact match to guess at this position?
beq .match ; Yes
sta HINTWK,X ; Store the answer letter in HINTWK workspace
lda #'- ; for possible inexact matching later
sta HINT,X ; Store "-" in HINT for now
bne .nxtltr ; Always taken
.match lda #'* ; Put "*" in both HINT (for display) and HINTWK
sta HINT,X ; (so the letter is out of the running for
sta HINTWK,X ; the inexact match check below)
inc COUNTER
.nxtltr dex ; Loop backwards for exact matches
bpl .exalp
ldx #0 ; Now check (looping forward) for inexact matches
.inxlp lda HINTWK,X
cmp #'* ; Have we exact-matched this letter already?
beq .nextx ; Yes, move on to next guessed letter
lda BUFFER,X ; A holds guessed letter
ldy #0
.chkltr cmp HINTWK,Y ; Does guessed letter match answer letter at Y?
beq .inxmch ; Yes, it's an inexact match
iny
cpy #5
bne .chkltr
beq .nextx
.inxmch lda #'?
sta HINT,X ; Put "?" at the guessed letter's position in HINT
sta HINTWK,Y ; and at the tested letter's position in HINTWK, so
; it won't get re-matched by a later guessed letter
.nextx inx
cpx #5
bne .inxlp
; Display the hint string
jsr PRINT
dc " "
HINT dc "-----" ; This gets overwritten by hint string at runtime
dc CR
dc NULL
; Was that a winning guess? (i.e., did we get five matches?)
lda #5
cmp COUNTER
beq WINNER
; Are we done yet?
lda GNUM ; Check current guess number
cmp #MAXGUES ; Was that the last turn?
beq LOSE ; Yup
jmp NXTTURN
LOSE jsr PRINT
dc "SORRY, THE WORD WAS "
dc '"
ANSWER dc "XXXXX" ; Overwritten by answer text at runtime
dc '"
dc NULL
jmp REPLAY
WINNER lda GNUM ; We won! Set up a response string to print...
and #%111 ; Convert ASCII GNUM "1" to "6" to values 1 to 6
asl ; Mult. by two to yield an offset from 2 to 12
tax ; Move offset to X
lda [PTRTBL-2],X ; Copy over LSB of response string
sta TXTPTR
lda [PTRTBL-1],X ; ...and the MSB
sta TXTPTR+1
jsr PRPTR ; Call print subroutine that assumes TXTPTR is set
lda #'! ; Saves one byte vs. putting the ! in each string
jsr ECHO
REPLAY jsr PRINT
dc CR
dc CR
dc "PLAY AGAIN (Y/N)? "
dc NULL
jsr GETLINE
lda BUFFER ; First character of response
cmp #'Y ; Is it Y?
bne QUIT ; No
jmp NEWGAME
QUIT jmp WOZMON ; Exit to monitor
; Subroutines ---------------------------------------------------------------
UNPACK SUBROUTINE ; Unpack the word currently pointed to by RAND
ldy #2 ; First copy the three bytes of the packed answer into
; the last three bytes of four-byte workspace APACK
.cpylp lda (RAND),Y
sta [APACK+1],Y
dey
bpl .cpylp ; Loop if not done copying
lda RAND ; Which part of the word list is RAND on (0 or 1)?
cmp #<WORDS_1 ; Subtract LSB of "1" list address from MSB of RAND
; We use cmp since we don't care about the result,
; just the carry flag (cmp sets carry automatically)
lda RAND+1 ; Subtract the MSB of "1" list from MSG of RAND
sbc #>WORDS_1 ; taking into account the carry flag from the cmp step
lda #0 ; Carry flag winds up equal to what bit 25 should be
adc #0 ; Put carry flag in A
sta APACK ; 1 if we're into "1" list, 0 if not
ldy #6 ; Shift the 25 bits of the packed word to the leftmost
.shftlp jsr ROTWKSP ; end of the four-byte (32-bit) workspace
dey
bpl .shftlp
iny ; Bump Y to zero to track ANSWER byte offset
.nxtltr lda #5 ; Each letter is encoded into five bits
sta COUNTER ; which we'll count using COUNTER
.nxtbit jsr ROTWKSP ; Rotate leftmost workspace bit into carry
rol ; Rotate that carry into A
dec COUNTER
bne .nxtbit
clc ; Letter is ready. Convert to ASCII char.
adc #$A1 ; The 5 we put in A at .nxtltr was never cleared.
; So we can't just add 65 to convert 0-25 to ASCII
; 65-90. The shifted 101 means the letters are now
; encoded as 10100000-10111001 ($A0-$B9), so we
; add $A1. Not clearing A saves two bytes :-)
sta ANSWER,Y ; Store freshly-unpacked letter in the ANSWER string
iny
cpy #5 ; Have we done all five letters?
bmi .nxtltr ; No, do next letter...
rts
ROTWKSP SUBROUTINE ; Rotates all 32 bits of APACK to the left, into carry
; Used by UNPACK above. Destroys X.
ldx #3 ; Loop uses 4 fewer bytes than unrolled version
.shflp ROL APACK,X
dex
bpl .shflp
rts
INITRND lda #<WORDS_0 ; Start RAND address at beginning of word list
sta RAND
lda #>WORDS_0
sta RAND + 1
rts
; Input handling. Similar to WozMon's GETLINE, but doesn't do a CR first
; and also cycles through RAND offsets while polling for a key press.
; Ignores non-alpha keys except for backspace, escape, and return.
; Treats backspace like an escape (cancels current input line), so the hint
; string will still line up with the guess correctly.
GETLINE SUBROUTINE ; Get user input and cycle word pointer while polling
ldx #0 ; Register X is our current buffer offset
.getkey clc ; Move RAND pointer up by three bytes
lda RAND
adc #3
sta RAND
lda RAND+1
adc #0
sta RAND+1
lda RAND ; Did we move past the end of the word list?
cmp #<WRDEND ; (See UNPACK for notes on how this weird check works)
lda RAND+1
sbc #>WRDEND
bcc .chkpia ; Carry clear = had to borrow, so not past end yet
jsr INITRND ; Otherwise, set back at beginning of list
.chkpia lda KBDCR ; Check PIA for keyboard input
bpl .getkey ; Loop if A is "positive" (bit 7 low... no key ready)
lda KBD ; Get the keyboard character
and #%01111111 ; Clear bit 7, which is always set for some reason
cmp #'[ ; Did they type something greater than Z?
bcs .notaz ; Yes -- so not A-Z, check for other commands
cmp #'A ; Less than A?
bcc .notaz ; Yes
sta BUFFER,X ; Store letter in buffer
jsr ECHO ; display it
inx ; bump up buffer pointer
bmi .reprmt ; If we overflowed the buffer, reprompt
; (Otherwise this will fall through to the bne .getkey)
.notaz cmp #CR ; Return/Enter?
beq .enter ; Yes, echo it and return without zeroing X
cmp #BACKSP ; Did they hit a backspace?
beq .reprmt ; Yes, reprompt
cmp #ESC ; What about Escape?
bne .getkey ; Nope. Ignore this key and get next one
.reprmt ldx #0 ; Set X back to zero and return (causing a re-prompt)
.enter lda #CR
jmp ECHO
; End of input line handler
; Print routines: Use PRINT to print text immediately after JSR PRINT call
; (Immediate mode). PRPTR is, in turn, called by PRINT.
; PRPTR assumes TXTPTR is already correctly set up. Call it
; directly when setting up TXTPTR in some other way. Note
; that PRPTR starts with an INC, so set TXTPTR to one less
; than the address of the string you want to print.
PRINT SUBROUTINE ; Prints any null-terminated text following its call
pla ; JSR stores the return address minus one on the stack
sta TXTPTR ; Pop it back off and put it in our text pointer
pla ; (Little end was last in!)
sta TXTPTR+1
jsr PRPTR ; Call print routine now that TXTPTR is set up
lda TXTPTR+1 ; Push current pointer onto the stack (big end first)
pha ; This will be on the NULL, i.e. address-1 of the
lda TXTPTR ; next operation after the end of the string,
pha ; which is what RTS expects to see
rts
PRPTR SUBROUTINE ; Prints null-terminated string starting from TXTPTR+1
ldx #0 ; No non-indexed indirect mode, so just keep X at zero
.nextch inc TXTPTR ; Bump up the pointer one byte
bne .readch ; If we didn't wrap, read next character
inc TXTPTR+1 ; We did wrap, so bump up the most-sig byte too
.readch lda (TXTPTR,X)
beq .done ; If we're on a NULL, stop printing
jsr ECHO ; Otherwise, display the character
jmp .nextch
.done rts
; Stored data --------------------------------------------------------------
PTRTBL ; Pointer table for the "winner" responses below
.word TXT_W1-1 ; PRPTR routine assumes we start
.word TXT_W2-1 ; by pointing to the address
.word TXT_W3-1 ; just before the string
.word TXT_W4-1 ; we really want
.word TXT_W5-1
.word TXT_W6-1
; The responses themselves, depending on guess #
TXT_W1 dc "LUCKY"
dc NULL
TXT_W2 dc "AMAZING"
dc NULL
TXT_W3 dc "WOO-HOO"
dc NULL
TXT_W4 dc "WELL DONE"
dc NULL
TXT_W5 dc "NOT BAD"
dc NULL
TXT_W6 dc "PHEW"
dc NULL
; **** Word lists **********************************************************
; Letters are coded into five-bit chunks, so 25 bits for a five-letter word.
; Ex: A = 0 (00000), P = 15 (01111), Q = 16 (10000), and Z = 25 (11001)
; To fit into three bytes (24 bits), we don't store the leftmost bit of the
; first letter. Instead it's inferred and reconstructed based on which section
; of the alphabetical list of words we're in:
; Words starting with A-P, where the unstored leftmost bit should be zero:
WORDS_0 INCBIN "words_0.bin"
; Words starting with Q-Z, where unstored leftmost bit should be one:
WORDS_1 INCBIN "words_1.bin"
WRDEND ; Symbol to let us know we've reached the end of the list
Reference in New Issue View Git Blame Copy Permalink