(life.tal)Modernizing codebase

This commit is contained in:
Devine Lu Linvega 2024-03-02 19:57:59 -08:00
parent 259b9dcf56
commit d8b83e80b5
1 changed files with 151 additions and 197 deletions

View File

@ -1,8 +1,8 @@
( Game Of Life: ( uxnemu life.rom )
Any live cell with fewer than two live neighbours dies, as if by underpopulation. ( 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 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 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. ) ( 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 |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 |10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
@ -10,267 +10,221 @@
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $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 |80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1 |90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
|000
|0000 @world &count $2
@anchor &x $2 &y $2 &x2 $2 &y2 $2
@world &frame $1 &count $2 |100
@anchor &x $2 &y $2 &x2 $2 &y2 $2
@pointer &x $2 &y $2
|0100 ( -> ) @on-reset ( -> )
( | theme )
( theme )
#02cf .System/r DEO2 #02cf .System/r DEO2
#02ff .System/g DEO2 #02ff .System/g DEO2
#024f .System/b DEO2 #024f .System/b DEO2
( resize ) ( | resize )
#00c0 #00c0 DUP2 .Screen/width DEO2
DUP2 .Screen/width DEO2 .Screen/height DEO2
.Screen/height DEO2 ( | vectors )
( vectors )
;on-frame .Screen/vector DEO2 ;on-frame .Screen/vector DEO2
;on-mouse .Mouse/vector DEO2 ;on-mouse .Mouse/vector DEO2
;on-control .Controller/vector DEO2 ;on-control .Controller/vector DEO2
( glider ) ( | glider )
#0703 set-cell #0703 <set-cell>
#0704 set-cell #0704 <set-cell>
#0504 set-cell #0504 <set-cell>
#0705 set-cell #0705 <set-cell>
#0605 set-cell #0605 <set-cell>
( center ) ( | center )
.Screen/width DEI2 #01 SFT2 #0040 SUB2 .Screen/width DEI2 #01 SFT2 #0040 SUB2 DUP2 .anchor/x STZ2
DUP2 .anchor/x STZ2 #007e ADD2 .anchor/x2 STZ2
#007e ADD2 .anchor/x2 STZ2 .Screen/height DEI2 #01 SFT2 #0040 SUB2 DUP2 .anchor/y STZ2
.Screen/height DEI2 #01 SFT2 #0040 SUB2 #007e ADD2 .anchor/y2 STZ2
DUP2 .anchor/y STZ2 BRK
#007e ADD2 .anchor/y2 STZ2
BRK
@on-frame ( -> ) @on-frame ( -> )
.Mouse/state DEI #00 EQU ?{ BRK }
.Mouse/state DEI #00 EQU #01 JCN [ BRK ]
#0000 .world/count STZ2 #0000 .world/count STZ2
.world/frame LDZ INC [ LIT &f $1 ] INCk ,&f STR
DUP .world/frame STZ ( ) #03 AND #00 EQU ?{ BRK }
#03 AND #00 EQU #01 JCN [ BRK ] <run>
run &paused BRK
&paused
BRK
@on-mouse ( -> ) @on-mouse ( -> )
[ LIT2 00 -Mouse/state ] DEI NEQ #42 ADD ;cursor-icn <update-cursor>
( clear last cursor ) ( | on touch in rect )
;cursor .Screen/addr DEO2 .Mouse/state DEI ?{ BRK }
.pointer/x LDZ2 .Screen/x DEO2 .Mouse/x DEI2 .Mouse/y DEI2 .anchor within-rect ?{ BRK }
.pointer/y LDZ2 .Screen/y DEO2 ( | paint )
#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 [ JMP BRK ]
( paint )
.Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP .Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP
.Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP ( ) .Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP <set-cell>
set-cell <draw-grid>
( draw ) BRK
draw-grid
BRK
@on-control ( -> ) @on-control ( -> )
( | toggle play )
.Controller/key DEI #20 NEQ ?{
;on-frame #0000 .Screen/vector DEI2 EQU2k ?{ ROT2 }
POP2 POP2 .Screen/vector DEO2 }
.Controller/button DEI #08 NEQ ?{ ;bank1 #0400 mclr }
BRK
( toggle play ) (
.Controller/key DEI #20 NEQ ?&no-toggle @|core )
;on-frame
.Screen/vector DEI2 ;on-frame/paused EQU2 ?&swap
POP2 ;on-frame/paused
&swap
.Screen/vector DEO2
&no-toggle
( clear on home )
.Controller/button DEI #08 NEQ ?&no-reset
;bank1 #0400 mclr
&no-reset
BRK @<run> ( -- )
( | clear buffer )
@run ( -- )
( clear buffer )
;bank2 #1000 mclr ;bank2 #1000 mclr
( run grid ) ( | <run> grid )
#4000 #4000
&ver &ver ( -- )
STHk STHk #4000
#4000 &hor ( -- )
&hor DUP STHkr <run-cell>
DUP STHkr run-cell INC GTHk ?&hor
INC GTHk ?&hor POP2 POPr INC GTHk ?&ver
POP2
POPr
INC GTHk ?&ver
POP2 POP2
( move buffer ) ( | move buffer )
;bank2 ;bank1 #1000 mcpy ;bank2 ;bank1 #1000 mcpy
( draw ) ( | draw )
!draw-grid !<draw-grid>
@run-cell ( x y -- )
@<run-cell> ( x y -- )
( x y ) DUP2k ( x y ) DUP2k
( neighbours ) get-neighbours ( neighbours ) get-neighbours
( state ) ROT ROT get-cell ( state ) ROT ROT get-cell #00 EQU ?&dead
#00 EQU ?&dead DUP #02 LTH ?&dies
DUP #02 LTH ?&dies DUP #03 GTH ?&dies
DUP #03 GTH ?&dies POP !&save
POP !&save &dies POP POP2 JMP2r
&dies POP POP2 JMP2r &dead ( -- )
&dead DUP #03 EQU ?&birth
DUP #03 EQU ?&birth POP POP2 JMP2r POP POP2 JMP2r
&birth POP &birth POP !&save
!&save
&save ( x y -- ) &save ( x y -- )
STH2 #01 STH2r get-index #1000 ADD2 STA STH2
#01 STH2r get-index #1000 ADD2 STA
.world/count LDZ2 INC2 .world/count STZ2 .world/count LDZ2 INC2 .world/count STZ2
JMP2r JMP2r
@get-index ( x y -- index* ) @get-index ( x y -- index* )
( y ) #3f AND #00 SWP #60 SFT2 ( y ) #3f AND #00 SWP #60 SFT2
( x ) ROT #3f AND #00 SWP ADD2 ( x ) ROT #3f AND #00 SWP ADD2 ;bank1 ADD2 JMP2r
;bank1 ADD2
JMP2r @<set-cell> ( x y -- )
STH2
@set-cell ( x y -- ) #01 STH2r get-index STA
JMP2r
STH2 #01 STH2r get-index STA
JMP2r
@get-cell ( x y -- cell ) @get-cell ( x y -- cell )
get-index LDA JMP2r
get-index LDA
JMP2r
@get-neighbours ( x y -- neighbours ) @get-neighbours ( x y -- neighbours )
,&origin STR2 ,&origin STR2
LITr 00 LITr 00 #0800
#0800 &loop ( -- )
&loop #00 OVRk ADD2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ] ROT ADD STH
#00 OVRk ADD2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ] ADD STHr get-cell STH
ROT ADD STH ADD STHr get-cell STH ADDr ADDr INC GTHk ?&loop
INC GTHk ?&loop POP2 STHr JMP2r
POP2 &mask [
STHr ffff 00ff 01ff ff00 0100 ff01 0001 0101 ]
JMP2r (
&mask [ ffff 00ff 01ff ff00 0100 ff01 0001 0101 ] @|drawing )
@draw-grid ( -- ) @<draw-grid> ( -- )
( draw cell count ) .anchor/x LDZ2 .Screen/x DEO2
( draw cell count )
.anchor/x LDZ2 .Screen/x DEO2
.anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2 .anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2
#01 .Screen/auto DEO #01 .Screen/auto DEO
.world/count LDZ2 draw-short .world/count LDZ2 <draw-short>
#00 .Screen/auto DEO #00 .Screen/auto DEO
#4000 #4000
&ver &ver ( -- )
#00 OVRk ADD2 .anchor/y LDZ2 ADD2 .Screen/y DEO2 #00 OVRk ADD2 .anchor/y LDZ2 ADD2 .Screen/y DEO2
STHk STHk #4000
#4000 &hor ( -- )
&hor #00 OVRk ADD2 .anchor/x LDZ2 ADD2 .Screen/x DEO2
#00 OVRk ADD2 .anchor/x LDZ2 ADD2 .Screen/x DEO2 DUP STHkr get-cell INC .Screen/pixel DEO
DUP STHkr get-cell INC .Screen/pixel DEO INC GTHk ?&hor
INC GTHk ?&hor POP2 POPr INC GTHk ?&ver
POP2 POP2 JMP2r
POPr
INC GTHk ?&ver
POP2
JMP2r @<draw-short> ( short* -- )
SWP <draw-byte>
@draw-short ( short* -- ) @<draw-byte> ( byte color -- )
DUP #04 SFT <draw-hex>
SWP draw-byte #0f AND
@draw-byte ( byte color -- )
DUP #04 SFT draw-hex #0f AND
@draw-hex ( char color -- )
@<draw-hex> ( char color -- )
#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2 #00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
[ LIT2 03 -Screen/sprite ] DEO [ LIT2 03 -Screen/sprite ] DEO
JMP2r
JMP2r @<update-cursor> ( color addr* -- )
[ LIT2 00 -Screen/auto ] DEO
;fill-icn .Screen/addr DEO2
#40 <draw-cursor>
.Mouse/x DEI2 ,<draw-cursor>/x STR2
.Mouse/y DEI2 ,<draw-cursor>/y STR2
.Screen/addr DEO2
@<draw-cursor> ( color -- )
[ LIT2 &x $2 ] .Screen/x DEO2
[ LIT2 &y $2 ] .Screen/y DEO2
.Screen/sprite DEO
JMP2r
@within-rect ( x* y* rect -- flag ) @within-rect ( x* y* rect -- flag )
STH STH
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ?&skip ( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ?&skip
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip ( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip
SWP2 SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip ( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip ( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip
POP2 POP2 POPr POP2 POP2 POPr #01 JMP2r
#01 &skip POP2 POP2 POPr #00 JMP2r
JMP2r
&skip (
POP2 POP2 POPr #00 JMP2r @|stdlib )
@mclr ( addr* len* -- ) @mclr ( addr* len* -- )
OVR2 ADD2 SWP2 OVR2 ADD2 SWP2
&loop &loop ( -- )
STH2k #00 STH2r STA STH2k #00 STH2r STA
INC2 GTH2k ?&loop INC2 GTH2k ?&loop
POP2 POP2 POP2 POP2 JMP2r
JMP2r
@mcpy ( src* dst* len* -- ) @mcpy ( src* dst* len* -- )
SWP2 STH2 SWP2 STH2
OVR2 ADD2 SWP2 OVR2 ADD2 SWP2
&loop &loop ( -- )
LDAk STH2kr STA INC2r LDAk STH2kr STA
INC2 GTH2k ?&loop INC2r INC2 GTH2k ?&loop
POP2 POP2 POP2 POP2 POP2r JMP2r
POP2r
JMP2r (
@|assets )
@cursor [ @cursor-icn [ 80c0 e0f0 f8e0 1000 ]
80c0 e0f0 f8e0 1000 ]
@fill-icn [ ffff ffff ffff ffff ]
@font-hex [ @font-hex [
7c82 8282 8282 7c00 7c82 8282 8282 7c00 3010 1010 1010 3800
3010 1010 1010 3800 7c82 027c 8080 fe00 7c82 021c 0282 7c00
7c82 027c 8080 fe00 2242 82fe 0202 0200 fe80 807c 0282 7c00
7c82 021c 0282 7c00 7c82 80fc 8282 7c00 fe82 0408 0810 1000
2242 82fe 0202 0200 7c82 827c 8282 7c00 7c82 827e 0202 0200
fe80 807c 0282 7c00 7c82 82fe 8282 8200 fc82 82fc 8282 fc00
7c82 80fc 8282 7c00 7c82 8080 8082 7c00 fc82 8282 8282 fc00
fe82 0408 0810 1000 fe80 80f0 8080 fe00 fe80 80f0 8080 8000 ]
7c82 827c 8282 7c00
7c82 827e 0202 0200 (
7c82 82fe 8282 8200 @|memory )
fc82 82fc 8282 fc00
7c82 8080 8082 7c00 @bank1 $1000
fc82 8282 8282 fc00
fe80 80f0 8080 fe00 @bank2
fe80 80f0 8080 8000 ]
@bank1 $1000 @bank2