life.tal (5355B)
1 ( uxnemu life.rom ) 2 ( Any live cell with fewer than two live neighbours dies, as if by underpopulation. ) 3 ( Any live cell with two or three live neighbours lives on to the next generation. ) 4 ( Any live cell with more than three live neighbours dies, as if by overpopulation. ) 5 ( Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction. ) 6 7 |00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1 8 |10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1 9 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 10 |30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 11 |80 @Controller &vector $2 &button $1 &key $1 12 |90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1 13 |000 14 15 @world &count $2 16 @anchor &x $2 &y $2 &x2 $2 &y2 $2 17 18 |100 19 20 @on-reset ( -> ) 21 ( | theme ) 22 #02cf .System/r DEO2 23 #02ff .System/g DEO2 24 #024f .System/b DEO2 25 ( | resize ) 26 #00c0 DUP2 .Screen/width DEO2 27 .Screen/height DEO2 28 ( | vectors ) 29 ;on-frame .Screen/vector DEO2 30 ;on-mouse .Mouse/vector DEO2 31 ;on-control .Controller/vector DEO2 32 ( | glider ) 33 #0703 <set-cell> 34 #0704 <set-cell> 35 #0504 <set-cell> 36 #0705 <set-cell> 37 #0605 <set-cell> 38 ( | center ) 39 .Screen/width DEI2 #01 SFT2 #0040 SUB2 DUP2 .anchor/x STZ2 40 #007e ADD2 .anchor/x2 STZ2 41 .Screen/height DEI2 #01 SFT2 #0040 SUB2 DUP2 .anchor/y STZ2 42 #007e ADD2 .anchor/y2 STZ2 43 BRK 44 45 @on-frame ( -> ) 46 [ LIT2 00 -Mouse/state ] DEI EQU ?{ BRK } 47 #0000 .world/count STZ2 48 [ LIT &f $1 ] INCk ,&f STR 49 ( ) #03 AND #00 EQU ?{ BRK } 50 <run> 51 BRK 52 53 @on-mouse ( -> ) 54 [ LIT2 00 -Mouse/state ] DEI NEQ #42 ADD ;cursor-icn <update-cursor> 55 ( | on touch in rect ) 56 .Mouse/state DEI ?{ BRK } 57 .Mouse/x DEI2 .Mouse/y DEI2 .anchor within-rect ?{ BRK } 58 ( | paint ) 59 .Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP 60 ( ) .Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP <set-cell> 61 <redraw> 62 BRK 63 64 @on-control ( -> ) 65 .Controller/key DEI 66 ( ) DUP #20 NEQ ?{ 67 #0000 ;on-frame .Screen/vector DEI2 ORA ?{ SWP2 } 68 POP2 .Screen/vector DEO2 } 69 ( ) #1b NEQ ?{ ;MMU/clear1 .System/expansion DEO2 } 70 BRK 71 72 ( 73 @|core ) 74 75 @<run> ( -- ) 76 ;MMU/clear2 .System/expansion DEO2 77 #4000 78 &ver ( -- ) 79 DUP ,&y STR 80 #4000 81 &hor ( -- ) 82 DUP [ LIT &y $1 ] <run-cell> 83 INC GTHk ?&hor 84 POP2 INC GTHk ?&ver 85 POP2 86 ( move ) ;MMU/move21 .System/expansion DEO2 87 !<redraw> 88 89 @<run-cell> ( x y -- ) 90 ( x y ) DUP2 STH2k 91 ( neighbours ) get-neighbours 92 ( state ) STH2r get-index LDA #00 EQU ?&dead 93 DUP #02 LTH ?&dies 94 DUP #03 GTH ?&dies 95 POP !&save 96 &dies POP POP2 JMP2r 97 &dead ( -- ) 98 DUP #03 EQU ?&birth 99 POP POP2 JMP2r 100 &birth POP !&save 101 &save ( x y -- ) 102 STH2 103 #01 STH2r get-index #1000 ADD2 STA 104 .world/count LDZ2 INC2 .world/count STZ2 105 JMP2r 106 107 @get-index ( x y -- index* ) 108 ( y ) #3f AND #00 SWP #60 SFT2 ROT 109 ( x ) #3f AND #00 SWP ADD2 ;bank1 ADD2 JMP2r 110 111 @<set-cell> ( x y -- ) 112 get-index STH2 113 #01 STH2r STA 114 JMP2r 115 116 @get-neighbours ( x y -- neighbours ) 117 ,&y STR 118 ,&x STR 119 [ LITr 00 ] #0800 120 &l ( -- ) 121 #00 OVRk ADD2 ;&mask ADD2 LDA2 122 ( ) [ LIT &y $1 ] ADD SWP 123 ( ) [ LIT &x $1 ] ADD SWP get-index LDA [ STH ADDr ] 124 ( stop at 3 ) DUPr [ LITr 03 ] GTHr [ LITr _&end ] JCNr 125 ( ) INC GTHk ?&l 126 &end POP2 STHr JMP2r 127 &mask [ 128 ffff 00ff 01ff ff00 0100 ff01 0001 0101 ] 129 130 @within-rect ( x* y* rect -- flag ) 131 STH 132 ( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ?&skip 133 ( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip 134 SWP2 135 ( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip 136 ( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip 137 POP2 POP2 POPr #01 JMP2r 138 &skip POP2 POP2 POPr #00 JMP2r 139 140 ( 141 @|drawing ) 142 143 @<redraw> ( -- ) 144 ( | draw count ) 145 .anchor/x LDZ2 .Screen/x DEO2 146 .anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2 147 [ LIT2 01 -Screen/auto ] DEO 148 .world/count LDZ2 <draw-short> 149 ( | draw grid ) 150 [ LIT2 01 -Screen/auto ] DEO 151 .anchor/y LDZ2 .Screen/y DEO2 152 ;bank2 ;bank1 153 &l ( -- ) 154 DUP #3f AND ?{ 155 .Screen/y DEI2k INC2 INC2 ROT DEO2 156 .anchor/x LDZ2 .Screen/x DEO2 } 157 LDAk INC .Screen/pixel DEO 158 [ LIT2 00 -Screen/pixel ] DEO 159 INC2 GTH2k ?&l 160 POP2 POP2 JMP2r 161 162 @<draw-short> ( short* -- ) 163 SWP <draw-byte> 164 ( >> ) 165 166 @<draw-byte> ( byte color -- ) 167 DUP #04 SFT <draw-hex> 168 #0f AND 169 ( >> ) 170 171 @<draw-hex> ( char color -- ) 172 #00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2 173 [ LIT2 03 -Screen/sprite ] DEO 174 JMP2r 175 176 @<update-cursor> ( color addr* -- ) 177 [ LIT2 00 -Screen/auto ] DEO 178 ;fill-icn .Screen/addr DEO2 179 #40 <draw-cursor> 180 .Mouse/x DEI2 ,<draw-cursor>/x STR2 181 .Mouse/y DEI2 ,<draw-cursor>/y STR2 182 .Screen/addr DEO2 183 ( >> ) 184 185 @<draw-cursor> ( color -- ) 186 [ LIT2 &x $2 ] .Screen/x DEO2 187 [ LIT2 &y $2 ] .Screen/y DEO2 188 .Screen/sprite DEO 189 JMP2r 190 191 ( 192 @|assets ) 193 194 @MMU ( programs ) 195 &clear1 [ 01 1000 0000 =bank3 0000 =bank1 ] 196 &clear2 [ 01 1000 0000 =bank3 0000 =bank2 ] 197 &move21 [ 01 1000 0000 =bank2 0000 =bank1 ] 198 199 @cursor-icn [ 80c0 e0f0 f8e0 1000 ] 200 201 @fill-icn [ ffff ffff ffff ffff ] 202 203 @font-hex [ 204 7c82 8282 8282 7c00 3010 1010 1010 3800 205 7c82 027c 8080 fe00 7c82 021c 0282 7c00 206 2242 82fe 0202 0200 fe80 807c 0282 7c00 207 7c82 80fc 8282 7c00 fe82 0408 0810 1000 208 7c82 827c 8282 7c00 7c82 827e 0202 0200 209 7c82 82fe 8282 8200 fc82 82fc 8282 fc00 210 7c82 8080 8082 7c00 fc82 8282 8282 fc00 211 fe80 80f0 8080 fe00 fe80 80f0 8080 8000 ] 212 213 ( 214 @|memory ) 215 216 |8000 @bank1 $1000 217 218 @bank2 $1000 219 220 @bank3 $1000 221