~rabbits/orca-toy

c5fba59027e0ca3039accb986e097f0577d93657 — Devine Lu Linvega 1 year, 3 months ago dbdaa49
Re-organized routines
1 files changed, 209 insertions(+), 207 deletions(-)

M src/orca.tal
M src/orca.tal => src/orca.tal +209 -207
@@ 275,9 275,9 @@ BRK

	( d-pad handler )
	.Controller/button DEI .dpad/last LDZ
	DUP2 #0200 EQU2 ?dpad-input/start
	DUP2 #0002 EQU2 ?dpad-input/end
	DUP #0f AND #02 EQU ?dpad-input/add
	DUP2 #0200 EQU2 ?on-dpad/start
	DUP2 #0002 EQU2 ?on-dpad/end
	DUP #0f AND #02 EQU ?on-dpad/add
	POP ( pop last )
	.dpad/last STZ



@@ 330,7 330,7 @@ BRK

	.Controller/button DEI #02 NEQ ?&no-scroll
	.Mouse/scrolly-lb DEI #00 EQU ?&no-scroll
		.Mouse/scrolly-lb DEI !dpad-input/mod
		.Mouse/scrolly-lb DEI !on-dpad/mod
		&no-scroll

	( route )


@@ 390,8 390,90 @@ JMP2r

BRK

@on-dpad ( -> )

	&start ( button* -> )
		POP .dpad/last STZ
		#20 .dpad STZ
		draw-dpad
		BRK
	&end ( button* -> )
		POP
		.dpad LDZ fill-sel
		.selection/from LDZ2 set-sel-from
		#00 .dpad STZ
		.dpad/last STZ
		draw-speed
		BRK
	&add ( button* -> )
		POP #04 SFT
	&mod ( mod -> )
		.dpad LDZ ADD
			( min ) #20 OVR #20 GTH [ JMP SWP POP ]
			( max ) #7e OVR #7e LTH [ JMP SWP POP ]
				.dpad STZ
		draw-dpad

BRK

(
@|core )

@init ( -- )

	;data/cells .grid/length LDZ2 LIT ". DUP mfil
	&grid
	;data/locks .grid/length LDZ2 STH2k #0000 mfil
	;data/types STH2r #0000 mfil
	;variables #0024 LIT ". DUP mfil
	#00 .signal/midi STZ

JMP2r

@run ( -- )

	manage-voices
	init/grid
	( reset head ) LIT2r 0000
	.grid/height LDZ #00
	&ver
		DUP .head/y STZ
		.grid/width LDZ #00
		&hor
			DUP .head/x STZ
			STH2kr run-char
			INC2r
			INC GTHk ?&hor
		POP2
		INC GTHk ?&ver
	POP2
	POP2r
	( do not draw when menu )
	;draw-menu/sel LDA INC ?&skip
		draw-grid
		draw-timer
		&skip
	.timer/frame LDZ2k INC2 ROT STZ2
	#00 .timer/beat STZ

JMP2r

@run-char ( id* -- )

	( cache )
	DUP2 .head/addr STZ2
	( skip locked )
	DUP2 read-lock ?&locked
	( run unlocked )
	DUP2 ;data/cells ADD2 LDA
	#00 SWP #20 SUB DUP ADD ;op-ascii ADD2 LDA2 JMP2
	&locked
	POP2

JMP2r

(
@|selection )
@|actions )

@play-decr ( -- ) #ff !mod-speed
@play-incr ( -- ) #01 !mod-speed


@@ 473,6 555,17 @@ BRK

!draw-state

@is-selected ( x y -- bool )

	DUP .selection/y1 LDZ LTH ?&outside
	DUP .selection/y2 LDZ GTH ?&outside
	OVR .selection/x1 LDZ LTH ?&outside
	OVR .selection/x2 LDZ GTH ?&outside
	POP2 #01

JMP2r
	&outside POP2 #00 JMP2r

@mod-speed ( mod -- )

	.timer/speed LDZ ADD


@@ 526,45 619,88 @@ BRK

JMP2r

( special )
@get-color ( -- char type )

@dpad-input ( -> )
	.head LDZ2 is-selected ?&selected
		#00 .head/addr LDZ2 read-type ;styles-lut ADD2 LDA JMP2r
	&selected
		#0c

	&start ( button* -> )
		POP .dpad/last STZ
		#20 .dpad STZ
		draw-dpad
		BRK
	&end ( button* -> )
JMP2r

