Add a version of life.tal with an infinite loop.

This commit is contained in:
Andrew Alderwick 2022-03-27 13:57:52 +01:00
parent 0e7ebb69e6
commit 91125f33a2
1 changed files with 287 additions and 0 deletions

View File

@ -0,0 +1,287 @@
( Copy of demos/life.tal, but with in infinite loop in the Screen vector )
( Game Of Life:
Any live cell with fewer than two live neighbours dies, as if by underpopulation.
Any live cell with two or three live neighbours lives on to the next generation.
Any live cell with more than three live neighbours dies, as if by overpopulation.
Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction. )
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &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
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
|0000
@world &frame $1 &count $2
@anchor &x $2 &y $2 &x2 $2 &y2 $2
@pointer &x $2 &y $2
|0100 ( -> )
( theme )
#02cf .System/r DEO2
#02ff .System/g DEO2
#024f .System/b DEO2
( resize )
#00c0 .Screen/width DEO2
#00c0 .Screen/height DEO2
( vectors )
;on-frame .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-control .Controller/vector DEO2
( glider )
#07 #03 ;set-cell JSR2
#07 #04 ;set-cell JSR2
#05 #04 ;set-cell JSR2
#07 #05 ;set-cell JSR2
#06 #05 ;set-cell JSR2
( center )
.Screen/width DEI2 #01 SFT2 #0040 SUB2
DUP2 .anchor/x STZ2
#007e ADD2 .anchor/x2 STZ2
.Screen/height DEI2 #01 SFT2 #0040 SUB2
DUP2 .anchor/y STZ2
#007e ADD2 .anchor/y2 STZ2
BRK
@on-frame ( -> )
( Because an interrupted infinite loop will (almost certainly) leave
items on the stacks, clear both stacks here. )
#00 .System/wst DEO
#00 .System/rst DEO
.Mouse/state DEI #00 EQU #01 JCN [ BRK ]
#0000 .world/count STZ2
.world/frame LDZ INC
DUP .world/frame STZ
#03 AND #00 EQU #01 JCN [ BRK ]
&infinite-loop
;run JSR2
,&infinite-loop JMP
&paused
BRK
@on-mouse ( -> )
( clear last cursor )
;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state )
#42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
( on touch in rect )
.Mouse/state DEI #00 NEQ #01 JCN [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .anchor ;within-rect JSR2 JMP [ BRK ]
( paint )
.Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP
.Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP
;set-cell JSR2
( draw )
;draw-grid JSR2
BRK
@on-control ( -> )
( toggle play )
.Controller/key DEI #20 NEQ ,&no-toggle JCN
;on-frame
.Screen/vector DEI2 ;on-frame/paused EQU2 ,&swap JCN
POP2 ;on-frame/paused
&swap
.Screen/vector DEO2
&no-toggle
( clear on home )
.Controller/button DEI #08 NEQ ,&no-reset JCN
;bank1 #0400 ;mclr JSR2
&no-reset
BRK
@run ( -- )
( clear buffer )
;bank2 #1000 ;mclr JSR2
( run grid )
#4000
&ver
STHk
#4000
&hor
DUP STHkr ,run-cell JSR
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
( move buffer )
;bank2 ;bank1 #1000 ;mcpy JSR2
( draw )
;draw-grid JSR2
JMP2r
@run-cell ( x y -- )
( x y ) DUP2
( neighbours ) DUP2 ;get-neighbours JSR2
( state ) ROT ROT ;get-cell JSR2
#00 EQU ,&dead JCN
DUP #02 LTH ,&dies JCN
DUP #03 GTH ,&dies JCN
POP ,&save JSR JMP2r
&dies POP POP2 JMP2r
&dead
DUP #03 EQU ,&birth JCN POP POP2 JMP2r
&birth POP ,&save JSR JMP2r
JMP2r
&save ( x y -- )
STH2 #01 STH2r ,get-index JSR [ #1000 ADD2 ] STA
.world/count LDZ2 INC2 .world/count STZ2
JMP2r
@get-index ( x y -- index* )
( y ) #3f AND #00 SWP #60 SFT2
( x ) ROT #3f AND #00 SWP ADD2
;bank1 ADD2
JMP2r
@set-cell ( x y -- )
STH2 #01 STH2r ,get-index JSR STA
JMP2r
@get-cell ( x y -- cell )
,get-index JSR LDA
JMP2r
@get-neighbours ( x y -- neighbours )
,&origin STR2
LITr 00
#0800
&loop
#00 OVR #10 SFT2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ]
ROT ADD STH ADD STHr ;get-cell JSR2 STH ADDr
INC GTHk ,&loop JCN
POP2
STHr
JMP2r
&mask ffff 00ff 01ff ff00 0100 ff01 0001 0101
@draw-grid ( -- )
( draw cell count )
.anchor/x LDZ2 .Screen/x DEO2
.anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2
#01 .Screen/auto DEO
.world/count LDZ2 ;draw-short JSR2
#00 .Screen/auto DEO
#4000
&ver
#00 OVR #10 SFT2 .anchor/y LDZ2 ADD2 .Screen/y DEO2
STHk
#4000
&hor
#00 OVR #10 SFT2 .anchor/x LDZ2 ADD2 .Screen/x DEO2
DUP STHkr ;get-cell JSR2 INC .Screen/pixel DEO
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
JMP2r
@draw-short ( short* -- )
SWP ,draw-byte JSR
@draw-byte ( byte color -- )
DUP #04 SFT ,draw-hex JSR #0f AND
@draw-hex ( char color -- )
#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
#03 .Screen/sprite DEO
JMP2r
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
JMP2r
&skip
POP2 POP2 POPr
#00
JMP2r
@mclr ( addr* len* -- )
OVR2 ADD2 SWP2
&loop
STH2k #00 STH2r STA
INC2 GTH2k ,&loop JCN
POP2 POP2
JMP2r
@mcpy ( src* dst* len* -- )
SWP2 STH2
OVR2 ADD2 SWP2
&loop
LDAk STH2kr STA INC2r
INC2 GTH2k ,&loop JCN
POP2 POP2
POP2r
JMP2r
@cursor
80c0 e0f0 f8e0 1000
@font-hex
7c82 8282 8282 7c00
3010 1010 1010 3800
7c82 027c 8080 fe00
7c82 021c 0282 7c00
2242 82fe 0202 0200
fe80 807c 0282 7c00
7c82 80fc 8282 7c00
fe82 0408 0810 1000
7c82 827c 8282 7c00
7c82 827e 0202 0200
7c82 82fe 8282 8200
fc82 82fc 8282 fc00
7c82 8080 8082 7c00
fc82 8282 8282 fc00
fe80 80f0 8080 fe00
fe80 80f0 8080 8000
@bank1 $1000 @bank2