(wireworld.tal) Optimized morph

This commit is contained in:
neauoire 2022-01-22 14:48:07 -08:00
parent a17b442fe2
commit 4ad5c8f9fa
1 changed files with 27 additions and 24 deletions

View File

@ -29,6 +29,7 @@
%WIDTH { #40 } %WIDTH { #40 }
%HEIGHT { #40 } %HEIGHT { #40 }
%LENGTH { #1000 }
( devices ) ( devices )
@ -74,7 +75,7 @@ BRK
.timer/frame LDZk .timer/frame LDZk
#03 AND ,&no-run JCN #03 AND ,&no-run JCN
;run JSR2 ;run JSR2
;future-world ;past-world #4000 ;mcpy JSR2 ;past-world LENGTH ++ ;past-world LENGTH ;mcpy JSR2
;redraw JSR2 ;redraw JSR2
&no-run &no-run
LDZk INC SWP STZ LDZk INC SWP STZ
@ -144,7 +145,7 @@ RTN
&hor &hor
( x,y ) DUP STHkr ( x,y ) DUP STHkr
( cell ) DUP2 ,get-addr JSR STH2k LDA ( cell ) DUP2 ,get-addr JSR STH2k LDA
( transform ) ,transform JSR STH2r ( future ) #4000 ++ STA ( transform ) ,transform JSR STH2r ( future ) LENGTH ++ STA
INC GTHk ,&hor JCN INC GTHk ,&hor JCN
POP2 POP2
POPr POPr
@ -153,33 +154,35 @@ RTN
RTN RTN
@transform ( xy cell -- cell )
DUP #03 ! ,&no-head JCN POP POP2 #02 RTN &no-head
DUP #02 ! ,&no-tail JCN POP POP2 #01 RTN &no-tail
DUP #01 ! ,&no-cond JCN POP ,morph JSR #02 * INC RTN &no-cond
NIP NIP
RTN
@get-addr ( x y -- addr* ) @get-addr ( x y -- addr* )
TOS [ #00 WIDTH ] ** ROT TOS ++ ;past-world ++ TOS [ #00 WIDTH ] ** ROT TOS ++ ;past-world ++
RTN RTN
@morph ( xy -- bool ) @transform ( xy cell -- cell )
DUP #00 ! ,&no-null JCN NIP NIP RTN &no-null
DUP #03 ! ,&no-head JCN POP POP2 #02 RTN &no-head
DUP #02 ! ,&no-tail JCN POP POP2 #01 RTN &no-tail
DUP #01 ! ,&no-cond JCN POP
LITr 00 LITr 00
DUP2 SWP #01 - SWP #01 - ,get-addr JSR LDA #03 ! JMP INCr DUP2 #01 - ,get-addr JSR
DUP2 #01 - ,get-addr JSR LDA #03 ! JMP INCr ( tl ) #0001 -- LDAk #03 ! JMP INCr
DUP2 SWP INC SWP #01 - ,get-addr JSR LDA #03 ! JMP INCr ( tc ) INC2 LDAk #03 ! JMP INCr
DUP2 SWP #01 - SWP ,get-addr JSR LDA #03 ! JMP INCr ( tr ) INC2 LDA #03 ! JMP INCr
DUP2 SWP INC SWP ,get-addr JSR LDA #03 ! JMP INCr DUP2 ,get-addr JSR
DUP2 SWP #01 - SWP INC ,get-addr JSR LDA #03 ! JMP INCr ( ml ) #0001 -- LDAk #03 ! JMP INCr
DUP2 INC ,get-addr JSR LDA #03 ! JMP INCr ( mr ) INC2 INC2 LDA #03 ! JMP INCr
SWP INC SWP INC ,get-addr JSR LDA #03 ! JMP INCr INC ,get-addr JSR
( bl ) #0001 -- LDAk #03 ! JMP INCr
( bc ) INC2 LDAk #03 ! JMP INCr
( br ) INC2 LDA #03 ! JMP INCr
STHkr #02 = STHr #01 = #0000 >> STHkr #02 = STHr #01 = #0000 >>
#02 * INC RTN
&no-cond
( unknown )
NIP NIP
RTN RTN
@ -206,4 +209,4 @@ JMP2r
What do I do? What do I do?
How do I find peace? ) How do I find peace? )
@past-world $4000 @future-world @past-world