(life.tal) Migrated to immediate opcodes

This commit is contained in:
Devine Lu Linvega 2023-03-05 20:58:55 -08:00
parent 1245b44d2a
commit d4ee3a4760
1 changed files with 66 additions and 69 deletions

View File

@ -24,18 +24,19 @@
#02ff .System/g DEO2 #02ff .System/g DEO2
#024f .System/b DEO2 #024f .System/b DEO2
( resize ) ( resize )
#00c0 .Screen/width DEO2 #00c0
#00c0 .Screen/height DEO2 DUP2 .Screen/width 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 JSR2 #0703 set-cell
#0704 ;set-cell JSR2 #0704 set-cell
#0504 ;set-cell JSR2 #0504 set-cell
#0705 ;set-cell JSR2 #0705 set-cell
#0605 ;set-cell JSR2 #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
@ -47,19 +48,19 @@
BRK BRK
@on-frame ( -> ) @on-frame ( -> )
.Mouse/state DEI #00 EQU #01 JCN [ BRK ] .Mouse/state DEI #00 EQU #01 JCN [ BRK ]
#0000 .world/count STZ2 #0000 .world/count STZ2
.world/frame LDZ INC .world/frame LDZ INC
DUP .world/frame STZ DUP .world/frame STZ
#03 AND #00 EQU #01 JCN [ BRK ] #03 AND #00 EQU #01 JCN [ BRK ]
;run JSR2 run
&paused &paused
BRK BRK
@on-mouse ( -> ) @on-mouse ( -> )
( clear last cursor ) ( clear last cursor )
;cursor .Screen/addr DEO2 ;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2 .pointer/x LDZ2 .Screen/x DEO2
@ -72,29 +73,29 @@ BRK
#42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO #42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
( on touch in rect ) ( on touch in rect )
.Mouse/state DEI #00 NEQ #01 JCN [ BRK ] .Mouse/state DEI #00 NEQ #01 JCN [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .anchor ;within-rect JSR2 JMP [ BRK ] .Mouse/x DEI2 .Mouse/y DEI2 .anchor within-rect [ JMP BRK ]
( paint ) ( 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 JSR2 set-cell
( draw ) ( draw )
;draw-grid JSR2 draw-grid
BRK BRK
@on-control ( -> ) @on-control ( -> )
( toggle play ) ( toggle play )
.Controller/key DEI #20 NEQ ,&no-toggle JCN .Controller/key DEI #20 NEQ ?&no-toggle
;on-frame ;on-frame
.Screen/vector DEI2 ;on-frame/paused EQU2 ,&swap JCN .Screen/vector DEI2 ;on-frame/paused EQU2 ?&swap
POP2 ;on-frame/paused POP2 ;on-frame/paused
&swap &swap
.Screen/vector DEO2 .Screen/vector DEO2
&no-toggle &no-toggle
( clear on home ) ( clear on home )
.Controller/button DEI #08 NEQ ,&no-reset JCN .Controller/button DEI #08 NEQ ?&no-reset
;bank1 #0400 ;mclr JSR2 ;bank1 #0400 mclr
&no-reset &no-reset
BRK BRK
@ -102,88 +103,87 @@ BRK
@run ( -- ) @run ( -- )
( clear buffer ) ( clear buffer )
;bank2 #1000 ;mclr JSR2 ;bank2 #1000 mclr
( run grid ) ( run grid )
#4000 #4000
&ver &ver
STHk STHk
#4000 #4000
&hor &hor
DUP STHkr ,run-cell JSR DUP STHkr run-cell
INC GTHk ,&hor JCN INC GTHk ?&hor
POP2 POP2
POPr POPr
INC GTHk ,&ver JCN INC GTHk ?&ver
POP2 POP2
( move buffer ) ( move buffer )
;bank2 ;bank1 #1000 ;mcpy JSR2 ;bank2 ;bank1 #1000 mcpy
( draw ) ( draw )
;draw-grid ( .. ) !draw-grid
JMP2
@run-cell ( x y -- ) @run-cell ( x y -- )
( x y ) DUP2k ( x y ) DUP2k
( neighbours ) ;get-neighbours JSR2 ( neighbours ) get-neighbours
( state ) ROT ROT ;get-cell JSR2 ( state ) ROT ROT get-cell
#00 EQU ,&dead JCN #00 EQU ?&dead
DUP #02 LTH ,&dies JCN DUP #02 LTH ?&dies
DUP #03 GTH ,&dies JCN DUP #03 GTH ?&dies
POP ;&save JMP2 POP !&save
&dies POP POP2 JMP2r &dies POP POP2 JMP2r
&dead &dead
DUP #03 EQU ,&birth JCN POP POP2 JMP2r DUP #03 EQU ?&birth POP POP2 JMP2r
&birth POP ;&save ( .. ) &birth POP
JMP2 !&save
&save ( x y -- )
STH2 #01 STH2r ,get-index JSR [ #1000 ADD2 ] STA &save ( x y -- )
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 ;bank1 ADD2
JMP2r JMP2r
@set-cell ( x y -- ) @set-cell ( x y -- )
STH2 #01 STH2r ,get-index JSR STA STH2 #01 STH2r get-index STA
JMP2r JMP2r
@get-cell ( x y -- cell ) @get-cell ( x y -- cell )
,get-index JSR LDA get-index LDA
JMP2r 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 ] #00 OVRk ADD2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ]
ROT ADD STH ADD STHr ;get-cell JSR2 STH ADDr ROT ADD STH ADD STHr get-cell STH ADDr
INC GTHk ,&loop JCN INC GTHk ?&loop
POP2 POP2
STHr STHr
JMP2r JMP2r
&mask ffff 00ff 01ff ff00 0100 ff01 0001 0101 &mask [ ffff 00ff 01ff ff00 0100 ff01 0001 0101 ]
@draw-grid ( -- ) @draw-grid ( -- )
( draw cell count ) ( draw cell count )
.anchor/x LDZ2 .Screen/x DEO2 .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 JSR2 .world/count LDZ2 draw-short
#00 .Screen/auto DEO #00 .Screen/auto DEO
#4000 #4000
&ver &ver
@ -192,53 +192,50 @@ JMP2r
#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 JSR2 INC .Screen/pixel DEO DUP STHkr get-cell INC .Screen/pixel DEO
INC GTHk ,&hor JCN INC GTHk ?&hor
POP2 POP2
POPr POPr
INC GTHk ,&ver JCN INC GTHk ?&ver
POP2 POP2
JMP2r JMP2r
@draw-short ( short* -- ) @draw-short ( short* -- )
SWP ,draw-byte JSR SWP draw-byte
@draw-byte ( byte color -- ) @draw-byte ( byte color -- )
DUP #04 SFT ,draw-hex JSR #0f AND 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
#03 .Screen/sprite DEO [ LIT2 03 -Screen/sprite ] DEO
JMP2r 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 JCN ( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ?&skip
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN ( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ?&skip
SWP2 SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN ( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ?&skip
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN ( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ?&skip
POP2 POP2 POPr POP2 POP2 POPr
#01 #01
JMP2r JMP2r
&skip &skip
POP2 POP2 POPr POP2 POP2 POPr #00 JMP2r
#00
JMP2r
@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 JCN INC2 GTH2k ?&loop
POP2 POP2 POP2 POP2
JMP2r JMP2r
@ -249,16 +246,16 @@ JMP2r
OVR2 ADD2 SWP2 OVR2 ADD2 SWP2
&loop &loop
LDAk STH2kr STA INC2r LDAk STH2kr STA INC2r
INC2 GTH2k ,&loop JCN INC2 GTH2k ?&loop
POP2 POP2 POP2 POP2
POP2r POP2r
JMP2r JMP2r
@cursor @cursor [
80c0 e0f0 f8e0 1000 80c0 e0f0 f8e0 1000 ]
@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 027c 8080 fe00
@ -274,6 +271,6 @@ JMP2r
7c82 8080 8082 7c00 7c82 8080 8082 7c00
fc82 8282 8282 fc00 fc82 8282 8282 fc00
fe80 80f0 8080 fe00 fe80 80f0 8080 fe00
fe80 80f0 8080 8000 fe80 80f0 8080 8000 ]
@bank1 $1000 @bank2 @bank1 $1000 @bank2