This little text action RPG is a labour of love for me. I first imagined the concept for this game while I was revising uwu.lisp, which, as you may not know, is a very simple Unicode tamagotchi clone for Common Lisp.
The idea is fairly simple: you have a “world of bags”, as one might put it. That is, you move into and out of bags which have portals inside them, linking them to other one-dimensional planes of existence.
How To Install
Type in by hand. Approximately ~250 lines of code.
Obtain bagquest.prg, and run in VICE emulator:
$ x64 bagquest.prg
The Premise Of The Bag Quest
Okay so you have decided to keep reading…
A screenshot of BAGQUEST.BAS running in VICE Commodore 64 emulator.
The premise of the game is simple enough:
Out laid before you are forty (40) tiles.
You are the @ symbol, and you can move left or right.
There is no tangible objective to the game, other than to have fun.
The following are the current total number of objects in the game, and their symbolic character representations:
player character – @
a bag entry – B
a bag exit – X
a key for a locked door – K
a greedy lil goblin – G
a (locked) door – D
a pile of treasure loot – L
a magic wand – W
a treasure map – M
Bags; Various and Sundry, Purposes Unknown?
Place a bag entry by pressing the B key on your computer. Then, to enter the bag, move onto its tile.
In order to move back out of that bag, move onto the X tile you find in the bag you have just entered.
Goblins, G, and doors, D, are both obstacles to the player. In order to move past their tile, you will need to bribe goblins with loot L, and unlock doors with keys K. Both of these items can be found littered within the bags you discover.
Added to this are magic wands W and treasure maps M.
Wands will whisk players away to a random empty tile within a randomly selected bag.
Treasure maps, however, allow players the choice of bag they wish to enter–at the added risk that they will not know onto which tile within the bag they will end up!
A Word To The Wizards
The data structures for the game are as simple as I could possibly make them, which limits the total number of bags one may possess to ten (10), but it should not be difficult to modify the code further to increase the total number of bags, and their attendant sizes, with a little exploration from the user, if they were to take the initiative.
A world of bags may be modeled thus:
130 DIM W(40,10):REM WORLD ARRAY
140 DIM B(10):REM BAG PARENT CONNECTION
150 DIM BX(10):REM BAG ENTRY POSITIONS
160 DIM BY(10):REM BAG EXIT POSITIONS
170 CURRENTBAG = 1:REM START IN BAG 1 (MAIN WORLD)
180 P = INT(RND(1)*40)+1:REM PLAYER POSITION ON INIT
190 HAVEBAG=10:REM START WITH 10 BAGS (??)
Each full-stop in the printed array W is a one-dimensional position in a line which the user may inhabit one-at-a-time.
;***********************************************************************
;
; Kim-1 MicroChess (c) 1976-2005 Peter Jennings, www.benlo.com
;
;***********************************************************************
; All rights reserved.
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions
; are met:
; 1. Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
; 2. Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following disclaimer in the
; documentation and/or other materials provided with the distribution.
; 3. The name of the author may not be used to endorse or promote products
; derived from this software without specific prior written permission.
; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ''AS IS'' AND ANY EXPRESS OR
; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;
; modified by Daryl Rictor to work over a
; serial terminal connection, August 2002.
;
; Updated with corrections to earlier OCR errors by Bill Forster, August 2005.
;
cpu 65c02
page 0,132
;
; 6551 I/O Port Addresses
;
ACIADat = $7F70
ACIASta = $7F71
ACIACmd = $7F72
ACIACtl = $7F73
;
; page zero variables
;
BOARD = $50
BK = $60
PIECE = $B0
SQUARE = $B1
SP2 = $B2
SP1 = $B3
INCHEK = $B4
STATE = $B5
MOVEN = $B6
REV = $B7
OMOVE = $DC
WCAP0 = $DD
COUNT = $DE
BCAP2 = $DE
WCAP2 = $DF
BCAP1 = $E0
WCAP1 = $E1
BCAP0 = $E2
MOB = $E3
MAXC = $E4
CC = $E5
PCAP = $E6
BMOB = $E3
BMAXC = $E4
BMCC = $E5 ; was BCC (TASS doesn't like it as a label)
BMAXP = $E6
XMAXC = $E8
WMOB = $EB
WMAXC = $EC
WCC = $ED
WMAXP = $EE
PMOB = $EF
PMAXC = $F0
PCC = $F1
PCP = $F2
OLDKY = $F3
BESTP = $FB
BESTV = $FA
BESTM = $F9
DIS1 = $FB
DIS2 = $FA
DIS3 = $F9
temp = $FC
;
;
;
*=$1000 ; load into RAM @ $1000-$15FF
LDA #$00 ; REVERSE TOGGLE
STA REV
JSR Init_6551
CHESS CLD ; INITIALIZE
LDX #$FF ; TWO STACKS
TXS
LDX #$C8
STX SP2
;
; ROUTINES TO LIGHT LED
; DISPLAY AND GET KEY
; FROM KEYBOARD
;
OUT JSR pout ; DISPLAY AND
JSR KIN ; GET INPUT *** my routine waits for a keypress
; CMP OLDKY ; KEY IN ACC *** no need to debounce
; BEQ OUT ; (DEBOUNCE)
; STA OLDKY
;
CMP #$43 ; [C]
BNE NOSET ; SET UP
LDX #$1F ; BOARD
WHSET LDA SETW,X ; FROM
STA BOARD,X ; SETW
DEX
BPL WHSET
LDX #$1B ; *ADDED
STX OMOVE ; INITS TO $FF
LDA #$CC ; Display CCC
BNE CLDSP
;
NOSET CMP #$45 ; [E]
BNE NOREV ; REVERSE
JSR REVERSE ; BOARD IS
SEC
LDA #$01
SBC REV
STA REV ; TOGGLE REV FLAG
LDA #$EE ; IS
BNE CLDSP
;
NOREV CMP #$40 ; [P]
BNE NOGO ; PLAY CHESS
JSR GO
CLDSP STA DIS1 ; DISPLAY
STA DIS2 ; ACROSS
STA DIS3 ; DISPLAY
BNE CHESS
;
NOGO CMP #$0D ; [Enter]
BNE NOMV ; MOVE MAN
JSR MOVE ; AS ENTERED
JMP DISP
NOMV CMP #$41 ; [Q] ***Added to allow game exit***
BEQ DONE ; quit the game, exit back to system.
JMP INPUT ; process move
DONE JMP $FF00 ; *** MUST set this to YOUR OS starting address
;
; THE ROUTINE JANUS DIRECTS THE
; ANALYSIS BY DETERMINING WHAT
; SHOULD OCCUR AFTER EACH MOVE
; GENERATED BY GNM
;
;
;
JANUS LDX STATE
BMI NOCOUNT
;
; THIS ROUTINE COUNTS OCCURRENCES
; IT DEPENDS UPON STATE TO INDEX
; THE CORRECT COUNTERS
;
COUNTS LDA PIECE
BEQ OVER ; IF STATE=8
CPX #$08 ; DO NOT COUNT
BNE OVER ; BLK MAX CAP
CMP BMAXP ; MOVES FOR
BEQ XRT ; WHITE
;
OVER INC MOB,X ; MOBILITY
CMP #$01 ; + QUEEN
BNE NOQ ; FOR TWO
INC MOB,X
;
NOQ BVC NOCAP
LDY #$0F ; CALCULATE
LDA SQUARE ; POINTS
ELOOP CMP BK,Y ; CAPTURED
BEQ FOUN ; BY THIS
DEY ; MOVE
BPL ELOOP
FOUN LDA POINTS,Y
CMP MAXC,X
BCC LESS ; SAVE IF
STY PCAP,X ; BEST THIS
STA MAXC,X ; STATE
;
LESS CLC
PHP ; ADD TO
ADC CC,X ; CAPTURE
STA CC,X ; COUNTS
PLP
;
NOCAP CPX #$04
BEQ ON4
BMI TREE ;(=00 ONLY)
XRT RTS
;
; GENERATE FURTHER MOVES FOR COUNT
; AND ANALYSIS
;
ON4 LDA XMAXC ; SAVE ACTUAL
STA WCAP0 ; CAPTURE
LDA #$00 ; STATE=0
STA STATE
JSR MOVE ; GENERATE
JSR REVERSE ; IMMEDIATE
JSR GNMZ ; REPLY MOVES
JSR REVERSE
;
LDA #$08 ; STATE=8
STA STATE ; GENERATE
JSR GNM ; CONTINUATION
JSR UMOVE ; MOVES
;
JMP STRATGY ; FINAL EVALUATION
NOCOUNT CPX #$F9
BNE TREE
;
; DETERMINE IF THE KING CAN BE
; TAKEN, USED BY CHKCHK
;
LDA BK ; IS KING
CMP SQUARE ; IN CHECK?
BNE RETJ ; SET INCHEK=0
LDA #$00 ; IF IT IS
STA INCHEK
RETJ RTS
;
; IF A PIECE HAS BEEN CAPTURED BY
; A TRIAL MOVE, GENERATE REPLIES &
; EVALUATE THE EXCHANGE GAIN/LOSS
;
TREE BVC RETJ ; NO CAP
LDY #$07 ; (PIECES)
LDA SQUARE
LOOPX CMP BK,Y
BEQ FOUNX
DEY
BEQ RETJ ; (KING)
BPL LOOPX ; SAVE
FOUNX LDA POINTS,Y ; BEST CAP
CMP BCAP0,X ; AT THIS
BCC NOMAX ; LEVEL
STA BCAP0,X
NOMAX DEC STATE
LDA #$FB ; IF STATE=FB
CMP STATE ; TIME TO TURN
BEQ UPTREE ; AROUND
JSR GENRM ; GENERATE FURTHER
UPTREE INC STATE ; CAPTURES
RTS
;
; THE PLAYER'S MOVE IS INPUT
;
INPUT CMP #$08 ; NOT A LEGAL
BCS ERROR ; SQUARE #
JSR DISMV
DISP LDX #$1F
SEARCH LDA BOARD,X
CMP DIS2
BEQ HERE ; DISPLAY
DEX ; PIECE AT
BPL SEARCH ; FROM
HERE STX DIS1 ; SQUARE
STX PIECE
ERROR JMP CHESS
;
; GENERATE ALL MOVES FOR ONE
; SIDE, CALL JANUS AFTER EACH
; ONE FOR NEXT STEP
;
;
GNMZ LDX #$10 ; CLEAR
GNMX LDA #$00 ; COUNTERS
CLEAR STA COUNT,X
DEX
BPL CLEAR
;
GNM LDA #$10 ; SET UP
STA PIECE ; PIECE
NEWP DEC PIECE ; NEW PIECE
BPL NEX ; ALL DONE?
RTS ; -YES
;
NEX JSR RESET ; READY
LDY PIECE ; GET PIECE
LDX #$08
STX MOVEN ; COMMON START
CPY #$08 ; WHAT IS IT?
BPL PAWN ; PAWN
CPY #$06
BPL KNIGHT ; KNIGHT
CPY #$04
BPL BISHOP ; BISHOP
CPY #$01
BEQ QUEEN ; QUEEN
BPL ROOK ; ROOK
;
KING JSR SNGMV ; MUST BE KING!
BNE KING ; MOVES
BEQ NEWP ; 8 TO 1
QUEEN JSR LINE
BNE QUEEN ; MOVES
BEQ NEWP ; 8 TO 1
;
ROOK LDX #$04
STX MOVEN ; MOVES
AGNR JSR LINE ; 4 TO 1
BNE AGNR
BEQ NEWP
;
BISHOP JSR LINE
LDA MOVEN ; MOVES
CMP #$04 ; 8 TO 5
BNE BISHOP
BEQ NEWP
;
KNIGHT LDX #$10
STX MOVEN ; MOVES
AGNN JSR SNGMV ; 16 TO 9
LDA MOVEN
CMP #$08
BNE AGNN
BEQ NEWP
;
PAWN LDX #$06
STX MOVEN
P1 JSR CMOVE ; RIGHT CAP?
BVC P2
BMI P2
JSR JANUS ; YES
P2 JSR RESET
DEC MOVEN ; LEFT CAP?
LDA MOVEN
CMP #$05
BEQ P1
P3 JSR CMOVE ; AHEAD
BVS NEWP ; ILLEGAL
BMI NEWP
JSR JANUS
LDA SQUARE ; GETS TO
AND #$F0 ; 3RD RANK?
CMP #$20
BEQ P3 ; DO DOUBLE
JMP NEWP
;
; CALCULATE SINGLE STEP MOVES
; FOR K,N
;
SNGMV JSR CMOVE ; CALC MOVE
BMI ILL1 ; -IF LEGAL
JSR JANUS ; -EVALUATE
ILL1 JSR RESET
DEC MOVEN
RTS
;
; CALCULATE ALL MOVES DOWN A
; STRAIGHT LINE FOR Q,B,R
;
LINE JSR CMOVE ; CALC MOVE
BCC OVL ; NO CHK
BVC LINE ; NOCAP
OVL BMI ILL ; RETURN
PHP
JSR JANUS ; EVALUATE POSN
PLP
BVC LINE ; NOT A CAP
ILL JSR RESET ; LINE STOPPED
DEC MOVEN ; NEXT DIR
RTS
;
; EXCHANGE SIDES FOR REPLY
; ANALYSIS
;
REVERSE LDX #$0F
ETC SEC
LDY BK,X ; SUBTRACT
LDA #$77 ; POSITION
SBC BOARD,X ; FROM 77
STA BK,X
STY BOARD,X ; AND
SEC
LDA #$77 ; EXCHANGE
SBC BOARD,X ; PIECES
STA BOARD,X
DEX
BPL ETC
RTS
;
; CMOVE CALCULATES THE TO SQUARE
; USING SQUARE AND THE MOVE
; TABLE, FLAGS SET AS FOLLOWS:
; N - ILLEGAL MOVE
; V - CAPTURE (LEGAL UNLESS IN CH)
; C - ILLEGAL BECAUSE OF CHECK
; [MY THANKS TO JIM BUTTERFIELD
; WHO WROTE THIS MORE EFFICIENT
; VERSION OF CMOVE]
;
CMOVE LDA SQUARE ; GET SQUARE
LDX MOVEN ; MOVE POINTER
CLC
ADC MOVEX,X ; MOVE LIST
STA SQUARE ; NEW POS'N
AND #$88
BNE ILLEGAL ; OFF BOARD
LDA SQUARE
;
LDX #$20
LOOP DEX ; IS TO
BMI NO ; SQUARE
CMP BOARD,X ; OCCUPIED?
BNE LOOP
;
CPX #$10 ; BY SELF?
BMI ILLEGAL
;
LDA #$7F ; MUST BE CAP!
ADC #$01 ; SET V FLAG
BVS SPX ; (JMP)
;
NO CLV ; NO CAPTURE
;
SPX LDA STATE ; SHOULD WE
BMI RETL ; DO THE
CMP #$08 ; CHECK CHECK?
BPL RETL
;
; CHKCHK REVERSES SIDES
; AND LOOKS FOR A KING
; CAPTURE TO INDICATE
; ILLEGAL MOVE BECAUSE OF
; CHECK SINCE THIS IS
; TIME CONSUMING, IT IS NOT
; ALWAYS DONE
;
CHKCHK PHA ; STATE
PHP
LDA #$F9
STA STATE ; GENERATE
STA INCHEK ; ALL REPLY
JSR MOVE ; MOVES TO
JSR REVERSE ; SEE IF KING
JSR GNM ; IS IN
JSR RUM ; CHECK
PLP
PLA
STA STATE
LDA INCHEK
BMI RETL ; NO - SAFE
SEC ; YES - IN CHK
LDA #$FF
RTS
;
RETL CLC ; LEGAL
LDA #$00 ; RETURN
RTS
;
ILLEGAL LDA #$FF
CLC ; ILLEGAL
CLV ; RETURN
RTS
;
; REPLACE PIECE ON CORRECT SQUARE
;
RESET LDX PIECE ; GET LOGAT
LDA BOARD,X ; FOR PIECE
STA SQUARE ; FROM BOARD
RTS
;
;
;
GENRM JSR MOVE ; MAKE MOVE
GENR2 JSR REVERSE ; REVERSE BOARD
JSR GNM ; GENERATE MOVES
RUM JSR REVERSE ; REVERSE BACK
;
; ROUTINE TO UNMAKE A MOVE MADE BY
; MOVE
;
UMOVE TSX ; UNMAKE MOVE
STX SP1
LDX SP2 ; EXCHANGE
TXS ; STACKS
PLA ; MOVEN
STA MOVEN
PLA ; CAPTURED
STA PIECE ; PIECE
TAX
PLA ; FROM SQUARE
STA BOARD,X
PLA ; PIECE
TAX
PLA ; TO SOUARE
STA SQUARE
STA BOARD,X
JMP STRV
;
; THIS ROUTINE MOVES PIECE
; TO SQUARE, PARAMETERS
; ARE SAVED IN A STACK TO UNMAKE
; THE MOVE LATER
;
MOVE TSX
STX SP1 ; SWITCH
LDX SP2 ; STACKS
TXS
LDA SQUARE
PHA ; TO SQUARE
TAY
LDX #$1F
CHECK CMP BOARD,X ; CHECK FOR
BEQ TAKE ; CAPTURE
DEX
BPL CHECK
TAKE LDA #$CC
STA BOARD,X
TXA ; CAPTURED
PHA ; PIECE
LDX PIECE
LDA BOARD,X
STY BOARD,X ; FROM
PHA ; SQUARE
TXA
PHA ; PIECE
LDA MOVEN
PHA ; MOVEN
STRV TSX
STX SP2 ; SWITCH
LDX SP1 ; STACKS
TXS ; BACK
RTS
;
; CONTINUATION OF SUB STRATGY
; -CHECKS FOR CHECK OR CHECKMATE
; AND ASSIGNS VALUE TO MOVE
;
CKMATE LDX BMAXC ; CAN BLK CAP
CPX POINTS ; MY KING?
BNE NOCHEK
LDA #$00 ; GULP!
BEQ RETV ; DUMB MOVE!
;
NOCHEK LDX BMOB ; IS BLACK
BNE RETV ; UNABLE TO
LDX WMAXP ; MOVE AND
BNE RETV ; KING IN CH?
LDA #$FF ; YES! MATE
;
RETV LDX #$04 ; RESTORE
STX STATE ; STATE=4
;
; THE VALUE OF THE MOVE (IN ACCU)
; IS COMPARED TO THE BEST MOVE AND
; REPLACES IT IF IT IS BETTER
;
PUSH CMP BESTV ; IS THIS BEST
BCC RETP ; MOVE SO FAR?
BEQ RETP
STA BESTV ; YES!
LDA PIECE ; SAVE IT
STA BESTP
LDA SQUARE
STA BESTM ; FLASH DISPLAY
RETP LDA #"." ; print ... instead of flashing disp
Jmp syschout ; print . and return
;
; MAIN PROGRAM TO PLAY CHESS
; PLAY FROM OPENING OR THINK
;
GO LDX OMOVE ; OPENING?
BMI NOOPEN ; -NO *ADD CHANGE FROM BPL
LDA DIS3 ; -YES WAS
CMP OPNING,X ; OPPONENT'S
BNE END ; MOVE OK?
DEX
LDA OPNING,X ; GET NEXT
STA DIS1 ; CANNED
DEX ; OPENING MOVE
LDA OPNING,X
STA DIS3 ; DISPLAY IT
DEX
STX OMOVE ; MOVE IT
BNE MV2 ; (JMP)
;
END LDA #$FF ; *ADD - STOP CANNED MOVES
STA OMOVE ; FLAG OPENING
NOOPEN LDX #$0C ; FINISHED
STX STATE ; STATE=C
STX BESTV ; CLEAR BESTV
LDX #$14 ; GENERATE P
JSR GNMX ; MOVES
;
LDX #$04 ; STATE=4
STX STATE ; GENERATE AND
JSR GNMZ ; TEST AVAILABLE
; MOVES
;
LDX BESTV ; GET BEST MOVE
CPX #$0F ; IF NONE
BCC MATE ; OH OH!
;
MV2 LDX BESTP ; MOVE
LDA BOARD,X ; THE
STA BESTV ; BEST
STX PIECE ; MOVE
LDA BESTM
STA SQUARE ; AND DISPLAY
JSR MOVE ; IT
JMP CHESS
;
MATE LDA #$FF ; RESIGN
RTS ; OR STALEMATE
;
; SUBROUTINE TO ENTER THE
; PLAYER'S MOVE
;
DISMV LDX #$04 ; ROTATE
DROL ASL DIS3 ; KEY
ROL DIS2 ; INTO
DEX ; DISPLAY
BNE DROL ;
ORA DIS3
STA DIS3
STA SQUARE
RTS
;
; THE FOLLOWING SUBROUTINE ASSIGNS
; A VALUE TO THE MOVE UNDER
; CONSIDERATION AND RETURNS IT IN
; THE ACCUMULATOR
;
STRATGY CLC
LDA #$80
ADC WMOB ; PARAMETERS
ADC WMAXC ; WITH WEIGHT
ADC WCC ; OF 0.25
ADC WCAP1
ADC WCAP2
SEC
SBC PMAXC
SBC PCC
SBC BCAP0
SBC BCAP1
SBC BCAP2
SBC PMOB
SBC BMOB
BCS POS ; UNDERFLOW
LDA #$00 ; PREVENTION
POS LSR
CLC ; **************
ADC #$40
ADC WMAXC ; PARAMETERS
ADC WCC ; WITH WEIGHT
SEC ; OF 0.5
SBC BMAXC
LSR ; **************
CLC
ADC #$90
ADC WCAP0 ; PARAMETERS
ADC WCAP0 ; WITH WEIGHT
ADC WCAP0 ; OF 1.0
ADC WCAP0
ADC WCAP1
SEC ; [UNDER OR OVER-
SBC BMAXC ; FLOW MAY OCCUR
SBC BMAXC ; FROM THIS
SBC BMCC ; SECTION]
SBC BMCC
SBC BCAP1
LDX SQUARE ; ***************
CPX #$33
BEQ POSN ; POSITION
CPX #$34 ; BONUS FOR
BEQ POSN ; MOVE TO
CPX #$22 ; CENTRE
BEQ POSN ; OR
CPX #$25 ; OUT OF
BEQ POSN ; BACK RANK
LDX PIECE
BEQ NOPOSN
LDY BOARD,X
CPY #$10
BPL NOPOSN
POSN CLC
ADC #$02
NOPOSN JMP CKMATE ; CONTINUE
;-----------------------------------------------------------------
; The following routines were added to allow text-based board
; display over a standard RS-232 port.
;
POUT jsr pout9 ; print CRLF
jsr pout13 ; print copyright
JSR POUT10 ; print column labels
LDY #$00 ; init board location
JSR POUT5 ; print board horz edge
POUT1 lDA #"|" ; print vert edge
JSR syschout ; PRINT ONE ASCII CHR - SPACE
LDX #$1F
POUT2 TYA ; scan the pieces for a location match
CMP BOARD,X ; match found?
BEQ POUT4 ; yes; print the piece's color and type
DEX ; no
BPL POUT2 ; if not the last piece, try again
tya ; empty square
and #$01 ; odd or even column?
sta temp ; save it
tya ; is the row odd or even
lsr ; shift column right 4 spaces
lsr ;
lsr ;
lsr ;
and #$01 ; strip LSB
clc ;
adc temp ; combine row & col to determine square color
and #$01 ; is board square white or blk?
beq pout25 ; white, print space
lda #"*" ; black, print *
db $2c ; used to skip over LDA #$20
POUT25 LDA #$20 ; ASCII space
JSR syschout ; PRINT ONE ASCII CHR - SPACE
JSR syschout ; PRINT ONE ASCII CHR - SPACE
POUT3 INY ;
TYA ; get row number
AND #$08 ; have we completed the row?
BEQ POUT1 ; no, do next column
LDA #"|" ; yes, put the right edge on
JSR syschout ; PRINT ONE ASCII CHR - |
jsr pout12 ; print row number
JSR POUT9 ; print CRLF
JSR POUT5 ; print bottom edge of board
CLC ;
TYA ;
ADC #$08 ; point y to beginning of next row
TAY ;
CPY #$80 ; was that the last row?
BEQ POUT8 ; yes, print the LED values
BNE POUT1 ; no, do new row
POUT4 LDA REV ; print piece's color & type
BEQ POUT41 ;
LDA cpl+16,X ;
BNE POUT42 ;
POUT41 LDA cpl,x ;
POUT42 JSR syschout ;
lda cph,x ;
jsr syschout ;
BNE POUT3 ; branch always
POUT5 TXA ; print "-----...-----<crlf>"
PHA
LDX #$19
LDA #"-"
POUT6 JSR syschout ; PRINT ONE ASCII CHR - "-"
DEX
BNE POUT6
PLA
TAX
JSR POUT9
RTS
POUT8 jsr pout10 ;
LDA $FB
JSR syshexout ; PRINT 1 BYTE AS 2 HEX CHRS
LDA #$20
JSR syschout ; PRINT ONE ASCII CHR - SPACE
LDA $FA
JSR syshexout ; PRINT 1 BYTE AS 2 HEX CHRS
LDA #$20
JSR syschout ; PRINT ONE ASCII CHR - SPACE
LDA $F9
JSR syshexout ; PRINT 1 BYTE AS 2 HEX CHRS
POUT9 LDA #$0D
JSR syschout ; PRINT ONE ASCII CHR - CR
LDA #$0A
JSR syschout ; PRINT ONE ASCII CHR - LF
RTS
pout10 ldx #$00 ; print the column labels
POUT11 lda #$20 ; 00 01 02 03 ... 07 <CRLF>
jsr syschout
txa
jsr syshexout
INX
CPX #$08
BNE POUT11
BEQ POUT9
POUT12 TYA
and #$70
JSR syshexout
rts
Pout13 ldx #$00 ; Print the copyright banner
Pout14 lda banner,x
beq POUT15
jsr syschout
inx
bne POUT14
POUT15 rts
KIN LDA #"?"
JSR syschout ; PRINT ONE ASCII CHR - ?
JSR syskin ; GET A KEYSTROKE FROM SYSTEM
AND #$4F ; MASK 0-7, AND ALPHA'S
RTS
;
; 6551 I/O Support Routines
;
;
Init_6551 lda #$1F ; 19.2K/8/1
sta ACIActl ; control reg
lda #$0B ; N parity/echo off/rx int off/ dtr active low
sta ACIAcmd ; command reg
rts ; done
;
; input chr from ACIA1 (waiting)
;
syskin lda ACIASta ; Serial port status
and #$08 ; is recvr full
beq syskin ; no char to get
Lda ACIAdat ; get chr
RTS ;
;
; output to OutPut Port
;
syschout PHA ; save registers
ACIA_Out1 lda ACIASta ; serial port status
and #$10 ; is tx buffer empty
beq ACIA_Out1 ; no
PLA ; get chr
sta ACIAdat ; put character to Port
RTS ; done
syshexout PHA ; prints AA hex digits
LSR ; MOVE UPPER NIBBLE TO LOWER
LSR ;
LSR ;
LSR ;
JSR PrintDig ;
PLA ;
PrintDig AND #$0F ; prints A hex nibble (low 4 bits)
PHY
TAY ;
LDA Hexdigdata,Y ;
PLY
jmp syschout ;
Hexdigdata asc "0123456789ABCDEF"
banner asc "MicroChess (c) 1996-2005 Peter Jennings, www.benlo.com"
db $0d, $0a, $00
cpl asc "WWWWWWWWWWWWWWWWBBBBBBBBBBBBBBBBWWWWWWWWWWWWWWWW"
cph asc "KQRRBBNNPPPPPPPPKQRRBBNNPPPPPPPP"
db $00
;
; end of added code
;
; BLOCK DATA
*= $1580
SETW db $03, $04, $00, $07, $02, $05, $01, $06
db $10, $17, $11, $16, $12, $15, $14, $13
db $73, $74, $70, $77, $72, $75, $71, $76
db $60, $67, $61, $66, $62, $65, $64, $63
MOVEX db $00, $F0, $FF, $01, $10, $11, $0F, $EF, $F1
db $DF, $E1, $EE, $F2, $12, $0E, $1F, $21
POINTS db $0B, $0A, $06, $06, $04, $04, $04, $04
db $02, $02, $02, $02, $02, $02, $02, $02
OPNING db $99, $25, $0B, $25, $01, $00, $33, $25
db $07, $36, $34, $0D, $34, $34, $0E, $52
db $25, $0D, $45, $35, $04, $55, $22, $06
db $43, $33, $0F, $CC
;
;
; end of file
;
10 REM ***********
20 REM * *
30 REM * Sketch *
40 REM * *
50 REM ***********
55 REM *** Instructions ***
60 CLS:PRINT:PRINT
70 PRINT TAB(12)"Instructions?"
80 PRINT:PRINT TAB(16)"(Y/N)"
90 GET A$:IF A$="" GOTO 90
100 IF A$="Y" OR A$="y" THEN GOTO 110 ELSE GOTO 270
110 CLS:PRINT:PRINT
120 PRINT TAB(2)"You may use either Sketch or Draft"
130 PRINT TAB(2)"modes. Sketch uses a moving line to"
140 PRINT TAB(2)"draw, while Draft draws lines between"
150 PRINT TAB(2)"two points you specify by hitting ";CHR$(34);"S";CHR$(34);"."
160 PRINT:PRINT TAB(1)"= Hit any key for Sketch instructions =";
170 GET A$:IF A$="" GOTO 170
180 CLS:PRINT
190 PRINT TAB(12)"== Sketch =="
200 PRINT TAB(13)"[Controls:]"
210 PRINT TAB(2)"Arrow Keys -- Change direction"
220 PRINT TAB(2)"Number keys -- Slow down cursor"
230 PRINT TAB(2)CHR$(34);"F";CHR$(34);" -- Return to top speed"
240 PRINT TAB(2)"Space Bar -- Toggle cursor (ON)-(OFF)"
250 PRINT:PRINT TAB(11)"== Hit any key =="
260 GET A$:IF A$="" GOTO 260
265 REM *** Set Delay ***
270 CLS:PRINT:PRINT
280 PRINT TAB(6)"Enter speed desired:"
290 PRINT
300 PRINT TAB(6)"[1] Fast to [9] Slow"
310 GET A$:IF A$="" GOTO 310
320 OG=VAL(A$)*10:IF OG<1 GOTO 310
330 DL=OG
335 REM *** Choose Sketch or Draw Mode ***
340 CLS:PRINT:PRINT
350 PRINT TAB(4)"Do you want:"
360 PRINT:PRINT TAB(6)"[S]ketch mode"
370 PRINT TAB(6)"[D]raft mode"
380 GET A$:IF A$="" GOTO 380
390 IF A$="S" OR A$="s" GOTO 420
400 IF A$="D" OR A$="d" GOTO 710
410 GOTO 380
420 CLS
430 REM FOR N=1 TO VAL(RIGHT$(TIME$,2))
440 REM DM=RND(1)
450 REM NEXT N
460 X=239:Y=63
470 X1=INT(RND(X)*X)+1:Y1=INT(RND(X)*Y)+1
480 COLOR 255: PLOT X1,Y1
485 REM *** Sketch Mode ***
490 GET A$
500 X1=X1+XD:IF X1>239 THEN X1=239
510 IF X1<0 THEN X1=0
520 Y1=Y1+YD:IF Y1>63 THEN Y1=63
530 IF Y1<0 THEN Y1=0
540 DELAY DL*10
550 IF FLAG<>1 GOTO 570
560 COLOR 255:PLOT X1,Y1:DELAY 100:NEXT N:COLOR 0:PLOT X1,Y1:GOTO 580
570 COLOR 255:PLOT X1,Y1
580 IF A$="" GOTO 490
590 IF VAL(A$)<1 GOTO 610
600 DL=DL*VAL(A$)
610 IF A$="F" OR A$="f" THEN DL=OG
620 A=ASC(A$)
630 IF A<>32 GOTO 650
640 IF FLAG=1 THEN FLAG=0 ELSE FLAG=1
650 IF A=4 GOTO 670
651 IF A=5 GOTO 690
652 IF A=19 GOTO 680
653 IF A=24 GOTO 700
654 GOTO 490
655 REM *** Change direction of Cursor ***
660 REM ON A-27 GOTO 670, 680, 690, 700
670 YD=0:XD=1:GOTO 490 REM RIGHT
680 YD=0:XD=-1:GOTO 490 REM LEFT
690 XD=0:YD=-1:GOTO 490 REM UP
700 YD=1:XD=0:GOTO 490 REM DOWN
705 REM *** Draft Mode ***
710 X1=40:Y1=40
720 CLS
730 GET A$
740 X1=X1+XD:IF X1>239 THEN X1=239
750 IF X1<0 THEN X1=0
760 Y1=Y1+YD:IF Y1>63 THEN Y1=63
770 IF Y1<0 THEN Y1=0
780 DELAY DL*10
790 COLOR 255:PLOT X1,Y1
800 DELAY 50
810 COLOR 0:PLOT X1,Y1
820 IF A$="" GOTO 730
830 IF A$="S" or A$="s" GOTO 850
840 GOTO 990
845 REM *** Set one point ***
850 PO=PO+1
860 COLOR 255:PLOT X1,Y1
870 IF PO=1 THEN X2=X1:Y2=Y1:GOTO 730
875 REM *** Draw Line ***
880 LINE X1,Y1,X2,Y2
890 PO=0
900 GET A$:IF A$="" GOTO 900
910 IF A$="S" OR A$="s" GOTO 950
920 A=ASC(A$)
930 IF A<>4 AND A<>5 AND A<>19 AND A<>24 GOTO 900
940 GOTO 980
950 PO=1
960 X2=X1:Y2=Y1
970 GOTO 900
975 REM *** Change Cursor Direction ***
980 IF A=4 GOTO 990 REM RIGHT
981 IF A=5 GOTO 1010 REM UP
982 IF A=19 GOTO 1000 REM LEFT
983 IF A=24 GOTO 1020 REM DOWN
984 GOTO 900
990 YD=0:XD=1:GOTO 730
1000 YD=0:XD=-1:GOTO 730
1010 XD=0:YD=-1:GOTO 730
1020 YD=1:XD=0:GOTO 730
10 GOSUB 610
20 COLOUR 3+128:CLS
30 LET BG=2:LET FG=1:LET T=0:LET L=3:LET LW=W-3:GOSUB 280
40 COLOUR 2+128:COLOUR 0
50 PRINT TAB(1,1);"LEVEL GENERATOR";
60 PRINT TAB(1,2);"THIS IS LEVEL:";LE;
70 PRINT TAB(1,3);"PRESS H FOR HELP"
80 LET BG=3:LET FG=2:LET T=5:LET L=15:LET LW=15:GOSUB 280
90 LET X=1:LET Y=1
100 LET I$=INKEY$(0)
110 IF I$="H" THEN GOSUB 360
120 IF I$="A" AND Y>1 THEN LET Y=Y-1
130 IF I$="Z" AND Y<15 THEN LET Y=Y+1
140 IF I$="N" AND X>1 THEN LET X=X-1
150 IF I$="M" AND X<15 THEN LET X=X+1
160 IF I$>"/" AND I$<":" THEN GOSUB 230
170 COLOUR 3+128:COLOUR 0
180 PRINT TAB(X,Y+5);CHR$(OS);
190 PRINT TAB(X,Y+5);CHR$(R(X,Y));
200 IF I$="S" AND IX>0 THEN GOSUB 450:GOTO 20
210 IF I$<>"F" THEN GOTO 100
220 STOP
230 LET I=VAL(I$)
240 IF I=9 THEN LET I=8+RND(3)
250 IF I=5 THEN LET IX=X:LET IY=Y
260 LET R(X,Y)=C0+I
270 RETURN
280 PRINT TAB(0,T);
290 COLOUR FG+128:PRINT LEFT$(B$,LW+2)
300 COLOUR BG+128:COLOUR FG
310 FOR I=1 TO L
320 PRINT TAB(0);CHR$(OS);LEFT$(B$,LW);CHR$(OS)
330 NEXT I
340 COLOUR FG+128:PRINT LEFT$(B$,LW+2);
350 RETURN
360 COLOUR 128+1:COLOUR 3
370 FOR H=1 TO 10
380 PRINT TAB(1,4);H$(H);:GOSUB 430
390 PRINT TAB(1,4);LEFT$(B$,W-2);
400 NEXT H
410 COLOUR 3
420 RETURN
430 LET G$=INKEY$(0):IF G$="" THEN GOTO 430
440 RETURN
450 PRINT TAB(1,4);"ONE MOMENT PLEASE.";
460 LET S$=""
470 FOR J=1 TO 15
480 FOR K=1 TO 15
490 LET S$=S$+CHR$(R(K,J))
500 NEXT K
510 NEXT J
520 LET S$=S$+CHR$(IX+OS):LET S$=S$+CHR$(IY+OS)
530 LET S$=S$+CHR$(LE+OS)
540 PRINT TAB(1,4);"ANY KEY TO SAVE ";:GOSUB 430
550 LET S=OPENOUT "LEVEL"
560 PRINT#S,S$
570 CLOSE#S
580 PRINT TAB(1,4);LEFT$(B$,W)
590 LET LE=LE+1:GOSUB 700
600 RETURN
610 DIM R(15,15),H$(10)
620 GOSUB 790
630 DATA "PRESS ANY KEY","TO MOVE A Z N M","1 WALL 2 VASE"
640 DATA "3 CHEST 4 * IDOL *","5 WAY IN 6 EXIT","7 TRAP","8 SAFE PLACE"
650 DATA "9 GUARD","0 TO ERASE","S TO SAVE"
660 LET LE=1
670 FOR I=1 TO 10
680 READ H$(I)
690 NEXT I:GOSUB 810
700 FOR J=1 TO 15
710 FOR K=1 TO 15
720 LET R(J,K)=C0
730 NEXT K
740 NEXT J
750 LET IX=0:LET IY=0
760 LET B$="":FOR I=1 TO W:LET B$=B$+" ":NEXT I
770 RETURN
790 OS=224:C0=OS+6:W=20
795 MODE 5:VDU 23,0,8202;0;0;0;
800 RETURN
810 REM READ THE CHARACTERS
820 VDU 23,224:FOR I=0 TO 7:READ A:VDU A:NEXT I
830 FOR I=0 TO 11:VDU 23,230+I
840 FOR J=0 TO 7:READ A:VDU A:NEXT J
850 NEXT I:RETURN
1000 DATA 255,255,255,255,255,255,255,255
1010 DATA 0,0,0,0,0,0,0,0
1020 DATA 85,170,85,170,85,170,85,170
1030 DATA 0,60,24,60,126,126,126,60
1040 DATA 0,56,100,114,95,73,41,31
1050 DATA 20,42,20,20,93,93,62,99
1060 DATA 60,126,255,255,255,253,255,255
1070 DATA 60,102,195,129,129,129,133,129
1080 DATA 129,66,36,0,0,36,66,129
1090 DATA 0,60,66,66,66,66,60,0
1100 DATA 76,158,170,190,84,30,37,88
1110 DATA 0,56,84,124,56,44,68,102
1120 DATA 0,8,28,42,127,85,65,34
