%BREAKPOINT { #0101 #0e DEO2 } %DEBUG { ;print-hex JSR2 #0a .console/write DEO } %DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .console/write DEO } %AUTO_X { #01 } %AUTO_Y { #02 } %AUTO_A { #04 } %B_UP { #10 } %B_DOWN { #20 } %B_LEFT { #40 } %B_RIGHT { #80 } %B_A { #01 } %B_B { #02 } %B_SELECT { #04 } %B_START { #08 } %SCREEN_HEIGHT { #00a0 } %SCREEN_WIDTH { #00f0 } %CUBE_HEIGHT { #10 } %CUBE_WIDTH { #10 } %BOARD_LEFT { #0078 .board/width LDZ #30 SFT SUB } %BOARD_TOP { #0050 .board/hidth LDZ #30 SFT SUB #07 SUB } ( 1x 1y -- 1tiledata ) ( weirdly because of implementation, multiplying is faster on gba... ) ( %CUBE_INDEX { DUP #40 SFT ADD ADD } ) %CUBE_INDEX { #09 MUL ADD } %CUBE_AT { CUBE_INDEX .board/cubes ADD LDZ } %CUBE_HEIGHT_AT { CUBE_INDEX .board/cube-height ADD LDZ } %SAVE_CUBE_AT { CUBE_INDEX .board/cubes ADD STZ } %SAVE_CUBE_HEIGHT_AT { CUBE_INDEX .board/cube-height ADD STZ } %DEC_CUBE_HEIGHT_AT { CUBE_INDEX .board/cube-height ADD DUP LDZ #01 SUB SWP STZ } %CUBE_ADDR { CUBE_INDEX .board/cubes ADD } %CUBE_HEIGHT_ADDR { CUBE_INDEX .board/cube-height ADD } %CUBE_HEIGHT_TO_CUBE { #51 SUB } %MODE_CLASSIC { #00 } %MODE_MODERN { #01 } %GAME_MAIN_MENU { #00 } %GAME_PLAY { #01 } %GAME_PAUSE { #02 } %GAME_OVER { #03 } |00 @system &vector $2 &pad $6 &r $2 &g $2 &b $2 |10 @console &vector $2 &read $1 &pad $5 &write $1 &error $1 |20 @screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 |30 @audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 |40 @audio1 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 |50 @audio2 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 |60 @audio3 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 |70 @midi &vector $2 &channel $1 ¬e $1 &velocity $1 |80 @controller &vector $2 &button $1 &key $1 |90 @mouse &vector $2 &x $2 &y $2 &state $1 &chord $1 |a0 @file &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 |c0 @datetime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ] |0000 @magic $1 @input $1 @pressed $1 @released $1 @input-changed $1 @touch &changed $1 &released $1 &state $1 @text-color $1 @cursor &x $1 &y $1 &direction $1 &on $1 @score $2 @mode $1 @board &width $1 &hidth &height $1 &cubes $51 &cube-height $51 @game &state $1 &cursor $1 |0100 ( theme ) #19df .system/r DEO2 #058c .system/g DEO2 #047a .system/b DEO2 AUTO_X AUTO_A ORA .screen/auto DEO ( seed prng - must be nonzero ) #00 .datetime/second DEI #00 .datetime/minute DEI #60 SFT2 EOR2 #00 .datetime/hour DEI #c0 SFT2 EOR2 ;prng2/x STA2 #00 .datetime/hour DEI #04 SFT2 #00 .datetime/day DEI #10 SFT2 EOR2 #00 .datetime/month DEI #60 SFT2 EOR2 .datetime/year DEI2 #a0 SFT2 EOR2 ;prng2/y STA2 ;prng2/x LDA2 ;prng2/y LDA2 EOR2 ORAk ,&non-zero JCN INC2 &non-zero ;prng/seed STA2 #ca .magic STZ ( resize screen ) SCREEN_WIDTH .screen/width DEO2 SCREEN_HEIGHT .screen/height DEO2 #07 .board/width STZ #06 .board/hidth STZ MODE_MODERN .mode STZ GAME_PLAY ;game-changestate JSR2 ;on-frame .screen/vector DEO2 ;on-mouse .mouse/vector DEO2 BRK @on-mouse #01 .touch/changed STZ BRK @on-frame ( handle input ) .controller/button DEI .input LDZ EQU ,&skip-input JCN #01 .input-changed STZ ( load controller ) .controller/button DEI ( get released inputs ) DUP .input LDZ EOR .input LDZ AND .released STZ ( get new inputs ) DUP DUP .input LDZ EOR AND .pressed STZ ( save old inputs ) .input STZ &skip-input ( handle mouse/touch input ) ( set released on lmb release ) #01 .touch/released STZ .touch/state LDZ #01 EQU .mouse/state DEI #00 EQU AND ,&skip-released-reset JCN #00 .touch/released STZ &skip-released-reset .mouse/state DEI .touch/state STZ ;game-update JSR2 #00 .input-changed STZ #00 .touch/changed STZ BRK ( STATE MACHINES ) ( GAME ) @game-entertable :game-enter-main-menu :game-enter-play :game-enter-pause :game-enter-over @game-updatetable :game-main-menu :game-play :game-pause :game-over @game-changestate ( 1newstate ) .game/state STZ ;game-entertable #00 .game/state LDZ #10 SFT ADD2 LDA2 JSR2 JMP2r @game-update ;game-updatetable #00 .game/state LDZ #10 SFT ADD2 LDA2 JSR2 JMP2r @draw-main-menu #41 .text-color STZ #0008 .screen/y DEO2 #0008 .screen/x DEO2 ;&header ;draw-string JSR2 .cursor/y LDZ #00 EQU #10 SFT #41 ADD .text-color STZ #0018 .screen/y DEO2 #0010 .screen/x DEO2 ;&width ;draw-string JSR2 #00 .cursor/y LDZ #00 NEQ ,¬-width-current JCN POP .cursor/x LDZ INC ¬-width-current .board/width LDZ ;draw-cubeselect JSR2 .cursor/y LDZ #01 EQU #10 SFT #41 ADD .text-color STZ #0030 .screen/y DEO2 #0010 .screen/x DEO2 ;&hidth ;draw-string JSR2 #00 .cursor/y LDZ #01 NEQ ,¬-hidth-current JCN POP .cursor/x LDZ INC ¬-hidth-current .board/hidth LDZ ;draw-cubeselect JSR2 .cursor/y LDZ #02 EQU #10 SFT #41 ADD .text-color STZ #0048 .screen/y DEO2 #0010 .screen/x DEO2 ;&cc ;draw-string JSR2 .mode LDZ MODE_MODERN EQU #41 ADD .text-color STZ #0048 .screen/y DEO2 #0068 .screen/x DEO2 ;&on ;draw-string JSR2 #0046 .screen/y DEO2 #0069 .screen/x DEO2 .mode LDZ MODE_MODERN EQU #02 MUL #02 ;draw-line JSR2 .mode LDZ MODE_CLASSIC EQU #41 ADD .text-color STZ #0048 .screen/y DEO2 #0088 .screen/x DEO2 ;&off ;draw-string JSR2 #0046 .screen/y DEO2 #0089 .screen/x DEO2 .mode LDZ MODE_CLASSIC EQU #02 MUL #03 ;draw-line JSR2 .cursor/y LDZ #03 EQU #10 SFT #41 ADD .text-color STZ #0090 .screen/y DEO2 #0008 .screen/x DEO2 ;&start ;draw-string JSR2 JMP2r &header "cat 20 "cubes! 00 &width "width: 00 &hidth "hidth: 00 &start "start 00 &cc "cat 20 "cubes: 00 &on "on 00 &off "off 00 @game-enter-main-menu ;draw-main-menu JSR2 JMP2r @game-main-menu .input-changed LDZ .touch/changed LDZ ORA #00 EQU ,&skip-cursor JCN .cursor/x LDZ2 ( ;one-direction JSR2 ) .pressed LDZ #f0 AND ;direction-step JSR2 .cursor/x STZ2 ;draw-main-menu JSR2 &skip-cursor JMP2r ( TODO: why does everything break if this is removed ) #0101 #0101 #01 @game-enter-play ;randomize-board JSR2 ;draw-board JSR2 ;draw-full-cursor JSR2 JMP2r @game-play ;update-board JSR2 .input-changed LDZ .touch/changed LDZ ORA #00 EQU ,&skip-cursor JCN ;update-cursor JSR2 ;check-game-over JSR2 ,&game-over JCN .pressed LDZ B_START AND #00 EQU ,&skip-pause JCN ( GAME_PAUSE ;game-changestate JSR2 ) &skip-pause &skip-cursor JMP2r &game-over #0090 .screen/y DEO2 #00a0 .screen/x DEO2 #43 .text-color STZ ;&gameover ;draw-string JSR2 AUTO_X AUTO_A ORA .screen/auto DEO ( GAME_OVER ;game-changestate JSR2 ) JMP2r &gameover "game 20 "over! 00 @game-enter-pause JMP2r @game-pause JMP2r @game-enter-over JMP2r @game-over ;update-board JSR2 JMP2r ( HELPERS ) @draw-cubeselect ( 1cursor 1selected ) .screen/y DEI2 #0004 SUB2 .screen/y DEO2 ;&selected STA ;&cursor STA #01 &loop STHk ( draw cube ) DUP ;&selected LDA INC LTH OVR ;&cursor LDA NEQ ,¬-cursor JCN POP #02 ¬-cursor #01 ADD .screen/x DEI2 .screen/y DEI2 #0010 #0010 ;cubes-tileset ;cubes-tiles STHr #20 SFT ADD ;draw-tiles JSR2 .screen/x DEI2 #0010 SUB2 .screen/x DEO2 .screen/y DEI2 #0009 ADD2 .screen/y DEO2 ( draw under-line ) ,&cursor LDR OVR EQU #0f MUL #40 ADD #02 ;draw-line JSR2 .screen/x DEI2 #0010 SUB2 .screen/x DEO2 .screen/y DEI2 #0012 SUB2 .screen/y DEO2 ( draw over-line ) ,&selected LDR INC OVR GTH #0a MUL #40 ADD #02 ;draw-line JSR2 .screen/y DEI2 #0001 ADD2 .screen/y DEO2 INC DUP #0a LTH ;&loop JCN2 POP JMP2r &cursor $1 &selected $1 @draw-line ( 1color 1segments ) AUTO_X .screen/auto DEO ;line .screen/addr DEO2 #00 STH2 .screen/sprite &loop DEOk INCr GTHkr STHr ,&loop JCN POP2r POP2 JMP2r @clear-cursor ( handle cursor ) ( clear old cursor ) .cursor/x LDZ .cursor/y LDZ ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ;clear .screen/addr DEO2 ;draw-four JSR2 JMP2r @draw-score #0008 #0090 .score LDZ2 POP ;print-byte JSR2 #0018 #0090 .score LDZ2 NIP ;print-byte JSR2 JMP2r @print-byte ( 2x 2y 1v -- ) ( print low nibble ) DUP #0f AND #00 SWP #30 SFT2 ;hex-font ADD2 .screen/addr DEO2 #00 ROT2 DUP2 #0008 ADD2 .screen/x DEO2 ROT2 DUP2 .screen/y DEO2 ROT2 POP #03 .screen/sprite DEO ( print high nibble ) DUP #f0 AND #01 SFT #00 SWP ;hex-font ADD2 .screen/addr DEO2 #00 ROT2 DUP2 .screen/x DEO2 ROT2 DUP2 .screen/y DEO2 ROT2 POP #03 .screen/sprite DEO POP POP2 POP2 JMP2r @board-to-screen ( 1x 1y -- 2x 2y ) #40 SFT #00 SWP BOARD_TOP ADD2 ROT #40 SFT #00 SWP BOARD_LEFT ADD2 SWP2 JMP2r @screen-to-board ( 2x 2y -- 1x 1y ) DUP2 BOARD_TOP LTH2 ,&bad-y JCN BOARD_TOP SUB2 CUBE_HEIGHT DIV SWP2 &x DUP2 BOARD_LEFT LTH2 ,&bad-x JCN BOARD_LEFT SUB2 CUBE_WIDTH DIV &cleanup NIP ROT POP SWP JMP2r &bad-y POP2 #0000 SWP2 ,&x JMP &bad-x POP2 #0000 ,&cleanup JMP @clean-touch DUP #ff NEQ ,&y-not-neg JCN POP #00 &y-not-neg DUP .board/hidth LDZ LTH ,&y-not-wrap JCN POP .board/hidth LDZ #01 SUB &y-not-wrap SWP DUP #ff NEQ ,&x-not-neg JCN POP #00 &x-not-neg DUP .board/width LDZ LTH ,&x-not-wrap JCN POP .board/width LDZ #01 SUB &x-not-wrap SWP JMP2r @clean-cursor .cursor/x LDZ2 DUP #ff NEQ ,&y-not-neg JCN POP .board/hidth LDZ #01 SUB &y-not-neg DUP .board/hidth LDZ LTH ,&y-not-wrap JCN POP #00 &y-not-wrap SWP DUP #ff NEQ ,&x-not-neg JCN POP .board/width LDZ #01 SUB &x-not-neg DUP .board/width LDZ LTH ,&x-not-wrap JCN POP #00 &x-not-wrap SWP .cursor/x STZ2 JMP2r @update-cursor .cursor/on LDZ ,&skip-move JCN ( touch handling ) .touch/changed LDZ #00 EQU ,&skip-touch JCN ;clear-cursor JSR2 .mouse/x DEI2 .mouse/y DEI2 ;screen-to-board JSR2 ;clean-touch JSR2 .cursor/y STZ .cursor/x STZ .touch/state LDZ #01 AND ,&cursor-on JCN &skip-touch ( gamepad handling ) .pressed LDZ B_A AND #00 EQU ,&end-c-a JCN &cursor-on #01 .cursor/on STZ ;highlights .screen/addr DEO2 .cursor/x LDZ2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ;draw-four JSR2 ,&skip-move JMP &end-c-a ( move cursor ) ;clear-cursor JSR2 .cursor/x LDZ2 ( ;one-direction JSR2 ) .pressed LDZ #f0 AND ;direction-step JSR2 .cursor/x STZ2 ;clean-cursor JSR2 ;draw-full-cursor JSR2 JMP2r &skip-move ( touch handling ) .touch/changed LDZ #00 EQU ,&skip-ptouch JCN ( cancel if another mouse button is pressed ) .touch/state LDZ #01 GTH ,&cancel-cursor JCN &skip-ptouch .pressed LDZ B_B AND #00 EQU ,&end-b JCN &cancel-cursor #00 .cursor/on STZ .cursor/direction LDZ #00 EQU ,&skip-clear-b JCN ;clear-highlights JSR2 #00 .cursor/direction STZ &skip-clear-b ;draw-full-cursor JSR2 JMP2r &end-b ;one-direction JSR2 #00 EQU ,&keep-direction JCN .cursor/direction LDZ #00 EQU ,&skip-clear JCN ;clear-highlights JSR2 &skip-clear ;one-direction JSR2 DUP .cursor/direction STZ .cursor/x LDZ2 ;match-length JSR2 ( max at hrair ) DUP DUP #05 LTH ,¬-hrair JCN POP #05 ¬-hrair #01 SUB #00 SWP #0020 MUL2 ;highlights ADD2 .screen/addr DEO2 ( cat cube? ) .cursor/x LDZ2 CUBE_AT #04 NEQ ,¬-cat JCN POP .cursor/x LDZ2 .cursor/direction LDZ ;direction-step JSR2 CUBE_AT ;cat-highlight JSR2 ,&after-draw JMP ¬-cat .cursor/direction LDZ .cursor/x LDZ2 ;draw-fours JSR2 &after-draw &keep-direction .released LDZ B_A AND #00 EQU .touch/released LDZ #00 EQU AND ;&end-a JCN2 #00 .cursor/on STZ .cursor/x LDZ2 STH2 ( nvm if no input direction ) .cursor/direction LDZ DUP #00 EQU ,&nvm JCN ( get match length ) DUP STH2kr ;match-length JSR2 ( clear highlights ) ;clear-highlights JSR2 ( cat cube? ) STH2kr CUBE_AT #04 NEQ ,¬-cat-clear JCN SWP POP ( number on stack ) STH2r .cursor/direction LDZ ;direction-step JSR2 CUBE_AT ;cat-clear JSR2 ,&cleanup-a JMP ¬-cat-clear DUP STH2kr CUBE_AT ( check if more than block number ) GTH ,&continue JCN POP2r POP2 ,&cleanup-a JMP &continue ( add score ) ( add #cleared - 1 + val * #cleared ) ( dup #cleared to short ) DUP #00 SWP ( put cleared-1 in back ) DUP2 #0001 SUB2 SWP2 ( get tile value + 1 as short ) STH2kr CUBE_AT INC #00 SWP ( mul value + 1 and cleared ) MUL2 ( combine with cleared-1 ) ADD2 ( add to score ) .score LDZ2 ADD2 .score STZ2 SWP STH2r ;clear-cubes JSR2 ,&cleanup-a JMP &nvm POP ( clear if it's a 1 block ) STH2kr CUBE_AT #00 EQU ,&is-1 JCN POP2r ,&cleanup-a JMP &is-1 .score LDZ2 INC2 .score STZ2 STH2r ;clear-cube JSR2 &cleanup-a ;draw-full-cursor JSR2 ;draw-score JSR2 ( clear cursor direction for future use ) #00 .cursor/direction STZ &end-a JMP2r @check-game-over #00 &xloop #00 &yloop STH2 ( get cube type ) STH2kr CUBE_AT ( we haven't lost if we have a cat cube or a 1 ) DUP DUP #04 EQU SWP #00 EQU ORA ,¬-game-over JCN ( we haven't lost if any cube can match ) ( we only need to check right and down ) ( up and left for later tiles will be the same ) ( as earlier tiles' right and down ) DUP B_RIGHT STH2kr ;match-length JSR2 LTH ,¬-game-over JCN DUP B_DOWN STH2kr ;match-length JSR2 LTH ,¬-game-over JCN POP STH2r INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP #01 JMP2r ¬-game-over POP POP2r #00 JMP2r @clear-highlights ( clear highlights ) ;clear .screen/addr DEO2 ( is current cube a cat cube? ) .cursor/x LDZ2 CUBE_AT DUP #04 NEQ ,¬-cat JCN ( switch to cat match length and return ) POP .cursor/x LDZ2 .cursor/direction LDZ ;direction-step JSR2 CUBE_AT ;cat-highlight JSR2 JMP2r ¬-cat POP .cursor/direction LDZ .cursor/x LDZ2 ;match-length JSR2 .cursor/direction LDZ .cursor/x LDZ2 ;draw-fours JSR2 JMP2r @direction-step ( 1x 1y 1direction - 1x 1y ) DUP B_LEFT AND #00 EQU ,&end-left JCN STH SWP #01 SUB SWP STHr &end-left DUP B_RIGHT AND #00 EQU ,&end-right JCN STH SWP #01 ADD SWP STHr &end-right DUP B_DOWN AND #00 EQU ,&end-down JCN STH #01 ADD STHr &end-down DUP B_UP AND #00 EQU ,&end-up JCN STH #01 SUB STHr &end-up POP JMP2r @one-direction ( check mouse first ) .touch/changed LDZ #00 EQU ,&no-mouse JCN ( determine cursor direction ) .mouse/x DEI2 .mouse/y DEI2 ;screen-to-board JSR2 ;clean-touch JSR2 ( check for y change ) DUP .cursor/y LDZ LTH ,&set-up JCN .cursor/y LDZ GTH ,&set-down JCN DUP .cursor/x LDZ LTH ,&set-left JCN .cursor/x LDZ GTH ,&set-right JCN ,&no-mouse JMP &set-up POP2 B_UP JMP2r &set-down POP B_DOWN JMP2r &set-left POP B_LEFT JMP2r &set-right B_RIGHT JMP2r &no-mouse .input LDZ DUP B_LEFT AND #00 EQU ,&end-left JCN POP B_LEFT JMP2r &end-left DUP B_RIGHT AND #00 EQU ,&end-right JCN POP B_RIGHT JMP2r &end-right DUP B_UP AND #00 EQU ,&end-up JCN POP B_UP JMP2r &end-up B_DOWN AND #00 EQU ,&end-down JCN B_DOWN JMP2r &end-down #00 JMP2r @draw-full-cursor ( clear old cube ) .cursor/x LDZ2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 #c1 ;draw-cursor JSR2 JMP2r @draw-cursor ( 1color ) ;tiles-cursor .screen/addr DEO2 DUP .screen/sprite DEO DUP .screen/sprite DEO .screen/y DEI2 #0008 ADD2 .screen/y DEO2 .screen/x DEI2 #0010 SUB2 .screen/x DEO2 DUP .screen/sprite DEO .screen/sprite DEO ( put things back how we found them ) .screen/y DEI2 #0008 SUB2 .screen/y DEO2 .screen/x DEI2 #0010 SUB2 .screen/x DEO2 JMP2r @randomize-board #00 &xloop #00 &yloop STH2 ;prng2 JSR2 NIP #03 AND STH2kr SAVE_CUBE_AT STH2r INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP JMP2r @update-board #00 &xloop #00 &yloop ( y offset ) ( if 0 assume all lower cubes are 0 too ) DUP2 CUBE_HEIGHT_ADDR LDZk ,&fall JCN POP ,&next-column JMP &continue INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN &next-column POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP JMP2r &fall ( stash cube_height_addr ) STHk ( dec cube height ) LDZk #01 SUB SWP STZ ( set up coords ) DUP2 ;board-to-screen JSR2 #00 STHkr LDZ SUB2 .screen/y DEO2 .screen/x DEO2 ( get cube type ) #00 STHr CUBE_HEIGHT_TO_CUBE LDZ #60 SFT2 ;cubes ADD2 ;draw-cube JSR2 ,&continue JMP @cat-match-length ( 1tiletype -- 1length ) #00 STH STH #00 &xloop #00 &yloop DUP2 CUBE_AT STHrk NEQ STHrk #04 NEQ AND ,¬-match JCN SWPr INCr SWPr ¬-match INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP POPr STHr JMP2r @match-length ( 1B_DIR 1x 1y -- 1length ) ( what are we? ) DUP2 CUBE_AT STH ( what's next? ) STH2 DUP B_LEFT NEQ ,&end-left JCN STH2r #0100 SUB2 STH2 &end-left DUP B_RIGHT NEQ ,&end-right JCN STH2r #0100 ADD2 STH2 &end-right DUP B_DOWN NEQ ,&end-down JCN STH2r #0001 ADD2 STH2 &end-down DUP B_UP NEQ ,&end-up JCN STH2r #0001 SUB2 STH2 &end-up ( check if we're out of bounds ) STH2kr .board/hidth LDZ LTH ,&y-ok JCN ( out of y axis, clean up and exit ) POP2 POP2r POPr #01 JMP2r &y-ok .board/width LDZ LTH ,&x-ok JCN ( out of y axis, clean up and exit ) POP POP2r POPr #01 JMP2r &x-ok ( get 'next' cube ) STH2kr CUBE_AT ( get current cube ) ROTr STHr ( is current cube a cat cube? ) DUP #04 NEQ ,¬-cat JCN ( switch to cat match length and return ) POP SWP POP POP2r ;cat-match-length JSR2 JMP2r ¬-cat ( the same? ) EQU ,&same JCN ( not the same, return.. 1??? ) POP2r POP #01 JMP2r &same ( the same, check next block ) STH2r ;match-length JSR2 ( return'd its length, add ours and return ) INC JMP2r @halt ;halt JSR2 @cat-clear ( 1number 1type ) STH ( add score ) ( add #cleared - 1 + val * #cleared ) ( dup #cleared to short ) #00 SWP ( put cleared-1 in back ) DUP2 #0001 SUB2 SWP2 ( get tile value + 1 as short ) STHkr INC #00 SWP ( mul value + 1 and cleared ) MUL2 ( combine with cleared-1 ) ADD2 ( add to score ) .score LDZ2 ADD2 .score STZ2 ( let's clear those cubes. ) #00 &xloop #00 &yloop ( get cube type ) DUP2 CUBE_AT STHkr NEQ STHkr #04 NEQ AND ,&nope JCN DUP2 ;clear-cube JSR2 &nope ( clear if cursor too, if we havent already ) DUP2 .cursor/x LDZ2 NEQ2 STHkr #04 EQU ORA ,&also-nope JCN DUP2 ;clear-cube JSR2 &also-nope INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP POPr JMP2r @cat-highlight ( 1type ) STH #00 &xloop #00 &yloop ( get cube type ) DUP2 CUBE_AT STHkr NEQ STHkr #04 NEQ AND ,&nope JCN DUP2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ;draw-four JSR2 &nope INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP POPr ( highlight cursor too ) .cursor/x LDZ2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ;draw-four JSR2 JMP2r @draw-fours ( 1len 1dir 1x 1y ) &begin DUP2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ;draw-four JSR2 ( what's next? ) STH2 DUP B_LEFT NEQ ,&end-left JCN STH2r #0100 SUB2 STH2 &end-left DUP B_RIGHT NEQ ,&end-right JCN STH2r #0100 ADD2 STH2 &end-right DUP B_DOWN NEQ ,&end-down JCN STH2r #0001 ADD2 STH2 &end-down DUP B_UP NEQ ,&end-up JCN STH2r #0001 SUB2 STH2 &end-up STH #01 SUB DUP ,&continue JCN POP POP2r POPr JMP2r &continue STHr STH2r ,&begin JMP @clear-cubes ( 1len 1dir 1x 1y ) &begin ( check for cat cube spawn ) .mode LDZ MODE_CLASSIC EQU ,¬-cat JCN ( pull out dir and len ) OVR2 ( check for vertical ) DUP B_UP NEQ SWP B_DOWN NEQ AND ,¬-vert JCN ( check if len equal to hidth ) .board/hidth LDZ NEQ ,¬-cat JCN ( oh, it is ) ,&cat JMP ¬-vert ( assume horizontal ) ( check if len equal to width ) .board/width LDZ NEQ ,¬-cat JCN ( oh, it is ) ( ,&cat JMP ) &cat DUP2 CUBE_ADDR #04 SWP STZ ( redraw as cat cube ) DUP2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ;cubes/cat ;draw-cube JSR2 ( bump up one if going up ) OVR2 NIP B_UP NEQ ,&donthaveta JCN #0001 SUB2 &donthaveta ,&after-clear JMP ¬-cat DUP2 ;clear-cube JSR2 &after-clear ( what's next? ) STH2 DUP B_LEFT NEQ ,&end-left JCN STH2r #0100 SUB2 STH2 &end-left DUP B_RIGHT NEQ ,&end-right JCN STH2r #0100 ADD2 STH2 &end-right DUP B_DOWN NEQ ,&end-down JCN STH2r #0001 ADD2 STH2 &end-down DUP B_UP NEQ ,&end-up JCN STH2r #0000 SUB2 STH2 &end-up STH #01 SUB DUP ,&continue JCN POP POP2r POPr JMP2r &continue STHr STH2r ;&begin JMP2 @clear-cube ( 1x 1y ) ( clear old cube ) DUP2 CUBE_HEIGHT_AT STH DUP2 ;board-to-screen JSR2 #00 STHr SUB2 .screen/y DEO2 .screen/x DEO2 #00 ;draw-cursor JSR2 DUP #00 EQU ,&newcube JCN &drop-in STH2k #01 SUB ( get coords of cube above ) DUP2 CUBE_AT STH CUBE_HEIGHT_AT STHr SWP ( increase height by a tile ) #10 ADD ( save info of above cube to current cube ) STH2kr SAVE_CUBE_HEIGHT_AT STH2kr SAVE_CUBE_AT ( move to cube above ) STH2r #01 SUB DUP ,&drop-in JCN &newcube STH2k ( get height of below cube ) INC CUBE_HEIGHT_AT ( let's make it always at least 0x10 ) DUP #10 GTH ,&ok JCN POP #10 &ok ( create new cube above below cube ) STH2kr SAVE_CUBE_HEIGHT_AT ( get random cube value ) ;prng2 JSR2 NIP #03 AND STH2r SAVE_CUBE_AT JMP2r @draw-board #00 &xloop #00 &yloop DUP2 ;board-to-screen JSR2 .screen/y DEO2 .screen/x DEO2 ( y offset ) DUP2 CUBE_HEIGHT_AT #00 SWP .screen/y DEI2 SWP2 SUB2 .screen/y DEO2 ( get cube type ) DUP2 CUBE_AT #00 SWP #0040 MUL2 ;cubes ADD2 ;draw-cube JSR2 INC DUP .board/hidth LDZ SWP GTH ,&yloop JCN POP INC DUP .board/width LDZ SWP GTH ,&xloop JCN POP JMP2r @draw-four #43 .screen/sprite DEO #43 .screen/sprite DEO .screen/y DEI2 #0008 ADD2 .screen/y DEO2 .screen/x DEI2 #0010 SUB2 .screen/x DEO2 #43 .screen/sprite DEO #43 .screen/sprite DEO ( set addr back ) .screen/addr DEI2 #0020 SUB2 .screen/addr DEO2 JMP2r @draw-cube ( 2cube ) .screen/addr DEO2 #81 .screen/sprite DEO #81 .screen/sprite DEO .screen/y DEI2 #0008 ADD2 .screen/y DEO2 .screen/x DEI2 #0010 SUB2 .screen/x DEO2 #81 .screen/sprite DEO #81 .screen/sprite DEO JMP2r @print-hex ( value -- ) STHk #04 SFT ,&parse JSR .console/write DEO STHr #0f AND ,&parse JSR .console/write DEO JMP2r &parse ( value -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r &above #09 SUB #60 ADD JMP2r JMP2r @draw-string ( 2ptr* -- ) #ff ;&limit STA &limited #00 .screen/auto DEO &beginning ;&limit LDA #00 NEQ ,¬-limited JCN POP2 JMP2r ¬-limited ( if no bytes of address are set, passed nil ptr ) ORAk ,¬-nil JCN POP2 JMP2r ¬-nil LDAk #00 NEQ ,¬-done JCN ;&limit LDA #01 SUB ;&limit STA POP2 JMP2r ¬-done LDAk #60 LTH ,¬-lower JCN ( convert lowercase to start at ! ) LDAk #41 SUB ,&draw-character JMP ¬-lower LDAk #20 EQU ,&advance JCN ( convert to start at ! ) LDAk #21 SUB &draw-character ( check for p ) DUP #2f NEQ ,¬-p JCN ;font/p-tail ,&tail JMP ¬-p ( check for q ) DUP #30 NEQ ,¬-q JCN ;font/q-tail ,&tail JMP ¬-q ( check for g ) DUP #26 NEQ ,¬-g JCN ;font/gy-tail ,&tail JMP ¬-g ( check for y ) DUP #38 NEQ ,¬-y JCN ;font/gy-tail ,&tail JMP ¬-y ,&no-tail JMP &tail .screen/addr DEO2 .screen/y DEI2 #0008 ADD2 .screen/y DEO2 .text-color LDZ .screen/sprite DEO .screen/y DEI2 #0008 SUB2 .screen/y DEO2 &no-tail #00 SWP #0008 MUL2 ;font ADD2 .screen/addr DEO2 .text-color LDZ .screen/sprite DEO &advance LDAk #97 EQU ,&after-advance JCN .screen/x DEI2 #0008 ADD2 .screen/x DEO2 &after-advance &next ,&limit LDR #01 SUB ,&limit STR INC2 ;&beginning JMP2 &end JMP2r &limit $1 @draw-tiles ( 1color 2x 2y 2width 2height 2tileset 2room -> ) AUTO_X .screen/auto DEO ,&next STR2 ,&tileset STR2 ,&height STR2 ,&width STR2 ,&y STR2 ,&x STR2 ,&color STR ,&height LDR2 #0000 &yloop DUP2 ,&y LDR2 ADD2 .screen/y DEO2 ,&x LDR2 .screen/x DEO2 ,&width LDR2 #0000 &xloop ( get tile offset keeping next around ) ,&next LDR2 DUP2 LDA #00 SWP ( check high bit of color for 2bpp ) ,&color LDR #80 AND #00 EQU ,&1bpp JCN ( if 2bpp shift once more ) #10 SFT2 &1bpp #30 SFT2 ( add to tileset addr ) ,&tileset LDR2 ADD2 .screen/addr DEO2 ( draw tile ) ,&color LDR .screen/sprite DEO ( inc next ) INC2 ,&next STR2 #0008 ADD2 GTH2k ,&xloop JCN POP2 POP2 #0008 ADD2 GTH2k ,&yloop JCN POP2 POP2 JMP2r &width $2 &height $2 &x $2 &y $2 &tileset $2 &next $2 &color $1 @prng ( -- number* ) ( returns the next number in a 65,535-long sequence, which is never zero but every other 16-bit number appears once before the sequence repeats ) ( http://www.retroprogramming.com/2017/07/xorshift-pseudorandom-numbers-in-z80.html ) ,&seed LDR2 DUP2 #70 SFT2 EOR2 DUP2 #09 SFT2 EOR2 DUP2 #80 SFT2 EOR2 ,&seed STR2k POP JMP2r &seed $2 @prng2 ( -- number* ) ( returns the next number in a (2^32-1)-long sequence ) ( http://b2d-f9r.blogspot.com/2010/08/16-bit-xorshift-rng-now-with-more.html ) ,&x LDR2 DUP2 #50 SFT2 EOR2 DUP2 #03 SFT2 EOR2 ,&y LDR2 DUP2 ,&x STR2 DUP2 #01 SFT2 EOR2 EOR2 ,&y STR2k POP JMP2r &x $2 &y $2 @tiles-cursor 00ff f8e0 c0c0 8080 00f8 e0c0 8080 0000 00fe 3e0e 0606 0202 003e 0e06 0202 0000 8080 80c0 c0e0 f8ff 0000 0080 80c0 e0f8 0202 0206 060e 3efe 0000 0002 0206 0e3e @line aa00 0000 0000 0000 @cubes &1 00ff 8080 9e9e 9e9e 0000 0000 0000 0000 00fe 0202 0202 0202 0000 0000 0000 0000 8080 8080 8080 80ff 0000 0000 0000 0000 0202 0202 0202 02fe 0000 0000 0000 0000 &2 00ff ffff e1e1 e1e1 0000 0000 0000 0000 00fe fefe fefe fefe 0000 0000 0000 0000 ffff ffff ffff ffff 0000 0000 0000 0000 fe0e 0e0e 0efe fefe 0000 0000 0000 0000 &3 0000 0000 0000 0000 00ff ffff e1e1 e1e1 0000 0000 0000 0000 00fe fefe 0e0e 0e0e 0000 0000 0000 0000 ffff ffff ffff ffff 0000 0000 0000 0000 fe0e 0e0e 0efe fefe &4 00ff ffff e1e1 e1e1 00ff ffff e1e1 e1e1 00fe fefe 0e0e 0e0e 00fe fefe 0e0e 0e0e ffe1 e1e1 e1ff ffff ffe1 e1e1 e1ff ffff fe0e 0e0e 0efe fefe fe0e 0e0e 0efe fefe &cat 00ff ffcf c3c0 c0e0 0000 0000 0018 1202 00fe fee6 8606 060e 0000 0000 0030 9080 e0c0 c0e0 f0f8 ffff 0003 0906 0000 0000 0e06 060e 1e3e fefe 0080 20c0 0000 0000 @highlights &1 0000 0000 1e1e 1e1e 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 &2 0000 0000 1e1e 1e1e 0000 0000 0000 0000 0000 0000 0000 0000 00f0 f0f0 f000 0000 &3 0000 0000 1e1e 1e1e 0000 0000 f0f0 f0f0 0000 0000 0000 0000 00f0 f0f0 f000 0000 &4 0000 0000 1e1e 1e1e 0000 0000 f0f0 f0f0 001e 1e1e 1e00 0000 00f0 f0f0 f000 0000 &hrair 0000 0000 1f1f 1f1f 0000 0000 f0f0 f0f0 1f1f 1f1f 1f00 0000 f0f0 f0f0 f000 0000 @clear 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 @hex-font 003e 4141 4141 413e 0038 0808 0808 087f 003e 4101 3e40 407f 007e 0101 1e01 017e 0001 4141 7f01 0101 007f 4040 7e01 017e 003c 4040 7e41 413e 007f 0102 1c08 0808 003e 4141 3e41 413e 003e 4141 3f01 011e 0000 3e01 3f41 413e 4040 7e41 4141 413e 0000 3f40 4040 403f 0101 3f41 4141 413e 0000 3e41 417e 403e 0000 3f40 407c 4040 @font 4040 4040 4040 0040 2424 0000 0000 0000 0014 3e14 3e14 0000 0050 7071 1f3e 2a00 314a 4c3e 1929 4600 1824 2418 2522 1d00 0808 0000 0000 0000 0001 0202 0202 0201 0040 2020 2020 2040 0014 0814 0000 0000 0808 087f 0808 0800 0000 0000 0020 6040 0000 007f 0000 0000 0000 0000 0060 6000 0001 0204 0810 2040 &digits 003e 4141 4141 413e 0038 0808 0808 087f 003e 4101 3e40 407f 007e 0101 1e01 017e 0001 4141 7f01 0101 007f 4040 7e01 017e 003c 4040 7e41 413e 007f 0102 1c08 0808 003e 4141 3e41 413e 003e 4141 3f01 011e 0000 6060 0060 6000 0000 6060 0020 6040 0003 0c30 4030 0c03 0000 7f00 007f 0000 0060 1806 0106 1860 3844 0408 1000 1000 0000 004a 4e7f 7c54 &letters 0000 3e01 3f41 413e 4040 7e41 4141 413e 0000 3f40 4040 403f 0101 3f41 4141 413e 0000 3e41 417e 403e 0000 3f40 407c 4040 0000 3e41 4141 413f 4040 7e41 4141 4141 0000 7f08 0808 087f 0000 7f04 0404 0478 0000 4244 7844 4241 0000 4040 4040 403f 0000 3649 4941 4141 0000 3e41 4141 4141 0000 3e41 4141 413e 0000 3e41 4141 417e 0000 3e41 4141 413f 0000 3e41 4040 4040 0000 1f20 1e01 413e 1010 7f10 1010 100f 0000 0141 4141 413f 0000 0141 4141 221c 0000 0141 4149 4936 0000 6314 0808 1463 0000 0141 4141 413f 0000 3e44 0810 217e 0024 2400 0042 3c00 0024 2400 003c 4200 &gy-tail 0101 0121 1e00 0000 &p-tail 4040 4040 0000 0000 &q-tail 0101 0101 0000 0000 @cats-tiles 0102 0d0e 0304 0506 0708 0f10 090a 0b0c @cats-tileset 0000 0000 0000 0000 0001 0111 7343 633d 0010 b0f0 58f8 a8d0 0001 0101 1373 4167 0010 b0f0 f8f8 30e0 0000 0101 0133 1331 0000 10b0 f0f8 f830 3637 3325 2000 0000 60e0 e0a0 a0a0 2000 3f3f 3e36 3622 2000 e0e0 20a0 2000 0000 233f 3f3e 3616 0400 e0e0 f010 8080 0000 0000 0131 1133 233d 0000 10b0 f058 f8a8 3e37 3315 0501 0100 d0e0 e0a0 1010 0000 @cubes-tiles 0102 0d05 0902 0d05 0902 0d0e 090a 0d0e 090a 060e 0304 0f07 0b04 0f07 0b04 0f10 0b0c 0f10 0b0c 0810 @cubes-tileset 0000 0000 0000 0000 00ff ffff ffff ffff 00fe fefe fefe fefe 00ff 80bf bfbf bfbf 00fe 02fa fafa fafa fefe fefe fefe fefe ffe1 e1e1 e1ff ffff fafa fafa fafa 02fe bfa1 a1a1 a1bf 80ff 00ff ffff e1e1 e1e1 00fe fefe 0e0e 0e0e 00ff 80bf a1a1 a1a1 00fe 02fa 0a0a 0a0a ffff ffff ffff ffff fe0e 0e0e 0efe fefe bfbf bfbf bfbf 80ff fa0a 0a0a 0afa 02fe