snake.tal (4109B)
1 ( uxnemu snake.rom ) 2 3 |00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1 4 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 5 |80 @Controller &vector $2 &button $1 &key $1 6 |c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 7 |000 8 9 @arena &w $1 &h $1 10 @apple &pos &x $1 &y $1 11 @snake &pos &x $1 &y $1 &direction $1 &length $1 &dead $1 &tail $40 12 13 |100 14 15 @on-reset ( -> ) 16 ( | theme ) 17 #0f7e .System/r DEO2 18 #0fe6 .System/g DEO2 19 #0f62 .System/b DEO2 20 ( | vectors ) 21 ;on-frame .Screen/vector DEO2 22 ;on-button .Controller/vector DEO2 23 ( | resize ) 24 #00c8 .Screen/width DEO2 25 #0100 .Screen/height DEO2 26 ( | set arena ) 27 .Screen/width DEI2 #03 SFT2 .arena/w STZ 28 POP .Screen/height DEI2 #03 SFT2 .arena/h STZ 29 POP [ LIT2 01 -Screen/auto ] DEO 30 reset BRK 31 32 @on-frame ( -> ) 33 [ LIT &f $1 ] INCk ,&f STR 34 #04 GTH ?{ BRK } 35 [ LIT2 00 _&f ] STR 36 #00 <draw-snake> 37 <move> 38 [ LIT2 02 -snake/dead ] LDZ ADD <draw-snake> 39 #83 <draw-apple> 40 <draw-score> 41 BRK 42 43 @on-button ( -> ) 44 .Controller/button DEI 45 ( ) DUP #f0 AND ?&arrow 46 ( ) #0f AND ?&button 47 BRK 48 &arrow ( button -> ) 49 #04 SFT .snake/direction STZ 50 BRK 51 &button ( -> ) 52 reset BRK 53 54 @reset ( -- ) 55 #00 <draw-snake> 56 #00 <draw-apple> 57 [ LIT2 00 -snake/dead ] STZ 58 [ LIT2 00 -snake/length ] STZ 59 [ LIT2 00 -snake/direction ] STZ 60 .arena/w LDZ #01 SFT #01 SUB .snake/x STZ 61 .arena/h LDZ #01 SFT #01 SUB .snake/y STZ 62 #03 <draw-snake> 63 !<add-apple> 64 65 @<move> ( -- ) 66 ( | copy tail ) 67 [ LITr -snake/pos ] LDZ2r .snake/length LDZ #00 68 &>loop ( -- ) 69 DUPk ADD .snake/tail ADD LDZ2k STH2 70 SWP2r STH2r ROT STZ2 71 INC GTHk ?&>loop 72 POP2 POP2r 73 ( ) .snake/dead LDZ ?&end 74 .snake/direction LDZ 75 ( ) DUP #01 NEQ ?{ 76 .snake/y LDZk #01 SUB .arena/h set-pos } 77 DUP #02 NEQ ?{ 78 .snake/y LDZk INC .arena/h set-pos } 79 DUP #04 NEQ ?{ 80 .snake/x LDZk #01 SUB .arena/w set-pos } 81 DUP #08 NEQ ?{ 82 .snake/x LDZk INC .arena/w set-pos } 83 POP 84 ( | detect collision with apple ) 85 .snake/pos LDZ2 .apple/pos LDZ2 NEQ2 ?{ 86 #00 <draw-apple> 87 .snake/length LDZk INC SWP STZ 88 <add-apple> 89 !<move> } 90 ( | detect collision with body ) 91 .snake/length LDZ #01 92 &>loop-body ( -- ) 93 DUPk ADD .snake/tail ADD LDZ2 .snake/pos LDZ2 NEQ2 ?{ 94 [ LIT2 01 -snake/dead ] STZ 95 #03 <draw-snake> } 96 INC GTHk ?&>loop-body 97 POP2 &end JMP2r 98 99 @set-pos ( z mod max -- ) 100 LDZ OVR INC ?{ ROT STZ 101 POP JMP2r } 102 DIVk MUL SUB SWP STZ 103 JMP2r 104 105 @<add-apple> ( -- ) 106 .DateTime/hour DEI2 .DateTime/minute DEI2 MUL2 107 ( ) DUP2 #1234 MUL2 ADD .arena/w LDZ DIVk MUL SUB .apple/x STZ 108 ( ) #abcd MUL2 ADD .arena/h LDZ DIVk MUL SUB .apple/y STZ 109 JMP2r 110 111 ( 112 @|drawing ) 113 114 @<draw-snake> ( color -- ) 115 STH 116 ( | draw tail ) 117 ;snake-icns .Screen/addr DEO2 118 [ LIT2 -snake/tail -snake/length ] LDZ DUP ADD OVR ADD SWP 119 &>loop ( -- ) 120 LDZ2k #0005 SFT2 .Screen/y DEO2 121 #0005 SFT2 .Screen/x DEO2 122 DUPr [ LITr -Screen/sprite ] DEOr 123 INC INC GTHk ?&>loop 124 POP2 125 ( | draw head ) 126 .snake/pos LDZ2 #0005 SFT2 .Screen/y DEO2 127 #0005 SFT2 .Screen/x DEO2 128 ;snake-icns/face .Screen/addr DEO2 129 [ LITr -Screen/sprite ] DEOr 130 JMP2r 131 132 @<draw-apple> ( color -- ) 133 .apple/x LDZ #0005 SFT2 .Screen/x DEO2 134 .apple/y LDZ #0005 SFT2 .Screen/y DEO2 135 STHk ;apple-chr ;fill-icn [ LITr 01 JCNr SWP2 POP2 ] .Screen/addr DEO2 136 .Screen/sprite DEO 137 JMP2r 138 139 @<draw-score> ( -- ) 140 #0010 DUP2 .Screen/x DEO2 141 .Screen/y DEO2 142 .snake/length LDZ 143 ( x0 ) DUP #04 SFT <draw-num> 144 ( >> ) 145 146 @<draw-num> ( num -- ) 147 #000f ROT AND #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2 148 [ LIT2 41 -Screen/sprite ] DEO 149 JMP2r 150 151 ( 152 @|assets ) 153 154 @snake-icns [ 7eff ffff ffff ff7e ] 155 &face [ 7eff ffdb ffe7 ff7e ] 156 157 @apple-chr [ 158 0000 76ff ffff 7e3c 1008 0000 0000 0000 ] 159 160 @fill-icn [ ffff ffff ffff ffff ] 161 162 @font-hex [ 163 007c 8282 8282 827c 0030 1010 1010 1010 164 007c 8202 7c80 80fe 007c 8202 1c02 827c 165 000c 1424 4484 fe04 00fe 8080 7c02 827c 166 007c 8280 fc82 827c 007c 8202 1e02 0202 167 007c 8282 7c82 827c 007c 8282 7e02 827c 168 007c 8202 7e82 827e 00fc 8282 fc82 82fc 169 007c 8280 8080 827c 00fc 8282 8282 82fc 170 007c 8280 f080 827c 007c 8280 f080 8080 ] 171