~rabbits/orca-toy

5538f70863fcfbc297caa487072cd840aa3ea249 — neauoire 11 months ago 7d556a4 
Removed remaining macros
patch browse .tar.gz 
1 files changed, 80 insertions(+), 83 deletions(-)

M src/main.tal

M src/main.tal => src/main.tal +80 -83
@@ 1,8 1,5 @@
( Orca )

%-  { SUB } 
%-- { SUB2 } 

%CHAR-NULL  { #00 } %CHAR-LINE  { #0a }
%CHAR-HASH  { #23 } %CHAR-BANG  { #2a }
%CHAR-DOT   { #2e } %CHAR-SLASH { #2f }


@@ 42,7 39,7 @@
@variables $24
@signal &midi $1

|0100
|0100 ( -> )

	( theme )
	#0f38 .System/r DEO2


@@ 69,13 66,13 @@

	( set grid size )
	.Screen/width DEI2
		DUP2 #03 SFT2 NIP #03 - .grid/width STZ
		DUP2 #01 SFT2 .grid/width LDZ #01 SFT INC #00 SWP #30 SFT2 -- #0004 ADD2 .grid/x1 STZ2
		DUP2 #03 SFT2 NIP #03 SUB .grid/width STZ
		DUP2 #01 SFT2 .grid/width LDZ #01 SFT INC #00 SWP #30 SFT2 SUB2 #0004 ADD2 .grid/x1 STZ2
		#01 SFT2 .grid/width LDZ #01 SFT #00 SWP #30 SFT2 ADD2 #0004 ADD2 .grid/x2 STZ2
	.Screen/height DEI2
		DUP2 #04 SFT2 NIP #03 - .grid/height STZ
		DUP2 #01 SFT2 .grid/height LDZ #01 SFT INC #00 SWP #40 SFT2 -- #0004 -- .grid/y1 STZ2
		#01 SFT2 .grid/height LDZ #01 SFT #00 SWP #40 SFT2 ADD2 #0008 -- .grid/y2 STZ2
		DUP2 #04 SFT2 NIP #03 SUB .grid/height STZ
		DUP2 #01 SFT2 .grid/height LDZ #01 SFT INC #00 SWP #40 SFT2 SUB2 #0004 SUB2 .grid/y1 STZ2
		#01 SFT2 .grid/height LDZ #01 SFT #00 SWP #40 SFT2 ADD2 #0008 SUB2 .grid/y2 STZ2
	#00 .grid/height LDZ #00 .grid/width LDZ MUL2 .grid/length STZ2

	( set toolbar size )


@@ 90,7 87,7 @@
	( theme support )
	;load-theme JSR2
	( draw once )
	.grid/x2 LDZ2 #0020 -- .Screen/x DEO2
	.grid/x2 LDZ2 #0020 SUB2 .Screen/x DEO2
	.toolbar/y1 LDZ2 .Screen/y DEO2
	;font/load #01 ;draw-sprite JSR2
	;font/make #01 ;draw-sprite JSR2


@@ 161,7 158,7 @@ BRK
@on-button-trap ( -> )

	#00 ;draw-filepath JSR2
	.Controller/key DEI DUP #0d EQU #03 MUL - ,capture-trap JSR
	.Controller/key DEI DUP #0d EQU #03 MUL SUB ,capture-trap JSR
	#01 ;draw-filepath JSR2

BRK


@@ 289,7 286,7 @@ BRK
	;cursor-icn .Screen/addr DEO2
	#41 [ .Mouse/state DEI #00 NEQ #10 SFT ] ADD .Screen/sprite DEO
	( route )
	.Mouse/y DEI2 .toolbar/y1 LDZ2 -- #04 SFT2 #0000 EQU2 ;on-mouse-toolbar JCN2
	.Mouse/y DEI2 .toolbar/y1 LDZ2 SUB2 #04 SFT2 #0000 EQU2 ;on-mouse-toolbar JCN2
	.Mouse/x DEI2 .Mouse/y DEI2 .grid ;within-rect JSR2 ,on-mouse-grid JCN

BRK


@@ 300,14 297,14 @@ BRK
		DUP2 #0000 EQU2 ,&end JCN
		( on down )
		DUP2 #0100 NEQ2 ,&no-down JCN
			.Mouse/x DEI2 .grid/x1 LDZ2 -- #03 SFT2 NIP
			.Mouse/y DEI2 .grid/y1 LDZ2 -- #04 SFT2 NIP
			.Mouse/x DEI2 .grid/x1 LDZ2 SUB2 #03 SFT2 NIP
			.Mouse/y DEI2 .grid/y1 LDZ2 SUB2 #04 SFT2 NIP
				;set-sel-from JSR2
			,&end JMP
			&no-down
		( on release )
		.Mouse/x DEI2 .grid/x1 LDZ2 -- #03 SFT2 NIP
		.Mouse/y DEI2 .grid/y1 LDZ2 -- #04 SFT2 NIP
		.Mouse/x DEI2 .grid/x1 LDZ2 SUB2 #03 SFT2 NIP
		.Mouse/y DEI2 .grid/y1 LDZ2 SUB2 #04 SFT2 NIP
			;set-sel-to JSR2
	&end
	POP ,&last STR


@@ 319,14 316,14 @@ BRK
	( skip ) .Mouse/state DEI #01 JCN BRK

	( left-side )
	.Mouse/x DEI2 .grid/x1 LDZ2 -- #03 SFT2 NIP
	.Mouse/x DEI2 .grid/x1 LDZ2 SUB2 #03 SFT2 NIP
	[ #05 ] GTHk NIP ,&no-insert JCN ;toggle-insert JSR2 POP BRK &no-insert
	[ #09 ] GTHk NIP ,&no-pause JCN ;toggle-play JSR2 POP BRK &no-pause
	[ #0d ] GTHk NIP ,&no-speed JCN [ .Mouse/state DEI #01 EQU #10 SFT #01 - ] ;mod-speed JSR2 #00 .Mouse/state DEO POP BRK &no-speed
	[ #0e ] GTHk NIP OVR .grid/width LDZ SWP - #06 GTH #0101 NEQ2 ,&no-rename JCN ;trap JSR2 &no-rename
	[ #0d ] GTHk NIP ,&no-speed JCN [ .Mouse/state DEI #01 EQU #10 SFT #01 SUB ] ;mod-speed JSR2 #00 .Mouse/state DEO POP BRK &no-speed
	[ #0e ] GTHk NIP OVR .grid/width LDZ SWP SUB #06 GTH #0101 NEQ2 ,&no-rename JCN ;trap JSR2 &no-rename
	POP
	( right-side )
	.grid/x2 LDZ2 .Mouse/x DEI2 -- #03 SFT2 NIP
	.grid/x2 LDZ2 .Mouse/x DEI2 SUB2 #03 SFT2 NIP
	[ #00 ] NEQk NIP ,&no-save JCN ;save-file JSR2 &no-save
	[ #02 ] NEQk NIP ,&no-load JCN ;load-file JSR2 &no-load
	[ #03 ] NEQk NIP ,&no-name JCN ;init-file JSR2 &no-name


@@ 392,8 389,8 @@ JMP2r
	( from )
	SWP2 DUP2 .selection/from LDZ2 NEQ2 STH .selection/from STZ2
	( to )
	.selection/y1 LDZ GTHk JMP SWP POP .grid/height LDZ #01 - LTHk JMP SWP POP STH
	.selection/x1 LDZ GTHk JMP SWP POP .grid/width LDZ #01 - LTHk JMP SWP POP STHr
	.selection/y1 LDZ GTHk JMP SWP POP .grid/height LDZ #01 SUB LTHk JMP SWP POP STH
	.selection/x1 LDZ GTHk JMP SWP POP .grid/width LDZ #01 SUB LTHk JMP SWP POP STHr
	DUP2 .selection/to LDZ2 NEQ2 STH .selection/to STZ2
	( skip redraw when unchanged )
	ADDr STHr #01 JCN JMP2r


@@ 467,7 464,7 @@ JMP2r
	.guide LDZk #00 EQU SWP STZ
	;draw-grid JSR2
	.toolbar/y1 LDZ2 .Screen/y DEO2
	.grid/x2 LDZ2 #0030 -- .Screen/x DEO2
	.grid/x2 LDZ2 #0030 SUB2 .Screen/x DEO2
	;font/help [ #00 .guide LDZ #40 SFT2 ] ADD2 #01 ;draw-sprite JSR2

JMP2r


@@ 569,7 566,7 @@ JMP2r
		&run
		.head/addr LDZ2 STH2k
		( set type ) OPERATOR-TYPE STH2r ;data/types ADD2 STA
		( run ) ROT ;chrb36 JSR2 #0a - #10 SFT #00 SWP ;op-table/func ADD2 LDA2 JMP2
		( run ) ROT ;chrb36 JSR2 #0a SUB #10 SFT #00 SWP ;op-table/func ADD2 LDA2 JMP2
		&no-uc
	( special )
	[ LIT '* ] EQUk NIP ;op-bang/func JCN2


@@ 588,7 585,7 @@ JMP2r
( operations )

@b36chr ( b36 -- char ) #24 DIVk MUL SUB #00 SWP ;b36clc ADD2 LDA JMP2r
@chrb36 ( char -- b36 ) #20 - #00 SWP ;values ADD2 LDA JMP2r
@chrb36 ( char -- b36 ) #20 SUB #00 SWP ;values ADD2 LDA JMP2r
@chrmid ( char -- midi ) DUP ,chrb36 JSR SWP ;ciuc JSR2 #24 MUL ADD #00 SWP ;notes ADD2 LDA JMP2r

@set-cell ( x y c -- ) ROT ROT ,get-cell JSR ;data/cells ADD2 STA JMP2r


@@ 597,9 594,9 @@ JMP2r
@get-bang ( -- bang )

	.head/addr LDZ2 ;data/cells ADD2 STH2
	STH2kr #0001 -- LDA CHAR-BANG EQU ,&bang JCN
	STH2kr #0001 SUB2 LDA CHAR-BANG EQU ,&bang JCN
	STH2kr INC2 LDA CHAR-BANG EQU ,&bang JCN
	STH2kr #00 .grid/width LDZ -- LDA CHAR-BANG EQU ,&bang JCN
	STH2kr #00 .grid/width LDZ SUB2 LDA CHAR-BANG EQU ,&bang JCN
	STH2kr #00 .grid/width LDZ ADD2 LDA CHAR-BANG EQU ,&bang JCN
	POP2r #00 JMP2r
	&bang POP2r #01


@@ 643,7 640,7 @@ JMP2r
	.toolbar/y1 LDZ2 .Screen/y DEO2
	( draw size )
	.selection/from LDZ2 .selection/to LDZ2 EQU2k ,&normal JCN
		SWP2 -- DUP2
		SWP2 SUB2 DUP2
		&normal
	( value )
	POP2 #01 ;draw-short JSR2


@@ 659,9 656,9 @@ JMP2r
	.toolbar/y1 LDZ2 .Screen/y DEO2
	.grid/x1 LDZ2 #0030 ADD2 .Screen/x DEO2
	( value )
	.timer/frame-lb LDZ STHk #03 .timer/playing LDZ #10 SFT - ;draw-byte JSR2
	.timer/frame-lb LDZ STHk #03 .timer/playing LDZ #10 SFT SUB ;draw-byte JSR2
	( icon )
	;font/beat #03 STHr #07 AND #00 EQU - ;draw-sprite JSR2
	;font/beat #03 STHr #07 AND #00 EQU SUB ;draw-sprite JSR2

JMP2r



@@ 679,7 676,7 @@ JMP2r

@draw-state ( -- )

	.toolbar/x2 LDZ2 #0008 -- .Screen/x DEO2
	.toolbar/x2 LDZ2 #0008 SUB2 .Screen/x DEO2
	.toolbar/y1 LDZ2 .Screen/y DEO2
	( icon )
	;font/save #01 .state/changed LDZ ADD ;draw-sprite JSR2


@@ 776,7 773,7 @@ JMP2r
@draw-meter ( -- )

	.toolbar/y1 LDZ2 .Screen/y DEO2
	.grid/x2 LDZ2 #0040 -- .Screen/x DEO2
	.grid/x2 LDZ2 #0040 SUB2 .Screen/x DEO2
	.signal/midi LDZ #07 LTHk JMP SWP POP STH
	;meter-icn #00 STHkr #40 SFT2 ADD2 .Screen/addr DEO2
	#01 STHr #07 EQU ADD .Screen/sprite DEO


@@ 824,7 821,7 @@ JMP2r
@draw-char ( char color -- )

	OVR #20 LTH ,draw-unknown JCN
	STH #20 - #00 SWP #40 SFT2 ;font ADD2 STHr
	STH #20 SUB #00 SWP #40 SFT2 ;font ADD2 STHr

@draw-sprite ( addr* color -- )
	


@@ 1014,12 1011,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( a-val ) #0001 -- ;get-port-left-value JSR2
	( a-val ) #0001 SUB2 ;get-port-left-value JSR2
	( b-raw ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) ADD
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1029,12 1026,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get a ) #0001 -- ;get-port-left-value JSR2
	( get a ) #0001 SUB2 ;get-port-left-value JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) - DUP #80 LTH ,&bounce JCN #24 SWP - &bounce
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( res ) SUB DUP #80 LTH ,&bounce JCN #24 SWP SUB &bounce
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1044,12 1041,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get rate ) #0001 -- ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get rate ) #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 DIV2 SWP2 DIV2k MUL2 SUB2 NIP
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1059,7 1056,7 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get rate ) #0001 -- ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get rate ) #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	( get mod ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD
	( res ) MUL #00 SWP .timer/frame LDZ2 SWP2 DIV2k MUL2 SUB2 #0000 EQU2
	( bang on equal ) #fc MUL CHAR-DOT ADD


@@ 1087,7 1084,7 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get a ) #0001 -- ;get-port-left-raw JSR2
	( get a ) #0001 SUB2 ;get-port-left-raw JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
	( bang on equal ) EQU [ #fc MUL CHAR-DOT ADD  ]
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2


@@ 1099,12 1096,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( x ) STH2kr #0003 -- ;get-port-left-value JSR2
	( x ) STH2kr #0003 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP ADD2
	( y ) STH2kr #0002 -- ;get-port-left-value JSR2
	( y ) STH2kr #0002 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP INC2 [ #00 .grid/width LDZ MUL2 ] ADD2
	,&save STR2
	( len ) STH2kr #0001 -- ;get-port-left-value JSR2 DUP #00 EQU ADD
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	#00
	&loop
		( load ) DUP #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2


@@ 1130,12 1127,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( step ) #0001 -- ;get-port-left-value JSR2
	( step ) #0001 SUB2 ;get-port-left-value JSR2
	( mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ] ADD SWP DIVk MUL SUB
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1145,7 1142,7 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get above ) #00 .grid/width LDZ -- ;get-port-left-raw JSR2
	( get above ) #00 .grid/width LDZ SUB2 ;get-port-left-raw JSR2
	( ignore cable )
	DUP ;chrb36 JSR2 #13 NEQ ,&no-wire JCN
		POP POP2r JMP2r &no-wire


@@ 1163,7 1160,7 @@ JMP2r
	&func ( addr* -- )

	STH2k
	#0001 -- ;get-port-left-value JSR2 #00
	#0001 SUB2 ;get-port-left-value JSR2 #00
	&loop
		DUP #00 SWP STH2kr INC2 ADD2 STH2k ;get-port-right-raw JSR2
		DUP CHAR-DOT EQU ,&skip JCN


@@ 1183,12 1180,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get a ) #0001 -- ;get-port-left-value JSR2
	( get a ) #0001 SUB2 ;get-port-left-value JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) LTHk JMP SWP POP
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1198,12 1195,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get a ) #0001 -- ;get-port-left-value JSR2
	( get a ) #0001 SUB2 ;get-port-left-value JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) MUL
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1213,9 1210,9 @@ JMP2r
	&func ( addr* -- )

	STH2k ;data/cells ADD2 LDA ,&self STR
	( wall ) .head/y LDZ #01 - #ff EQU ,&collide JCN
	( cell ) STH2kr #00 .grid/width LDZ -- ;data/cells ADD2 LDA CHAR-DOT NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ -- ;set-port-raw JSR2
	( wall ) .head/y LDZ #01 SUB #ff EQU ,&collide JCN
	( cell ) STH2kr #00 .grid/width LDZ SUB2 ;data/cells ADD2 LDA CHAR-DOT NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ SUB2 ;set-port-raw JSR2
	( erase old ) CHAR-DOT STH2r ;set-port-raw JSR2
	JMP2r
	&collide


@@ 1228,8 1225,8 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( x ) STH2kr #0002 -- ;get-port-left-value JSR2 INC #00 SWP ADD2
	( y ) STH2kr #0001 -- ;get-port-left-value JSR2 #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( x ) STH2kr #0002 SUB2 ;get-port-left-value JSR2 INC #00 SWP ADD2
	( y ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) ;get-port-right-raw JSR2
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 1240,8 1237,8 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( key ) #0002 -- ;get-port-left-value JSR2
	( len ) STH2kr #0001 -- ;get-port-left-value JSR2 DUP #00 EQU ADD
	( key ) #0002 SUB2 ;get-port-left-value JSR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	#00
	&loop
		#00 OVR STH2kr #00 .grid/width LDZ ADD2 ADD2 STH2


@@ 1259,13 1256,13 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( x ) STH2kr #0003 -- ;get-port-left-value JSR2
	( x ) STH2kr #0003 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP INC2 ADD2
	( y ) STH2kr #0002 -- ;get-port-left-value JSR2
	( y ) STH2kr #0002 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP [ #00 .grid/width LDZ MUL2 ] ADD2
	,&load STR2
	( len ) STH2kr #0001 -- ;get-port-left-value JSR2 DUP #00 EQU ADD
		( save ) DUP #00 SWP STH2kr #00 .grid/width LDZ ADD2 SWP2 -- INC2 ,&save STR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
		( save ) DUP #00 SWP STH2kr #00 .grid/width LDZ ADD2 SWP2 SUB2 INC2 ,&save STR2
	#00
	&loop
		( load ) DUP #00 SWP [ LIT2 &load $2 ] ADD2 ;get-port-right-raw JSR2


@@ 1281,12 1278,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( a-min ) #0001 -- ;get-port-left-value JSR2
	( a-min ) #0001 SUB2 ;get-port-left-value JSR2
	( b-max ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2 DUP #00 EQU ADD
	( mod ) OVR - ;prng JSR2 ADD SWP DUP #00 EQU ADD DIVk MUL SUB ADD
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( mod ) OVR SUB ;prng JSR2 ADD SWP DUP #00 EQU ADD DIVk MUL SUB ADD
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1311,8 1308,8 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( key ) #0002 -- ;get-port-left-value JSR2
	( len ) STH2kr #0001 -- ;get-port-left-value JSR2 DUP #00 EQU ADD
	( key ) #0002 SUB2 ;get-port-left-value JSR2
	( len ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 DUP #00 EQU ADD
	#00
	&loop
		#00 OVR STH2kr INC2 ADD2 STH2


@@ 1330,9 1327,9 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( step ) #0001 -- ;get-port-left-value JSR2
	( step ) #0001 SUB2 ;get-port-left-value JSR2
	( max ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD STH2
	( frame ADD max - 1 ) .timer/frame LDZ2 STHkr #00 SWP ADD2 #0001 --
	( frame ADD max SUB 1 ) .timer/frame LDZ2 STHkr #00 SWP ADD2 #0001 SUB2
	( MUL step ) OVRr STHr #00 SWP MUL2
	( % max ) STHkr #00 SWP DIV2k MUL2 SUB2
	( ADD step ) SWPr STHr #00 SWP ADD2


@@ 1347,7 1344,7 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( key ) #0001 -- ;get-port-left-raw JSR2
	( key ) #0001 SUB2 ;get-port-left-raw JSR2
	( val ) STH2kr INC2 ;get-port-right-raw JSR2
	DUP CHAR-DOT EQU ,&idle JCN
	OVR ;chrb36 JSR2 ,&save JCN


@@ 1365,9 1362,9 @@ JMP2r
	&func ( addr* -- )

	STH2k ;data/cells ADD2 LDA ,&self STR
	( wall ) .head/x LDZ #01 - #ff EQU ,&collide JCN
	( cell ) STH2kr #0001 -- ;data/cells ADD2 LDA CHAR-DOT NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #0001 -- ;set-port-raw JSR2
	( wall ) .head/x LDZ #01 SUB #ff EQU ,&collide JCN
	( cell ) STH2kr #0001 SUB2 ;data/cells ADD2 LDA CHAR-DOT NEQ ,&collide JCN
	( write new ) [ LIT &self $1 ] STH2kr #0001 SUB2 ;set-port-raw JSR2
	( erase old ) CHAR-DOT STH2r ;set-port-raw JSR2
	JMP2r
	&collide


@@ 1380,8 1377,8 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( x ) STH2kr #0002 -- ;get-port-left-value JSR2 #00 SWP ADD2
	( y ) STH2kr #0001 -- ;get-port-left-value JSR2 INC #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( x ) STH2kr #0002 SUB2 ;get-port-left-value JSR2 #00 SWP ADD2
	( y ) STH2kr #0001 SUB2 ;get-port-left-value JSR2 INC #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) STH2r INC2 ;get-port-right-raw JSR2
	( output ) ROT ROT ;set-port-output JSR2



@@ 1392,7 1389,7 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get above ) #0001 -- ;get-port-left-raw JSR2
	( get above ) #0001 SUB2 ;get-port-left-raw JSR2
	( ignore cable )
	DUP ;chrb36 JSR2 #22 NEQ ,&no-wire JCN
		POP POP2r JMP2r &no-wire


@@ 1410,13 1407,13 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( rate ) #0001 -- ;get-port-left-value JSR2
	( rate ) #0001 SUB2 ;get-port-left-value JSR2
	( target ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( val ) STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ]
	( res ) ;lerp JSR2
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT SUB
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1439,7 1436,7 @@ JMP2r
	POP
	.head/addr LDZ2 STH2k
	( bounds )
	#00 .grid/width LDZ .head/x LDZ - ADD2
	#00 .grid/width LDZ .head/x LDZ SUB ADD2
	STH2r INC2
	&loop
		( set lock ) DUP2 #01 ROT ROT ;data/locks ADD2 STA


@@ 1594,7 1591,7 @@ JMP2r

@slen ( str* -- len* )

	DUP2 ,scap JSR SWP2 --
	DUP2 ,scap JSR SWP2 SUB2

JMP2r



@@ 1615,7 1612,7 @@ JMP2r

	LDAk ,&no-null JCN
		POP2 JMP2r &no-null
	#00 ROT ROT ,scap JSR #0001 -- STA
	#00 ROT ROT ,scap JSR #0001 SUB2 STA

JMP2r