@get-char-at-addr ( addr* -- char )

	;data/cells ADD2 LDA
	DUP LIT ". NEQ ?&no-bar
		POP
		.dpad LDZ fill-sel
		.selection/from LDZ2 set-sel-from
		#00 .dpad STZ
		.dpad/last STZ
		draw-speed
		BRK
	&add ( button* -> )
		POP #04 SFT
	&mod ( mod -> )
		.dpad LDZ ADD
			( min ) #20 OVR #20 GTH [ JMP SWP POP ]
			( max ) #7e OVR #7e LTH [ JMP SWP POP ]
				.dpad STZ
		draw-dpad
		.guide/grid LDZ ?&do-grid
			#20 JMP2r
			&do-grid
		.head LDZ2
		DUP2 #07 AND SWP #0f AND ORA ?&no-cross
			POP2 #7f JMP2r
			&no-cross
		DUP2 #01 AND SWP #03 AND ORA ?&no-dot
			&dot POP2 LIT ". JMP2r
			&no-dot
		DUP2 is-selected ?&dot
		.head/addr LDZ2 read-type ?&dot
		POP2 #20
	&no-bar

BRK
JMP2r

@init ( -- )
@get-word ( addr* -- word* )

	;data/cells .grid/length LDZ2 LIT ". DUP mfil
	&grid
	;data/locks .grid/length LDZ2 STH2k #0000 mfil
	;data/types STH2r #0000 mfil
	;variables #0024 LIT ". DUP mfil
	#00 .signal/midi STZ
	;&word #0020 mclr
	&while
		INC2 DUP2 read-cell
			DUP LIT ". EQU ?&skip
				DUP ;&word sput
				&skip
			LIT ". NEQ ?&while
	POP2
	;&word

JMP2r
	&word $20

@get-strw ( str* -- width* )

	slen #30 SFT2

JMP2r

@get-bang ( -- bang )

	.head/addr LDZ2 ;data/cells ADD2 STH2k
	( left ) #0001 SUB2 LDA LIT "* EQU ?&bang
	( top ) STH2kr [ LIT2 00 -grid/width ] LDZ SUB2 LDA LIT "* EQU ?&bang
	( right ) STH2kr INC2 LDA LIT "* EQU ?&bang
	( bottom ) STH2kr [ LIT2 00 -grid/width ] LDZ ADD2 LDA LIT "* EQU ?&bang
	POP2r #00
JMP2r
	&bang POP2r #01 JMP2r

@lerp ( rate target val -- val )

	DUP2 GTHk [ JMP SWP SUB ] STH
	( if rate GTH target )
	ROT DUP STHr LTH ?&skip
		POP2 JMP2r
		&skip
	( target val rate )
	STH
	GTHk ?&no-below
		NIP STHr SUB JMP2r
		&no-below
	NIP STHr ADD

JMP2r

(
@|voices )

@manage-voices ( -> )

	( iterate thru channels )


@@ 590,80 726,67 @@ JMP2r

JMP2r

@run ( -- )
(
@|drawing )

@redraw-all ( -- )

@draw-grid ( -- )

	manage-voices
	init/grid
	( reset head ) LIT2r 0000
	.grid/height LDZ #00
	&ver
		DUP .head/y STZ
		( x ) .grid/x1 LDZ2 .Screen/x DEO2
		( y ) #00 OVR #40 SFT2 .grid/y1 LDZ2 ADD2 .Screen/y DEO2
		.grid/width LDZ #00
		&hor
			DUP .head/x STZ
			STH2kr run-char
			STH2kr .head/addr STZ2
			STH2kr get-char-at-addr get-color draw-chr-color
			( underline )
			STH2kr read-lock #02 NEQ ?&no-lock
				.Screen/x DEI2k #0008 SUB2 ROT DEO2
				;underline-icn .Screen/addr DEO2
				#0f .Screen/sprite DEO
				&no-lock
			INC2r
			INC GTHk ?&hor
		POP2
		INC GTHk ?&ver
	POP2
	POP2r
	( do not draw when menu )
	;draw-menu/sel LDA INC ?&skip
		draw-grid
		draw-timer
		&skip
	.timer/frame LDZ2k INC2 ROT STZ2
	#00 .timer/beat STZ

JMP2r

@run-char ( id* -- )

	( cache )
	DUP2 .head/addr STZ2
	( skip locked )
	DUP2 read-lock ?&locked
	( run unlocked )
	DUP2 ;data/cells ADD2 LDA
	#00 SWP #20 SUB DUP ADD ;op-ascii ADD2 LDA2 JMP2
	&locked
	POP2
	( draw meter )
	draw-meter
	( draw guide )
	.guide LDZ ?draw-guide

JMP2r

( operations )

@get-bang ( -- bang )

	.head/addr LDZ2 ;data/cells ADD2 STH2k
	( left ) #0001 SUB2 LDA LIT "* EQU ?&bang
	( top ) STH2kr [ LIT2 00 -grid/width ] LDZ SUB2 LDA LIT "* EQU ?&bang
	( right ) STH2kr INC2 LDA LIT "* EQU ?&bang
	( bottom ) STH2kr [ LIT2 00 -grid/width ] LDZ ADD2 LDA LIT "* EQU ?&bang
	POP2r #00
JMP2r
	&bang POP2r #01 JMP2r
@draw-guide ( -- )

