~rabbits/orca-toy

43430d9c16e2d7ea4898188095d09fdde09848c3 — Devine Lu Linvega a month ago 6b07143
Removed a few macros
3 files changed, 61 insertions(+), 65 deletions(-)

M src/library.tal
M src/manifest.tal
M src/orca.tal
M src/library.tal => src/library.tal +7 -7
@@ 145,7 145,7 @@ JMP2r
	( 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 MOD2 NIP
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 DIV2 SWP2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] NIP
	( 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



@@ 159,7 159,7 @@ JMP2r
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( 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 MOD2 #0000 EQU2
	( res ) MUL #00 SWP .timer/frame LDZ2 SWP2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] #0000 EQU2
	( bang on equal ) #fc MUL LIT '. ADD
	( output ) STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2



@@ 240,7 240,7 @@ JMP2r
	( 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 MOD
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA ;chrb36 JSR2 ] ADD SWP ( MOD ) [ DIVk MUL SUB ]
	( 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



@@ 364,7 364,7 @@ JMP2r
		INC GTHk ,&loop JCN
	POP
	( read ) STH2kr INC2 ;get-port-right-raw JSR2
	( output ) ROT ROT MOD #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2 ;set-port-output JSR2
	( output ) ROT ROT ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2 ;set-port-output JSR2

JMP2r
	&? 'P "Writes 20 "eastward 20 "operand $1


@@ 401,7 401,7 @@ JMP2r
	( 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 SUB ;prng JSR2 ADD SWP DUP #00 EQU ADD MOD ADD
	( mod ) OVR SUB ;prng JSR2 ADD SWP DUP #00 EQU ADD ( MOD ) [ 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



@@ 439,7 439,7 @@ JMP2r
		( type ) LOCKED-TYPE STH2r ;data/types ADD2 STA
		INC GTHk ,&loop JCN
	POP
	( read ) MOD #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2
	( read ) ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2
	STH2r #00 .grid/width LDZ ADD2 ;set-port-output JSR2

JMP2r


@@ 454,7 454,7 @@ JMP2r
	( max ) STH2kr INC2 ;get-port-right-value JSR2 DUP #00 EQU ADD STH2
	( 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 MOD2
	( % max ) STHkr #00 SWP ( MOD2 ) [ DIV2k MUL2 SUB2 ]
	( ADD step ) SWPr STHr #00 SWP ADD2
	( bucket GTH= max ) STHr #00 SWP LTH2 #01 NEQ
	( bang if equal ) #fc MUL LIT '. ADD

M src/manifest.tal => src/manifest.tal +7 -24
@@ 20,7 20,7 @@ BRK
	#42 .Mouse/state DEI #00 NEQ ADD .Screen/sprite DEO
	( when touch cat )
	.Mouse/state DEI #00 EQU ,&no-touch-cat JCN
	.Mouse/y DEI2 menu-hit GTH2 ,&no-touch-cat JCN
	.Mouse/y DEI2 #0014 GTH2 ,&no-touch-cat JCN
		.Mouse/x DEI2 ;get-xcat JSR2 ;menu-select JSR2
		( release ) #00 .Mouse/state DEO
		BRK


@@ 28,7 28,7 @@ BRK
	( when sub active )
	;draw-menu/sel LDA #ff EQU ,&no-sub JCN
		( when sel changed )
		.Mouse/y DEI2 #0004 SUB2 menu-r SFT2 NIP #01 SUB
		.Mouse/y DEI2 #0004 SUB2 #04 SFT2 NIP #01 SUB
		DUP ;draw-sub/sel LDA EQU ,&no-change JCN
			DUP ;draw-sub/sel STA
			;draw-menu/sel LDA #ff ;draw-sub JSR2


@@ 43,7 43,7 @@ BRK
		&no-sub
	( don't leave if menu is active )
	;draw-menu/sel LDA #ff NEQ ,&no-leave JCN
	.Mouse/y DEI2 menu-hit LTH2 ,&no-leave JCN
	.Mouse/y DEI2 #0014 LTH2 ,&no-leave JCN
		,menu-close JSR
		&no-leave



@@ 231,7 231,7 @@ JMP2r
	#00 ,&id STR
	[ LIT2 &manifest :manifest ]
	&cat
		menu-sel menu-def [ LIT &sel ff ] [ LIT &id $1 ] EQU [ JMP SWP POP ] ;draw-chr/color STA
		#0401 [ LIT &sel ff ] [ LIT &id $1 ] EQU [ JMP SWP POP ] ;draw-chr/color STA
		INC2k ;draw-str JSR2 POP2 #20 ;draw-chr JSR2
		;skip-sub JSR2
		,&id LDR INC ,&id STR


@@ 249,9 249,9 @@ JMP2r
	LDAk STH INC2 ;skip-str JSR2
	STHr #00
	&subcat
		STHk menu-hov menu-sel STHr [ LIT &sel ff ] EQU [ JMP SWP POP ] [ LIT &mask $1 ] AND ;draw-chr/color STA
		STHk #0804 STHr [ LIT &sel ff ] EQU [ JMP SWP POP ] [ LIT &mask $1 ] AND ;draw-chr/color STA
		[ LIT2 &anchor $2 ] .Screen/x DEO2
		#00 OVR INC menu-l SFT2 #0004 ADD2 .Screen/y DEO2
		#00 OVR INC #40 SFT2 #0004 ADD2 .Screen/y DEO2
		SWP2 ;draw-label JSR2 SWP2
		INC GTHk ,&subcat JCN
	POP2 POP2


@@ 267,7 267,7 @@ JMP2r
		.Screen/auto DEI
			#f2 .Screen/auto DEO
			;blank-icn .Screen/addr DEO2
			;draw-chr/color LDA .Screen/sprite menu-label
			;draw-chr/color LDA .Screen/sprite DEOk DEO
		.Screen/auto DEO
	.Screen/y DEO2
	( mod )


@@ 312,23 312,6 @@ JMP2r
	&cat ;&buf ;scat JSR2 ,&end JMP
	&bsp "bsp $1 &tab "tab $1 &ent "ent $1 &spc "spc $1 &esc "esc $1 &del "del $1

@draw-str-right ( text* -- )

	DUP2 ;get-strw JSR2 STH2
	.Screen/x DEI2k STH2r SUB2 ROT DEO2

@draw-str ( str* -- str* )

	LDAk #00 EQU ,&skip JCN
	menu-auto .Screen/auto DEO
	&while
		LDAk ;draw-chr JSR2
		INC2 LDAk ,&while JCN
	&skip
	INC2

JMP2r

@update-cursor ( color addr* -- )

	#00 .Screen/auto DEO

M src/orca.tal => src/orca.tal +47 -34
@@ 1,4 1,4 @@
( app/orca : livecoding ide )
( Orca )

|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|10 @Console &vector $2 &read $1 &pad $5 &write $1


@@ 16,40 16,28 @@
%OPERATOR-TYPE { #03 } %PORTER-TYPE { #04 }
%OUTPUT-TYPE { #05 } %IO-TYPE { #07 }

%MOD { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }

%menu-def { #01 }
%menu-sel { #04 }
%menu-hov { #08 }
%menu-hit { #0014 }
%menu-auto { #15 }
%menu-label { DEOk DEO }
%menu-l { #40 }
%menu-r { #04 }

|0000

@dpad $1 &last $1
@timer &beat $1 &speed $1 &playing $1 &frame $1 &frame-lb $1
@state &timer $1 &changed $1
@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
@cursor &x $2 &y $2
@toolbar &x1 $2 &y1 $2 &x2 $2 &y2 $2
@head &x $1 &y $1 &addr $2
@variables $24
@signal &midi $1 &midi-last $1
@voices $20
	@dpad $1 &last $1
	@timer &beat $1 &speed $1 &playing $1 &frame $1 &frame-lb $1
	@state &timer $1 &changed $1
	@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
	@cursor &x $2 &y $2
	@toolbar &x1 $2 &y1 $2 &x2 $2 &y2 $2
	@head &x $1 &y $1 &addr $2
	@variables $24
	@signal &midi $1 &midi-last $1
	@voices $20

|0100 ( -> )

	( theme )
	#0f38 .System/r DEO2
	#0fc8 .System/g DEO2
	#0f98 .System/b DEO2
	#0f58 .System/r DEO2
	#0fb8 .System/g DEO2
	#0fa8 .System/b DEO2

	( init random )
	;init-prng JSR2


@@ 155,6 143,9 @@ BRK
			01 'a :select-all "All $1
		$1

(
@|vectors )

@untrap ( -- )

	( vectors )


@@ 366,7 357,8 @@ BRK

BRK

( selection )
(
@|selection )

@play-decr ( -- ) #ff ;mod-speed JSR2 JMP2r
@play-incr ( -- ) #01 ;mod-speed JSR2 JMP2r


@@ 636,7 628,8 @@ JMP2r

JMP2r

( drawing )
(
@|drawing )

@draw-dpad ( -- )



@@ 852,6 845,23 @@ JMP2r

JMP2r

@draw-str-right ( text* -- )

	DUP2 ,get-strw JSR STH2
	.Screen/x DEI2k STH2r SUB2 ROT DEO2

@draw-str ( str* -- str* )

	LDAk #00 EQU ,&skip JCN
	#15 .Screen/auto DEO
	&while
		LDAk ,draw-chr JSR
		INC2 LDAk ,&while JCN
	&skip
	INC2

JMP2r

@draw-str-color ( str* color -- )

	,draw-chr/color STR


@@ 865,7 875,8 @@ JMP2r

JMP2r

( file )
(
@|document )

@file-new ( -- )



@@ 1029,10 1040,11 @@ JMP2r

JMP2r

( helpers )
(
@|stdlib )

@base128 ( char - b128 ) ,chrb36 JSR #00 SWP #007f MUL2 #0023 DIV2 NIP JMP2r
@b36chr ( b36 -- char ) #24 MOD #00 SWP ;b36clc ADD2 LDA JMP2r
@b36chr ( b36 -- char ) #24 ( MOD ) [ DIVk MUL SUB ] #00 SWP ;b36clc ADD2 LDA JMP2r
@chrb36 ( char -- b36 ) #20 SUB #00 SWP ;values ADD2 LDA JMP2r
@chrmid ( char -- midi ) DUP ,chrb36 JSR SWP ,ciuc JSR #24 MUL ADD #00 SWP ;notes ADD2 LDA JMP2r
@ciuc ( char -- bool ) DUP #40 GTH SWP #5b LTH AND JMP2r


@@ 1114,3 1126,4 @@ JMP2r
	&cells $4000
	&locks $4000
	&types $4000