~rabbits/orca-toy

7ade8024516a1f776c18b943c73126b3d021612f — Devine Lu Linvega a month ago 43430d9
Removed extra macros
4 files changed, 160 insertions(+), 149 deletions(-)

M src/assets.tal
M src/library.tal
M src/manifest.tal
M src/orca.tal
M src/assets.tal => src/assets.tal +97 -0
@@ 239,3 239,100 @@
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0000 0000 0000 0000

@op-ascii
	( 20	_ ) :op-null
	( 21	! ) :op-null
	( 22	" ) :op-null
	( 23	# ) :op-comment
	( 24	$ ) :op-self
	( 25	% ) :op-null
	( 26	& ) :op-null
	( 27	' ) :op-null
	( 28	_ ) :op-null
	( 29	_ ) :op-null
	( 2A	* ) :op-bang
	( 2B	+ ) :op-null
	( 2C	, ) :op-null
	( 2D	- ) :op-null
	( 2E	. ) :op-null
	( 2F	/ ) :op-byte
	( 30	0 ) :op-null
	( 31	1 ) :op-null
	( 32	2 ) :op-null
	( 33	3 ) :op-null
	( 34	4 ) :op-null
	( 35	5 ) :op-null
	( 36	6 ) :op-null
	( 37	7 ) :op-null
	( 38	8 ) :op-null
	( 39	9 ) :op-null
	( 3A	: ) :op-midi
	( 3B	; ) :op-pitch
	( 3C	< ) :op-null
	( 3D	= ) :op-synth
	( 3E	> ) :op-null
	( 3F	? ) :op-null
	( 40	@ ) :op-null
	( 41	A ) :op-a
	( 42	B ) :op-b
	( 43	C ) :op-c
	( 44	D ) :op-d
	( 45	E ) :op-e
	( 46	F ) :op-f
	( 47	G ) :op-g
	( 48	H ) :op-h
	( 49	I ) :op-i
	( 4A	J ) :op-j
	( 4B	K ) :op-k
	( 4C	L ) :op-l
	( 4D	M ) :op-m
	( 4E	N ) :op-n
	( 4F	O ) :op-o
	( 50	P ) :op-p
	( 51	Q ) :op-q
	( 52	R ) :op-r
	( 53	S ) :op-s
	( 54	T ) :op-t
	( 55	U ) :op-u
	( 56	V ) :op-v
	( 57	W ) :op-w
	( 58	X ) :op-x
	( 59	Y ) :op-y
	( 5A	Z ) :op-z
	( 5B	[ ) :op-null
	( 5C	\ ) :op-null
	( 5D	] ) :op-null
	( 5E	^ ) :op-null
	( 5F	_ ) :op-null
	( 60	` ) :op-null
	( 61	a ) :op-a-lc
	( 62	b ) :op-b-lc
	( 63	c ) :op-c-lc
	( 64	d ) :op-d-lc
	( 65	e ) :op-e-lc
	( 66	f ) :op-f-lc
	( 67	g ) :op-g-lc
	( 68	h ) :op-h-lc
	( 69	i ) :op-i-lc
	( 6A	j ) :op-j-lc
	( 6B	k ) :op-k-lc
	( 6C	l ) :op-l-lc
	( 6D	m ) :op-m-lc
	( 6E	n ) :op-n-lc
	( 6F	o ) :op-o-lc
	( 70	p ) :op-p-lc
	( 71	q ) :op-q-lc
	( 72	r ) :op-r-lc
	( 73	s ) :op-s-lc
	( 74	t ) :op-t-lc
	( 75	u ) :op-u-lc
	( 76	v ) :op-v-lc
	( 77	w ) :op-w-lc
	( 78	x ) :op-x-lc
	( 79	y ) :op-y-lc
	( 7A	z ) :op-z-lc
	( 7B	{ ) :op-null
	( 7C	| ) :op-null
	( 7D	} ) :op-null
	( 7E	~ ) :op-null
	( 7F	_ ) :op-null

M src/library.tal => src/library.tal +35 -133
@@ 1,101 1,3 @@
@op-ascii
	( 20	_ ) :op-null
	( 21	! ) :op-null
	( 22	" ) :op-null
	( 23	# ) :op-comment
	( 24	$ ) :op-self
	( 25	% ) :op-null
	( 26	& ) :op-null
	( 27	' ) :op-null
	( 28	_ ) :op-null
	( 29	_ ) :op-null
	( 2A	* ) :op-bang
	( 2B	+ ) :op-null
	( 2C	, ) :op-null
	( 2D	- ) :op-null
	( 2E	. ) :op-null
	( 2F	/ ) :op-byte
	( 30	0 ) :op-null
	( 31	1 ) :op-null
	( 32	2 ) :op-null
	( 33	3 ) :op-null
	( 34	4 ) :op-null
	( 35	5 ) :op-null
	( 36	6 ) :op-null
	( 37	7 ) :op-null
	( 38	8 ) :op-null
	( 39	9 ) :op-null
	( 3A	: ) :op-midi
	( 3B	; ) :op-pitch
	( 3C	< ) :op-null
	( 3D	= ) :op-synth
	( 3E	> ) :op-null
	( 3F	? ) :op-null
	( 40	@ ) :op-null
	( 41	A ) :op-a
	( 42	B ) :op-b
	( 43	C ) :op-c
	( 44	D ) :op-d
	( 45	E ) :op-e
	( 46	F ) :op-f
	( 47	G ) :op-g
	( 48	H ) :op-h
	( 49	I ) :op-i
	( 4A	J ) :op-j
	( 4B	K ) :op-k
	( 4C	L ) :op-l
	( 4D	M ) :op-m
	( 4E	N ) :op-n
	( 4F	O ) :op-o
	( 50	P ) :op-p
	( 51	Q ) :op-q
	( 52	R ) :op-r
	( 53	S ) :op-s
	( 54	T ) :op-t
	( 55	U ) :op-u
	( 56	V ) :op-v
	( 57	W ) :op-w
	( 58	X ) :op-x
	( 59	Y ) :op-y
	( 5A	Z ) :op-z
	( 5B	[ ) :op-null
	( 5C	\ ) :op-null
	( 5D	] ) :op-null
	( 5E	^ ) :op-null
	( 5F	_ ) :op-null
	( 60	` ) :op-null
	( 61	a ) :op-a-lc
	( 62	b ) :op-b-lc
	( 63	c ) :op-c-lc
	( 64	d ) :op-d-lc
	( 65	e ) :op-e-lc
	( 66	f ) :op-f-lc
	( 67	g ) :op-g-lc
	( 68	h ) :op-h-lc
	( 69	i ) :op-i-lc
	( 6A	j ) :op-j-lc
	( 6B	k ) :op-k-lc
	( 6C	l ) :op-l-lc
	( 6D	m ) :op-m-lc
	( 6E	n ) :op-n-lc
	( 6F	o ) :op-o-lc
	( 70	p ) :op-p-lc
	( 71	q ) :op-q-lc
	( 72	r ) :op-r-lc
	( 73	s ) :op-s-lc
	( 74	t ) :op-t-lc
	( 75	u ) :op-u-lc
	( 76	v ) :op-v-lc
	( 77	w ) :op-w-lc
	( 78	x ) :op-x-lc
	( 79	y ) :op-y-lc
	( 7A	z ) :op-z-lc
	( 7B	{ ) :op-null
	( 7C	| ) :op-null
	( 7D	} ) :op-null
	( 7E	~ ) :op-null
	( 7F	_ ) :op-null

@op-table
	&docs
	:op-a/? :op-b/? :op-c/? :op-d/? :op-e/? :op-f/? :op-g/? :op-h/?


@@ 108,7 10,7 @@
@op-a ( add )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 124,7 26,7 @@ JMP2r
@op-b ( subtract )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 140,7 42,7 @@ JMP2r
@op-c ( clock )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator 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-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR


@@ 156,7 58,7 @@ JMP2r
@op-d ( delay )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator 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 ) [ DIV2k MUL2 SUB2 ] #0000 EQU2


@@ 170,7 72,7 @@ JMP2r
@op-e ( east )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/x LDZ INC .grid/width LDZ EQU ,&collide JCN
	( cell ) STH2kr INC2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN


@@ 187,7 89,7 @@ JMP2r
@op-f ( if )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 ;get-port-left-raw JSR2
	( get b ) STH2kr INC2 ;get-port-right-raw JSR2
	( bang on equal ) EQU [ #fc MUL LIT '. ADD ]


@@ 200,7 102,7 @@ JMP2r
@op-g ( generator )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( x ) STH2kr #0003 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP ADD2
	( y ) STH2kr #0002 SUB2 ;get-port-left-value JSR2


@@ 222,11 124,11 @@ JMP2r
@op-h ( hold )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	POP2r
	#00 .grid/width LDZ ADD2
	( set lock ) DUP2 #01 ROT ROT ;data/locks ADD2 STA
	( set type ) OUTPUT-TYPE ROT ROT ;data/types ADD2 STA
	( set type ) .types/output ROT ROT ;data/types ADD2 STA

JMP2r
	&? 'H "Holds 20 "southward 20 "operand $1


@@ 235,7 137,7 @@ JMP2r
@op-i ( increment )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( step ) #0001 SUB2 ;get-port-left-value JSR2
	( mod ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR


@@ 251,7 153,7 @@ JMP2r
@op-j ( jumper )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( get above ) #00 .grid/width LDZ SUB2 ;get-port-left-raw JSR2
	( ignore cable )
	DUP ;chrb36 JSR2 #13 NEQ ,&no-wire JCN


@@ 270,7 172,7 @@ JMP2r
@op-k ( konkat )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	#0001 SUB2 ;get-port-left-value JSR2 #00
	&loop
		#00 OVR STH2kr INC2 ADD2 STH2k ;get-port-right-raw JSR2


@@ 291,7 193,7 @@ JMP2r
@op-l ( lesser )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 307,7 209,7 @@ JMP2r
@op-m ( multiply )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 323,7 225,7 @@ JMP2r
@op-n ( north )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/y LDZ #01 SUB #ff EQU ,&collide JCN
	( cell ) STH2kr #00 .grid/width LDZ SUB2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN


@@ 340,7 242,7 @@ JMP2r
@op-o ( read )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 353,14 255,14 @@ JMP2r
@op-p ( push )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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
		( lock ) #01 STH2kr ;data/locks ADD2 STA
		( type ) LOCKED-TYPE STH2r ;data/types ADD2 STA
		( type ) .types/locked STH2r ;data/types ADD2 STA
		INC GTHk ,&loop JCN
	POP
	( read ) STH2kr INC2 ;get-port-right-raw JSR2


@@ 373,7 275,7 @@ JMP2r
@op-q ( query )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( x ) STH2kr #0003 SUB2 ;get-port-left-value JSR2
		( load ) #00 SWP INC2 ADD2
	( y ) STH2kr #0002 SUB2 ;get-port-left-value JSR2


@@ 396,7 298,7 @@ JMP2r
@op-r ( random )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 412,7 314,7 @@ JMP2r
@op-s ( south )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/y LDZ INC .grid/height LDZ EQU ,&collide JCN
	( cell ) STH2kr #00 .grid/width LDZ ADD2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN


@@ 429,14 331,14 @@ JMP2r
@op-t ( track )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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
		( lock ) #01 STH2kr ;data/locks ADD2 STA
		( type ) LOCKED-TYPE STH2r ;data/types ADD2 STA
		( type ) .types/locked STH2r ;data/types ADD2 STA
		INC GTHk ,&loop JCN
	POP
	( read ) ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2kr INC2 ADD2 ;get-port-right-raw JSR2


@@ 449,7 351,7 @@ JMP2r
@op-u ( Uclid )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( step ) #0001 SUB2 ;get-port-left-value JSR2
	( 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


@@ 467,7 369,7 @@ JMP2r
@op-v ( variable )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( key ) #0001 SUB2 ;get-port-left-raw JSR2
	( val ) STH2kr INC2 ;get-port-right-raw JSR2
	DUP LIT '. EQU ,&idle JCN


@@ 486,7 388,7 @@ JMP2r
@op-w ( west )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( wall ) .head/x LDZ #01 SUB #ff EQU ,&collide JCN
	( cell ) STH2kr #0001 SUB2 ;data/cells ADD2 LDA LIT '. NEQ ,&collide JCN


@@ 503,7 405,7 @@ JMP2r
@op-x ( write )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( 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


@@ 516,7 418,7 @@ JMP2r
@op-y ( yumper )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( get above ) #0001 SUB2 ;get-port-left-raw JSR2
	( ignore cable )
	DUP ;chrb36 JSR2 #22 NEQ ,&no-wire JCN


@@ 535,7 437,7 @@ JMP2r
@op-z ( lerp )

	STH2k
	( set type ) OPERATOR-TYPE STH2kr ;data/types ADD2 STA
	( set type ) .types/operator STH2kr ;data/types ADD2 STA
	( rate ) #0001 SUB2 ;get-port-left-value JSR2
	( target ) STH2kr INC2 ;get-port-right-raw JSR2
		( get case ) DUP ;ciuc JSR2 ,&case STR


@@ 567,7 469,7 @@ JMP2r
		( set lock ) DUP2 #01 ROT ROT ;data/locks ADD2 STA
		( set type if unset )
		DUP2 ;data/types ADD2 LDA ,&skip JCN
			( set type ) DUP2 LOCKED-TYPE ROT ROT ;data/types ADD2 STA
			( set type ) DUP2 .types/locked ROT ROT ;data/types ADD2 STA
			&skip
		( stop at hash ) DUP2 ;data/cells ADD2 LDA LIT '# EQU ,&end JCN
		INC2 GTH2k ,&loop JCN


@@ 585,7 487,7 @@ JMP2r
	( note ) STH2kr #0003 ADD2 ;get-port-right-raw JSR2
	( has note ) DUP LIT '. 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
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD
	( play ) .Audio0/pitch [ LIT &ch $1 ] #03 AND #40 SFT ADD DEO



@@ 606,7 508,7 @@ JMP2r

	( store length ) .voices ,&ch LDR DUP ADD ADD INC STZk POP [ ,&len STR ]

	( animate ) IO-TYPE STH2r ;data/types ADD2 STA
	( animate ) .types/io STH2r ;data/types ADD2 STA

	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD
	( store note ) DUP .voices ,&ch LDR DUP ADD ADD STZ


@@ 643,7 545,7 @@ JMP2r
	( note ) STH2kr INC2 INC2 ;get-port-right-raw JSR2
	( has note ) DUP LIT '. 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
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( get note ) ;chrmid JSR2 SWP [ #0c MUL ] ADD .Console/write DEO

JMP2r


@@ 655,7 557,7 @@ JMP2r
	( hn ) INC2 ;get-port-right-value JSR2
	( ln ) STH2kr INC2 INC2 ;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
	( animate ) .types/io STH2r ;data/types ADD2 STA
	#0f AND SWP #0f AND #40 SFT ADD .Console/write DEO

JMP2r


@@ 669,7 571,7 @@ JMP2r
	POP2
	( has bang ) ;get-bang JSR2 ,&is-bang JCN [ POP2r JMP2r ] &is-bang
	.head LDZ2 INC STH2kr ;get-word JSR2 ;inject-file JSR2
	( animate ) IO-TYPE STH2r ;data/types ADD2 STA
	( animate ) .types/io STH2r ;data/types ADD2 STA

JMP2r
	&? '$ "Load 20 "orca 20 "file $1

M src/manifest.tal => src/manifest.tal +10 -10
@@ 81,15 81,15 @@ JMP2r
	#ff ;draw-sub/sel STA
	DUP ;draw-menu/sel STA
	#ff ;draw-sub JSR2
	;draw-menu JSR2
	;draw-menu ( .. )

JMP2r
JMP2

@menu-deselect ( cat cat -- )

	POP2 ;menu-close JSR2
	POP2 ;menu-close ( .. )

JMP2r
JMP2

@menu-select-sub ( sub -- )



@@ 274,9 274,9 @@ JMP2r
	STH2k #0078 ADD2 .Screen/x DEO2
	LDA2k ;get-modkey-str JSR2 ;draw-str-right JSR2 POP2
	STH2r .Screen/x DEO2
	#0004 ADD2 ;draw-str JSR2
	#0004 ADD2 ;draw-str ( .. )

JMP2r
JMP2

@get-modkey-str ( mod key -- str* )



@@ 348,16 348,16 @@ JMP2r
JMP2r
	&path ".theme $1

( stdlib )
(
@|stdlib )

@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r
@spop ( str* -- ) LDAk ,&n JCN POP2 JMP2r &n ,scap JSR #0001 SUB2 #00 ROT ROT STA JMP2r
@sput ( chr str* -- ) ,scap JSR STA JMP2r
@sput ( chr str* -- ) ,scap JSR INC2k #00 ROT ROT STA STA JMP2r
@slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r
@scat ( src* dst* -- ) DUP2 ,slen JSR ADD2
@scat ( src* dst* -- ) ,scap JSR
@scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r
@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ,&loop JCN POP2 POP2 POP2r JMP2r

@print ( short* -- )


M src/orca.tal => src/orca.tal +18 -6
@@ 12,9 12,18 @@
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1

%LOCKED-TYPE { #01 } %PORTEL-TYPE { #02 }
%OPERATOR-TYPE { #03 } %PORTER-TYPE { #04 }
%OUTPUT-TYPE { #05 } %IO-TYPE { #07 }
( enums )

|00

	@types
		&default $1
		&locked $1
		&portel $1
		&operator $1
		&porter $1
		&output $1
		&io $1

|0000



@@ 309,6 318,7 @@ BRK
	.Mouse/y DEI2 DUP2 .cursor/y STZ2 .Screen/y DEO2
	;cursor-icn .Screen/addr DEO2
	.Mouse/state DEI #00 NEQ DUP ADD #41 ADD .Screen/sprite DEO

	( route )
	.Mouse/x DEI2 .Mouse/y DEI2 .grid ;within-rect JSR2 ,on-mouse-grid JCN
	.Mouse/x DEI2 .Mouse/y DEI2 .toolbar ;within-rect JSR2 ,on-mouse-toolbar JCN


@@ 1043,6 1053,8 @@ JMP2r
(
@|stdlib )

@mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ,&loop JCN POP2 POP2 POP2r JMP2r

@base128 ( char - b128 ) ,chrb36 JSR #00 SWP #007f MUL2 #0023 DIV2 NIP 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


@@ 1058,7 1070,7 @@ JMP2r

@get-port-left-raw ( addr* -- value )

	( set type ) STH2k PORTEL-TYPE STH2r ;data/types ADD2 STA
	( set type ) STH2k .types/portel STH2r ;data/types ADD2 STA
	( get data ) ;data/cells ADD2 LDA

JMP2r


@@ 1066,7 1078,7 @@ JMP2r
@get-port-right-raw ( addr* -- value )

	( set lock ) STH2k #01 STH2kr ;data/locks ADD2 STA
	( set type ) PORTER-TYPE STH2r ;data/types ADD2 STA
	( set type ) .types/porter STH2r ;data/types ADD2 STA
	( get data ) ;data/cells ADD2 LDA

JMP2r


@@ 1074,7 1086,7 @@ JMP2r
@set-port-output ( value addr* -- )

	( set lock ) STH2k #01 STH2kr ;data/locks ADD2 STA
	( set type ) OUTPUT-TYPE STH2r ;data/types ADD2 STA
	( set type ) .types/output STH2r ;data/types ADD2 STA
	( set data ) ;data/cells ADD2 STA

JMP2r