~rabbits/orca-toy

ca6b52fe66d50dce3a5ea1d8dcf759e2f56bd0e4 — neauoire 4 months ago fc2d827
Improved insert toggle
1 files changed, 141 insertions(+), 146 deletions(-)

M src/main.tal
M src/main.tal => src/main.tal +141 -146
@@ 1,9 1,7 @@
( Orca )

%+  { ADD }  %-  { SUB }  %*  { MUL }  %/  { DIV }
%<  { LTH }  %>  { GTH }  %=  { EQU }  %!  { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%-  { SUB } 
%-- { SUB2 } 

%CHAR-NULL  { #00 } %CHAR-LINE  { #0a }
%CHAR-HASH  { #23 } %CHAR-BANG  { #2a }


@@ 37,7 35,7 @@
@guide $1
@filepath $40
@grid &x1 $2 &y1 $2 &x2 $2 &y2 $2 &size &width $1 &height $1 &length $2
@selection &from &x1 $1 &y1 $1 &to &x2 $1 &y2 $1 &insert $1
@selection &from &x1 $1 &y1 $1 &to &x2 $1 &y2 $1
@cursor &x $2 &y $2
@toolbar &x1 $2 &y1 $2 &x2 $2 &y2 $2
@head &x $1 &y $1 &addr $2


@@ 80,7 78,7 @@
		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
	#00 .grid/height LDZ #00 .grid/width LDZ ** .grid/length STZ2
	#00 .grid/height LDZ #00 .grid/width LDZ MUL2 .grid/length STZ2

	( set toolbar size )
	.grid/x1 LDZ2 .toolbar/x1 STZ2


@@ 138,10 136,10 @@ JMP2r
@on-console ( -> )

	.Console/read DEI
	[ #11 ] NEQk NIP ,&no-u JCN #00ff #00 ;set-selection-mod JSR2 &no-u
	[ #12 ] NEQk NIP ,&no-d JCN #0001 #00 ;set-selection-mod JSR2 &no-d
	[ #13 ] NEQk NIP ,&no-l JCN #ff00 #00 ;set-selection-mod JSR2 &no-l
	[ #14 ] NEQk NIP ,&no-r JCN #0100 #00 ;set-selection-mod JSR2 &no-r
	[ #11 ] NEQk NIP ,&no-u JCN #00ff #00 ;mod-sel JSR2 &no-u
	[ #12 ] NEQk NIP ,&no-d JCN #0001 #00 ;mod-sel JSR2 &no-d
	[ #13 ] NEQk NIP ,&no-l JCN #ff00 #00 ;mod-sel JSR2 &no-l
	[ #14 ] NEQk NIP ,&no-r JCN #0100 #00 ;mod-sel JSR2 &no-r
	DUP ;ci-key JSR2 #00 EQU ,&no-key JCN
		STHk .selection LDZ2 STHr ;set-cell JSR2
		&no-key


@@ 162,7 160,7 @@ BRK
@on-button-trap ( -> )

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

BRK


@@ 220,39 218,25 @@ BRK

	( default )
	.Controller/key DEI
	DUP #00 NEQ ,&no-null JCN
		POP BRK
		&no-null
	DUP #1b NEQ ,&no-escape JCN
		.selection/from LDZ2 ;set-selection-from JSR2
		#00 .selection/insert STZ
		POP BRK
		&no-escape
	DUP #20 NEQ ,&no-space JCN
		( insert mode )
		.selection/insert LDZ #00 EQU ,&no-space-insert JCN
			#01 #00 #00 ;set-selection-mod JSR2 POP BRK
			&no-space-insert
		;toggle-play JSR2
		POP BRK
		&no-space
	DUP #08 NEQ OVR #7f NEQ AND ,&no-backspace JCN
		( insert mode )
		.selection/insert LDZ #00 EQU ,&no-backspace-insert JCN
			#ff #00 #00 ;set-selection-mod JSR2
			&no-backspace-insert
		CHAR-DOT ;fill-selection JSR2
		POP BRK
		&no-backspace
	DUP ;ci-key JSR2 #00 EQU ,&no-key JCN
		.Controller/key DEI ;fill-selection JSR2
		( insert mode )
		.selection/insert LDZ #00 EQU ,&no-key-insert JCN
			#01 #00 #00 ;set-selection-mod JSR2
			&no-key-insert
		#01 .state/changed STZ ;draw-state JSR2
		POP BRK
		&no-key
	[ #00 ] EQUk NIP ,&end JCN
	[ #1b ] NEQk NIP ,&no-esc JCN .selection/from LDZ2 ;set-sel-from JSR2 POP BRK &no-esc
	[ #20 ] NEQk NIP ,&no-spc JCN ;toggle-play JSR2 POP BRK &no-spc
	[ #08 ] NEQk NIP OVR #7f NEQ AND ,&no-bks JCN CHAR-DOT ;fill-sel JSR2 POP BRK &no-bks
	DUP ;ci-key JSR2 #00 EQU ,&no-key JCN .Controller/key DEI ;fill-sel JSR2 &no-key
	&end
	POP

BRK

@on-button-insert ( -> )

	.Controller/key DEI
	[ #00 ] EQUk NIP ,&end JCN
	[ #1b ] NEQk NIP ,&no-esc JCN ;unset-insert JSR2 POP BRK &no-esc
	[ #20 ] NEQk NIP ,&no-spc JCN #01 #00 #00 ;mod-sel JSR2 POP BRK &no-spc
	[ #08 ] NEQk NIP ,&no-bks JCN #ff #00 #00 ;mod-sel JSR2 CHAR-DOT ;fill-sel JSR2 POP BRK &no-bks
	DUP ;ci-key JSR2 #00 EQU ,&no-key JCN .Controller/key DEI ;fill-sel JSR2 #01 #00 #00 ;mod-sel JSR2 &no-key
	&end
	POP

BRK


@@ 270,8 254,8 @@ BRK
	[ LIT 'o ] NEQk NIP ,&no-open JCN ;load-file JSR2 &no-open
	[ LIT 's ] NEQk NIP ,&no-save JCN ;save-file JSR2 &no-save
	( select-all/insert )
	[ LIT 'a ] NEQk NIP ,&no-a JCN ;set-selection-all JSR2 &no-a
	[ LIT 'i ] NEQk NIP ,&no-i JCN ;toggle-insert JSR2 &no-i
	[ LIT 'a ] NEQk NIP ,&no-a JCN ;set-sel-all JSR2 &no-a
	[ LIT 'i ] NEQk NIP ,&no-i JCN ;set-insert JSR2 &no-i
	[ LIT 'h ] NEQk NIP ,&no-h JCN ;toggle-guide JSR2 &no-h
	( tempo )
	[ LIT ', ] NEQk NIP ,&no-slow JCN #ff ;mod-speed JSR2 &no-slow


@@ 287,7 271,7 @@ BRK
	DUP #0f AND ,&mod STR
	#04 SFT #00 OVR #03 AND ;&vec ADD2 LDA ,&y STR
	#02 SFT #00 SWP #03 AND ;&vec ADD2 LDA ,&x STR
	[ LIT &x $1 ] [ LIT &y $1 ] [ LIT &mod $1 ] ;set-selection-mod JSR2
	[ LIT &x $1 ] [ LIT &y $1 ] [ LIT &mod $1 ] ;mod-sel JSR2

BRK
	&vec 00 ff 01 00


@@ 302,7 286,7 @@ BRK
	.Mouse/x DEI2 DUP2 .cursor/x STZ2 .Screen/x DEO2
	.Mouse/y DEI2 DUP2 .cursor/y STZ2 .Screen/y DEO2
	;cursor-icn .Screen/addr DEO2
	#41 [ .Mouse/state DEI #00 NEQ #10 SFT ] + .Screen/sprite DEO
	#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/x DEI2 .Mouse/y DEI2 .grid ;within-rect JSR2 ,on-mouse-grid JCN


@@ 317,13 301,13 @@ BRK
		DUP2 #0100 NEQ2 ,&no-down JCN
			.Mouse/x DEI2 .grid/x1 LDZ2 -- #03 SFT2 NIP
			.Mouse/y DEI2 .grid/y1 LDZ2 -- #04 SFT2 NIP
				;set-selection-from JSR2
				;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
			;set-selection-to JSR2
			;set-sel-to JSR2
	&end
	POP ,&last STR



@@ 338,7 322,7 @@ BRK
	[ #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 > #0101 NEQ2 ,&no-rename JCN ;trap JSR2 &no-rename
	[ #0e ] GTHk NIP OVR .grid/width LDZ SWP - #06 GTH #0101 NEQ2 ,&no-rename JCN ;trap JSR2 &no-rename
	POP
	( right-side )
	.grid/x2 LDZ2 .Mouse/x DEI2 -- #03 SFT2 NIP


@@ 353,11 337,11 @@ BRK

( selection )

@set-selection-mod ( x y mod -- )
@mod-sel ( x y mod -- )

	DUP #04 NEQ ,&no-scale JCN
		POP
		.selection/to LDZ2 ,&add-pos JSR ;set-selection-to JSR2
		.selection/to LDZ2 ,&add-pos JSR ;set-sel-to JSR2
		JMP2r
		&no-scale
	DUP #01 NEQ ,&no-drag JCN


@@ 365,7 349,7 @@ BRK
		;cut-snarf JSR2
		STH2k .selection/from LDZ2 ,&add-pos JSR
		STH2r .selection/to LDZ2 ,&add-pos JSR
			;set-selection-range JSR2
			;set-sel-range JSR2
		;paste-snarf JSR2
		JMP2r
		&no-drag


@@ 373,35 357,35 @@ BRK
	( default )
	STH2k .selection/from LDZ2 ,&add-pos JSR
	STH2r .selection/to LDZ2 ,&add-pos JSR
		;set-selection-range JSR2
		;set-sel-range JSR2

JMP2r
	&add-pos ROT ADD STH ADD STHr JMP2r

@set-selection-all ( -- )
@set-sel-all ( -- )

	#0000 .grid/size LDZ2 ,set-selection-range JSR
	#0000 .grid/size LDZ2 ,set-sel-range JSR

JMP2r

@set-selection-from ( x y -- )
@set-sel-from ( x y -- )

	DUP2 ,set-selection-range JSR
	DUP2 ,set-sel-range JSR

JMP2r

@set-selection-to ( x y -- )
@set-sel-to ( x y -- )

	.selection/from LDZ2 SWP2

@set-selection-range ( from* to* -- )
@set-sel-range ( from* to* -- )

	( clamp top-left )
	OVR2 #ff NEQ SWP #ff NEQ AND ,&no-tl JCN
		POP2 POP2 JMP2r
		&no-tl
	( clamp bottom-right )
	OVR2 .grid/height LDZ < SWP .grid/width LDZ < AND ,&no-br JCN
	OVR2 .grid/height LDZ LTH SWP .grid/width LDZ LTH AND ,&no-br JCN
		POP2 POP2 JMP2r
		&no-br
	( from )


@@ 420,7 404,7 @@ JMP2r

JMP2r

@fill-selection ( char -- )
@fill-sel ( char -- )

	,&c STR
	.selection/y2 LDZ INC .selection/y1 LDZ


@@ 439,7 423,7 @@ JMP2r

@mod-speed ( mod -- )

	.timer/speed LDZ +
	.timer/speed LDZ ADD

@set-speed ( speed -- )



@@ 451,9 435,21 @@ JMP2r

@toggle-insert ( -- )

	.selection/insert LDZk #00 EQU SWP STZ
	.Controller/vector DEI2 ;on-button-insert EQU2 ,unset-insert JCN

@set-insert ( -- )

	;on-button-insert .Controller/vector DEO2
	;draw-position JSR2
	#00 .Mouse/state DEO

JMP2r

@unset-insert ( -- )

	;on-button .Controller/vector DEO2
	;draw-position JSR2
	#00 .Mouse/state DEO

JMP2r



@@ 485,10 481,9 @@ JMP2r
		;&save JMP2
	&end ( button* -> )
		POP
		.dpad LDZ #7f > ,&save JCN
		.dpad LDZ ;fill-selection JSR2
		#01 .state/changed STZ ;draw-state JSR2
		.selection/from LDZ2 ;set-selection-from JSR2
		.dpad LDZ #7f GTH ,&save JCN
		.dpad LDZ ;fill-sel JSR2
		.selection/from LDZ2 ;set-sel-from JSR2
		#00 .dpad STZ
		.dpad/last STZ
		;draw-speed JSR2


@@ 496,7 491,7 @@ JMP2r
		,&save JMP
	&add ( button* -> )
		#02 NEQ ,&save JCN
		DUP #04 SFT .dpad LDZ + #7f AND .dpad STZ
		DUP #04 SFT .dpad LDZ ADD #7f AND .dpad STZ
		,&save JMP
	&save ( -> )
		.dpad/last STZ


@@ 546,8 541,8 @@ JMP2r
		POP JMP2r
		&no-dot
	( skip numbers )
	DUP #30 < ,&no-num JCN
	DUP #39 > ,&no-num JCN
	DUP #30 LTH ,&no-num JCN
	DUP #39 GTH ,&no-num JCN
		POP JMP2r
		&no-num
	( skip locked )


@@ 555,14 550,14 @@ JMP2r
		POP JMP2r
		&no-locked
	( lowercase )
	DUP #61 < ,&no-lc JCN
	DUP #7a > ,&no-lc JCN
	DUP #61 LTH ,&no-lc JCN
	DUP #7a GTH ,&no-lc JCN
		;get-bang JSR2 ,&run JCN
		POP JMP2r
		&no-lc
	( uppercase )
	DUP #41 < ,&no-uc JCN
	DUP #5a > ,&no-uc JCN
	DUP #41 LTH ,&no-uc JCN
	DUP #5a GTH ,&no-uc JCN
		&run
		.head/addr LDZ2 STH2k
		( set type ) OPERATOR-TYPE STH2r ;data/types ADD2 STA


@@ 586,10 581,10 @@ JMP2r

@b36chr ( b36 -- char ) #24 DIVk MUL SUB #00 SWP ;b36clc ADD2 LDA JMP2r
@chrb36 ( char -- b36 ) #20 - #00 SWP ;values ADD2 LDA JMP2r
@chrmid ( char -- midi ) DUP ,chrb36 JSR SWP ;ciuc JSR2 #24 * + #00 SWP ;notes 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
@get-cell ( x y -- addr* ) #00 SWP #00 .grid/width LDZ ** ROT #00 SWP ADD2 JMP2r
@get-cell ( x y -- addr* ) #00 SWP #00 .grid/width LDZ MUL2 ROT #00 SWP ADD2 JMP2r

@get-bang ( -- bang )



@@ 606,8 601,8 @@ JMP2r
@lerp ( rate target val -- val )

	DUP2 GTHk JMP SWP SUB STH
	( if rate > target )
	ROT DUP STHr < ,&skip JCN
	( if rate GTH target )
	ROT DUP STHr LTH ,&skip JCN
		POP2 JMP2r
		&skip
	( target val rate )


@@ 645,8 640,8 @@ JMP2r
	( value )
	POP2 #01 ;draw-short JSR2
	( icon )
	;font/selector #00 .selection/insert LDZ #40 SFT2 ++
	#02 .selection/from LDZ2 .selection/to LDZ2 EQU2 +
	;font/selector #00 [ .Controller/vector DEI2 ;on-button-insert EQU2 ] #40 SFT2 ADD2
	#02 .selection/from LDZ2 .selection/to LDZ2 EQU2 ADD
		;draw-sprite JSR2

JMP2r


@@ 679,7 674,7 @@ JMP2r
	.toolbar/x2 LDZ2 #0008 -- .Screen/x DEO2
	.toolbar/y1 LDZ2 .Screen/y DEO2
	( icon )
	;font/save #01 .state/changed LDZ + ;draw-sprite JSR2
	;font/save #01 .state/changed LDZ ADD ;draw-sprite JSR2

JMP2r



@@ 758,10 753,10 @@ JMP2r

@is-selected ( x y -- bool )

	DUP .selection/y1 LDZ < ,&end JCN
	DUP .selection/y2 LDZ > ,&end JCN
	OVR .selection/x1 LDZ < ,&end JCN
	OVR .selection/x2 LDZ > ,&end JCN
	DUP .selection/y1 LDZ LTH ,&end JCN
	DUP .selection/y2 LDZ GTH ,&end JCN
	OVR .selection/x1 LDZ LTH ,&end JCN
	OVR .selection/x2 LDZ GTH ,&end JCN
		POP2 #01 JMP2r
	&end
	POP2 #00


@@ 937,7 932,7 @@ JMP2r
@cut-snarf ( -- )

	,copy-snarf JSR
	CHAR-DOT ;fill-selection JSR2
	CHAR-DOT ;fill-sel JSR2
	
JMP2r



@@ 996,8 991,8 @@ JMP2r
	( b-raw ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) +
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
	( res ) ADD
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1011,8 1006,8 @@ JMP2r
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) - DUP #80 < ,&bounce JCN #24 SWP - &bounce
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
	( res ) - DUP #80 LTH ,&bounce JCN #24 SWP - &bounce
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1022,12 1017,12 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get rate ) #0001 -- ;get-port-left-value JSR2 DUP #00 EQU +
	( get rate ) #0001 -- ;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 +
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 // SWP2 DIV2k MUL2 SUB2 NIP
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
		( 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 -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1037,10 1032,10 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( get rate ) #0001 -- ;get-port-left-value JSR2 DUP #00 EQU +
	( get mod ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU +
	( res ) * #00 SWP .timer/frame LDZ2 SWP2 DIV2k MUL2 SUB2 #0000 ==
	( bang on equal ) #fc * CHAR-DOT +
	( get rate ) #0001 -- ;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
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


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

JMP2r


@@ 1078,11 1073,11 @@ JMP2r

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


@@ 1111,9 1106,9 @@ JMP2r
	( step ) #0001 -- ;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 +
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ] + SWP DIVk MUL SUB
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
		( 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 -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1130,7 1125,7 @@ JMP2r
	( skip down )
	STH2r
	&while
		#00 .grid/width LDZ ADD2 DUP2 ;data/cells ADD2 LDA ;chrb36 JSR2 #13 =
		#00 .grid/width LDZ ADD2 DUP2 ;data/cells ADD2 LDA ;chrb36 JSR2 #13 EQU
		,&while JCN
	( set below ) ;set-port-output JSR2



@@ 1145,7 1140,7 @@ JMP2r
	&loop
		DUP #00 SWP STH2kr INC2 ADD2 STH2k ;get-port-right-raw JSR2
		DUP CHAR-DOT EQU ,&skip JCN
			( load ) DUP ;chrb36 JSR2 .variables + LDZ
			( load ) DUP ;chrb36 JSR2 .variables ADD LDZ
			( save ) STH2kr #00 .grid/width LDZ ADD2 ;set-port-output JSR2
			&skip
		POP


@@ 1166,7 1161,7 @@ JMP2r
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) LTHk JMP SWP POP
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1180,8 1175,8 @@ JMP2r
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR
		( to value ) ;chrb36 JSR2
	( res ) *
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
	( res ) MUL
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1206,8 1201,8 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( x ) STH2kr #0002 -- ;get-port-left-value JSR2 INC #00 SWP ++
	( y ) STH2kr #0001 -- ;get-port-left-value JSR2 #00 SWP #00 .grid/width LDZ ** ++
	( 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
	( val ) ;get-port-right-raw JSR2
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 1219,7 1214,7 @@ JMP2r

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


@@ 1238,11 1233,11 @@ JMP2r

	STH2k
	( x ) STH2kr #0003 -- ;get-port-left-value JSR2
		( load ) #00 SWP INC2 ++
		( load ) #00 SWP INC2 ADD2
	( y ) STH2kr #0002 -- ;get-port-left-value JSR2
		( load ) #00 SWP [ #00 .grid/width LDZ ** ] ++
		( load ) #00 SWP [ #00 .grid/width LDZ MUL2 ] ADD2
	,&load STR2
	( len ) STH2kr #0001 -- ;get-port-left-value JSR2 DUP #00 EQU +
	( 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
	#00
	&loop


@@ 1262,9 1257,9 @@ JMP2r
	( a-min ) #0001 -- ;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 +
	( mod ) OVR - ;prng JSR2 + SWP DUP #00 EQU + DIVk MUL SUB +
	( set case ) ;b36chr JSR2 DUP #60 > [ LIT &case $1 ] AND #50 SFT -
		( 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 -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1290,7 1285,7 @@ JMP2r

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


@@ 1309,13 1304,13 @@ JMP2r

	STH2k
	( step ) #0001 -- ;get-port-left-value JSR2
	( max ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU + STH2
	( frame + max - 1 ) .timer/frame LDZ2 STHkr #00 SWP ADD2 #0001 --
	( * step ) OVRr STHr #00 SWP **
	( 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 --
	( MUL step ) OVRr STHr #00 SWP MUL2
	( % max ) STHkr #00 SWP DIV2k MUL2 SUB2
	( + step ) SWPr STHr #00 SWP ++
	( bucket >= max ) STHr #00 SWP << #01 !
	( bang if equal ) #fc * CHAR-DOT +
	( ADD step ) SWPr STHr #00 SWP ADD2
	( bucket GTH= max ) STHr #00 SWP LTH2 #01 NEQ
	( bang if equal ) #fc MUL CHAR-DOT ADD
	STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 1330,9 1325,9 @@ JMP2r
	DUP CHAR-DOT EQU ,&idle JCN
	OVR ;chrb36 JSR2 ,&save JCN
	( load )
		NIP ;chrb36 JSR2 .variables + LDZ STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2 JMP2r
		NIP ;chrb36 JSR2 .variables ADD LDZ STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2 JMP2r
	&save
		SWP ;chrb36 JSR2 .variables + STZ POP2r JMP2r
		SWP ;chrb36 JSR2 .variables ADD STZ POP2r JMP2r
	&idle
		POP2 POP2r



@@ 1358,8 1353,8 @@ JMP2r
	&func ( addr* -- )

	STH2k
	( x ) STH2kr #0002 -- ;get-port-left-value JSR2 #00 SWP ++
	( y ) STH2kr #0001 -- ;get-port-left-value JSR2 INC #00 SWP #00 .grid/width LDZ ** ++
	( 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
	( val ) STH2r INC2 ;get-port-right-raw JSR2
	( output ) ROT ROT ;set-port-output JSR2



@@ 1377,7 1372,7 @@ JMP2r
	( skip down )
	STH2r
	&while
		INC2 DUP2 ;data/cells ADD2 LDA ;chrb36 JSR2 #22 =
		INC2 DUP2 ;data/cells ADD2 LDA ;chrb36 JSR2 #22 EQU
		,&while JCN
	( set below ) ;set-port-output JSR2



@@ 1394,7 1389,7 @@ JMP2r
		( 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 > [ LIT &case $1 ] AND #50 SFT -
	( set case ) ;b36chr JSR2 DUP #60 GTH [ LIT &case $1 ] AND #50 SFT -
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


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


@@ 1444,8 1439,8 @@ JMP2r
	( has note ) DUP CHAR-DOT NEQ ,&has-note JCN [ POP2 POP2r JMP2r ] &has-note
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) IO-TYPE STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c * ] +
	( play ) .Audio0/pitch [ LIT &ch $1 ] #03 AND #40 SFT + DEO
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD
	( play ) .Audio0/pitch [ LIT &ch $1 ] #03 AND #40 SFT ADD DEO

JMP2r



@@ 1461,7 1456,7 @@ JMP2r
	( has note ) DUP CHAR-DOT NEQ ,&has-note JCN [ POP2 POP2r JMP2r ] &has-note
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) IO-TYPE STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c * ] +
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD
	( get channel ) [ LIT &ch $1 ]
	( note on )
	DUP .Console/write DEO


@@ 1485,7 1480,7 @@ JMP2r
	( has note ) DUP CHAR-DOT NEQ ,&has-note JCN [ POP2 POP2r JMP2r ] &has-note
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) IO-TYPE STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c * ] + .Console/write DEO
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD .Console/write DEO

JMP2r



@@ 1499,7 1494,7 @@ JMP2r
	( ln ) STH2kr #0002 ADD2 ;get-port-right-value JSR2
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2 POP2r JMP2r ] &is-bang
	( animate ) IO-TYPE STH2r ;data/types ADD2 STA
	#0f AND SWP #0f AND #40 SFT + .Console/write DEO
	#0f AND SWP #0f AND #40 SFT ADD .Console/write DEO

JMP2r



@@ 1563,8 1558,8 @@ JMP2r

JMP2r

@ciuc ( char -- bool ) DUP #40 > SWP #5b < AND JMP2r
@ci-key ( char -- bool ) DUP #20 > SWP #7b < AND JMP2r
@ciuc ( char -- bool ) DUP #40 GTH SWP #5b LTH AND JMP2r
@ci-key ( char -- bool ) DUP #20 GTH SWP #7b LTH AND JMP2r

( standards )



@@ 1624,11 1619,11 @@ JMP2r
@within-rect ( x* y* rect -- flag )

	STH
	( y < rect.y1 ) DUP2 STHkr #02 + LDZ2 << ,&skip JCN
	( y > rect.y2 ) DUP2 STHkr #06 + LDZ2 >> ,&skip JCN
	( y LTH rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
	( y GTH rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
	SWP2
	( x < rect.x1 ) DUP2 STHkr LDZ2 << ,&skip JCN
	( x > rect.x2 ) DUP2 STHkr #04 + LDZ2 >> ,&skip JCN
	( x LTH rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
	( x GTH rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
	POP2 POP2 POPr
	#01
JMP2r