@lerp ( rate target val -- val )
	.Screen/width DEI2 #0200 GTH2 ?&continue
		JMP2r
		&continue

	DUP2 GTHk [ JMP SWP SUB ] STH
	( if rate GTH target )
	ROT DUP STHr LTH ?&skip
		POP2 JMP2r
	#0020 #0000
	&loop
		( x ) DUP2 #84 SFT2 .grid/x1 LDZ2 ADD2 #0020 ADD2 .Screen/x DEO2
		( y ) DUP2 #000f AND2 #40 SFT2 .grid/y1 LDZ2 ADD2 #0020 ADD2 .Screen/y DEO2
		.Screen/y DEI2 .grid/y2 LDZ2 #0030 SUB2 GTH2 ?&skip
		DUP2k ADD2 ;docs-lut ADD2 LDA2
		( glyph )
			LDAk #0c draw-chr-color
		( space )
			[ LIT2 00 -Screen/sprite ] DEO
		( text )
			INC2 #01 draw-str-color
		&skip
	( target val rate )
	STH
	GTHk ?&no-below
		NIP STHr SUB JMP2r
		&no-below
	NIP STHr ADD
		INC2 GTH2k ?&loop
	POP2 POP2

JMP2r

(
@|drawing )

@draw-dpad ( -- )

	[ LIT2 &x $2 ] .Screen/x DEO2


@@ 751,121 874,6 @@ JMP2r

JMP2r

@redraw-all ( -- )

@draw-grid ( -- )

	( reset head ) LIT2r 0000
	.grid/height LDZ #00
	&ver
		DUP .head/y STZ
		( x ) .grid/x1 LDZ2 .Screen/x DEO2
		( y ) #00 OVR #40 SFT2 .grid/y1 LDZ2 ADD2 .Screen/y DEO2
		.grid/width LDZ #00
		&hor
			DUP .head/x STZ
			STH2kr .head/addr STZ2
			STH2kr get-char-at-addr get-color draw-chr-color
			( underline )
			STH2kr read-lock #02 NEQ ?&no-lock
				.Screen/x DEI2k #0008 SUB2 ROT DEO2
				;underline-icn .Screen/addr DEO2
				#0f .Screen/sprite DEO
				&no-lock
			INC2r
			INC GTHk ?&hor
		POP2
		INC GTHk ?&ver
	POP2
	POP2r
	( draw meter )
	draw-meter
	( draw guide )
	.guide LDZ ?draw-guide

JMP2r

@get-color ( -- char type )

	.head LDZ2 is-selected ?&selected
		#00 .head/addr LDZ2 read-type ;styles-lut ADD2 LDA JMP2r
	&selected
		#0c

JMP2r

@get-char-at-addr ( addr* -- char )

	;data/cells ADD2 LDA
	DUP LIT ". NEQ ?&no-bar
		POP
		.guide/grid LDZ ?&do-grid
			#20 JMP2r
			&do-grid
		.head LDZ2
		DUP2 #07 AND SWP #0f AND ORA ?&no-cross
			POP2 #7f JMP2r
			&no-cross
		DUP2 #01 AND SWP #03 AND ORA ?&no-dot
			&dot POP2 LIT ". JMP2r
			&no-dot
		DUP2 is-selected ?&dot
		.head/addr LDZ2 read-type ?&dot
		POP2 #20
	&no-bar

JMP2r

@get-word ( addr* -- word* )

	;&word #0020 mclr
	&while
		INC2 DUP2 read-cell
			DUP LIT ". EQU ?&skip
				DUP ;&word sput
				&skip
			LIT ". NEQ ?&while
	POP2
	;&word

JMP2r
	&word $20

@is-selected ( x y -- bool )

	DUP .selection/y1 LDZ LTH ?&outside
	DUP .selection/y2 LDZ GTH ?&outside
	OVR .selection/x1 LDZ LTH ?&outside
	OVR .selection/x2 LDZ GTH ?&outside
	POP2 #01

JMP2r
	&outside POP2 #00 JMP2r

@draw-guide ( -- )

	.Screen/width DEI2 #0200 GTH2 ?&continue
		JMP2r
		&continue

	#0020 #0000
	&loop
		( x ) DUP2 #84 SFT2 .grid/x1 LDZ2 ADD2 #0020 ADD2 .Screen/x DEO2
		( y ) DUP2 #000f AND2 #40 SFT2 .grid/y1 LDZ2 ADD2 #0020 ADD2 .Screen/y DEO2
		.Screen/y DEI2 .grid/y2 LDZ2 #0030 SUB2 GTH2 ?&skip
		DUP2k ADD2 ;docs-lut ADD2 LDA2
		( glyph )
			LDAk #0c draw-chr-color
		( space )
			[ LIT2 00 -Screen/sprite ] DEO
		( text )
			INC2 #01 draw-str-color
		&skip
		INC2 GTH2k ?&loop
	POP2 POP2

JMP2r

@draw-short ( short* -- )

	SWP draw-byte


@@ 914,12 922,6 @@ JMP2r

JMP2r

@get-strw ( str* -- width* )

	slen #30 SFT2

JMP2r

(
@|document )