~rabbits/orca-toy

801d6b71383d05c19cfa864b9abe475bb1f34d71 — Devine Lu Linvega 22 days ago 6bcc2fe
Spaced out lib
1 files changed, 68 insertions(+), 0 deletions(-)

M src/library.tal
M src/library.tal => src/library.tal +68 -0
@@ 12,26 12,31 @@

@op-a "A "Outputs 20 "sum 20 "of 20 "inputs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( a ) get-port-left1-value
	( b ) STH2kr get-port-right1-raw
		( case-val ) DUP ciuc ,&case STR chrb36
	( res ) ADD

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-b "B "Outputs 20 "difference 20 "of 20 "inputs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( a ) get-port-left1-value
	( b ) STH2kr get-port-right1-raw
		( case-val ) DUP ciuc ,&case STR chrb36
	( res ) SUB DUP #80 LTH ?&bounce #24 SWP SUB &bounce

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-c "C "Outputs 20 "modulo 20 "of 20 "frame $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2
	( set type ) .types/op STH2kr write-type
	.timer/frame LDZ2


@@ 42,10 47,12 @@
			( case-val ) DUP ciuc ,&case STR chrb36
			( min1* ) EQUk ADD
		( mod2 ) [ DIV2k MUL2 SUB2 ] NIP

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-d "D "Bangs 20 "on 20 "modulo 20 "of 20 "frame $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2
	( set type ) .types/op STH2kr write-type
	.timer/frame LDZ2


@@ 54,31 61,37 @@
			MUL2
		( mod2 ) [ DIV2k MUL2 SUB2 ] #0000 EQU2
		( bang ) [ LIT2 "*. ] ROT [ JMP SWP POP ]

STH2r !set-port-output-below

@op-e "E "Moves 20 "eastward 20 "or 20 "bangs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR
	( wall ) .head/x LDZ INC .grid/width LDZ EQU ?&collide
	( cell ) STH2kr INC2 read-cell LIT ". NEQ ?&collide
	( new ) [ LIT &self $1 ] STH2kr INC2 set-port-raw

LIT ". STH2r !set-port-raw
	&collide
LIT "* STH2r !set-port-output

@op-f "F "Bangs 20 "if 20 "inputs 20 "are 20 "equal $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( a ) get-port-left1-raw
	( b ) STH2kr get-port-right1-raw
	( bang ) EQU [ LIT2 "*. ] ROT [ JMP SWP POP ]

STH2r !set-port-output-below

@op-g "G "Writes 20 "operands 20 "with 20 "offset $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0003 SUB2 get-port-left-value


@@ 94,17 107,21 @@ STH2r !set-port-output-below
		INC GTHk ?&l
	POP2
	POP2r

JMP2r

@op-h "H "Holds 20 "southward 20 "operand $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( cell ) #00 .grid/width LDZ ADD2 read-cell

STH2r !set-port-output-below

@op-i "I "Increments 20 "southward 20 "operand $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( step ) get-port-left1-value


@@ 113,10 130,12 @@ STH2r !set-port-output-below
		( min1 ) DUP #00 EQU ADD
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 read-cell chrb36 ADD SWP
	( MOD ) [ DIVk MUL SUB ]

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-j "J "Outputs 20 "northward 20 "operand $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( get above ) #00 .grid/width LDZ SUB2 get-port-left-raw


@@ 128,10 147,12 @@ STH2r !set-port-output-below
	&while
		#00 .grid/width LDZ ADD2 DUP2 read-cell chrb36 #13 EQU
		?&while

!set-port-output

@op-k "K "Reads 20 "multiple 20 "variables $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	get-port-left1-value #00


@@ 146,30 167,36 @@ STH2r !set-port-output-below
		INC GTHk ?&l
	POP2
	POP2r

JMP2r

@op-l "L "Outputs 20 "smallest 20 "of 20 "inputs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( a ) get-port-left1-value
	( b ) STH2kr get-port-right1-raw
		( case-val ) DUP ciuc ,&case STR chrb36
	( res ) [ LTHk JMP SWP POP ]

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-m "M "Outputs 20 "product 20 "of 20 "inputs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( a ) get-port-left1-value
	( b ) STH2kr get-port-right1-raw
		( case-val ) DUP ciuc ,&case STR chrb36
	( res ) MUL

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-n "N "Moves 20 "Northward 20 "or 20 "bangs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR


@@ 178,19 205,23 @@ JMP2r
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ SUB2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide

LIT "* STH2r !set-port-output

@op-o "O "Reads 20 "operand 20 "with 20 "offset $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0002 SUB2 get-port-left-value INC #00 SWP ADD2
	( y ) STH2kr get-port-left1-value #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) get-port-right-raw

STH2r !set-port-output-below

@op-p "P "Writes 20 "eastward 20 "operand $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( key ) #0002 SUB2 get-port-left-value


@@ 205,10 236,12 @@ STH2r !set-port-output-below
	( read ) STH2kr get-port-right1-raw
	ROT ROT
	( MOD ) [ DIVk MUL SUB ] #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2

!set-port-output

@op-q "Q "Reads 20 "operands 20 "with 20 "offset $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0003 SUB2 get-port-left-value


@@ 225,10 258,12 @@ STH2r !set-port-output-below
		INC GTHk ?&l
	POP2
	POP2r

JMP2r

@op-r "R "Outputs 20 "random 20 "value $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( a-min ) get-port-left1-value


@@ 237,10 272,12 @@ JMP2r
		( min1 ) DUP #00 EQU ADD
	( mod ) OVR SUB prng ADD SWP ( min1 ) DUP #00 EQU ADD
	( MOD ) [ DIVk MUL SUB ] ADD

[ LIT &case $1 ] set-case STH2r !set-port-output-below

@op-s "S "Moves 20 "southward 20 "or 20 "bangs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR


@@ 249,10 286,12 @@ JMP2r
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ ADD2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide

LIT "* STH2r !set-port-output

@op-t "T "Reads 20 "eastward 20 "operand $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( key ) #0002 SUB2 get-port-left-value


@@ 266,10 305,12 @@ LIT "* STH2r !set-port-output
	POP
	( read )
	( MOD ) [ DIVk MUL SUB ] #00 SWP STH2kr INC2 ADD2 get-port-right-raw

STH2r !set-port-output-below

@op-u "U "Bangs 20 "on 20 "Euclidean 20 "rhythm $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( step ) get-port-left1-value


@@ 281,10 322,12 @@ STH2r !set-port-output-below
	( ADD step ) SWPr STHr #00 SWP ADD2
	( bucket GTH= max ) STHr #00 SWP LTH2 #01 NEQ
	( bang if equal ) #fc MUL LIT ". ADD

STH2r !set-port-output-below

@op-v "V "Reads 20 "and 20 "writes 20 "variable $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( key ) get-port-left1-raw


@@ 297,10 340,12 @@ STH2r !set-port-output-below
		SWP chrb36 .variables ADD STZ POP2r JMP2r
	&idle
		POP2 POP2r

JMP2r

@op-w "W "Moves 20 "westward 20 "or 20 "bangs $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR


@@ 309,20 354,24 @@ JMP2r
	( write new ) [ LIT &self $1 ] STH2kr #0001 SUB2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide

LIT "* STH2r !set-port-output

@op-x "X "Writes 20 "operand 20 "with 20 "offset $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0002 SUB2 get-port-left-value #00 SWP ADD2
	( y ) STH2kr get-port-left1-value INC #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) STH2r get-port-right1-raw
	ROT ROT

!set-port-output

@op-y "Y "Outputs 20 "westward 20 "operand $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( get above ) get-port-left1-raw


@@ 334,10 383,12 @@ LIT "* STH2r !set-port-output
	&while
		INC2 DUP2 read-cell chrb36 #22 EQU
		?&while

!set-port-output

@op-z "Z "Transitions 20 "operand 20 "to 20 "input $1
	&lc get-bang ?&* POP2 JMP2r &*

	STH2k
	( set type ) .types/op STH2kr write-type
	( rate ) get-port-left1-value


@@ 345,6 396,7 @@ LIT "* STH2r !set-port-output
		( case-val ) DUP ciuc ,&case STR chrb36
	( val ) STH2kr #00 .grid/width LDZ ADD2 read-cell chrb36
	( res ) lerp

[ LIT &case $1 ] set-case STH2r !set-port-output-below

(


@@ 352,11 404,14 @@ LIT "* STH2r !set-port-output

@op-bang "* "Bangs 20 "neighboring 20 "operands $1
	&*

	LIT ". ROT ROT

!write-cell

@op-comment "# "Comments 20 "a 20 "line $1
	&*

	STH2k
	( set itself )
	.types/comment STH2kr write-type


@@ 373,10 428,12 @@ LIT "* STH2r !set-port-output
		INC2 GTH2k ?&l
	&end
	POP2 POP2

JMP2r

@op-synth "= "Play 20 "note 20 "with 20 "uxn 20 "synth $1
	&*

	STH2k
	( channel ) get-port-right1-value [ ,&ch STR ]
	( octave ) STH2kr INC2 get-port-right1-value


@@ 386,10 443,12 @@ JMP2r
	( animate ) .types/io STH2r write-type
	( get note ) chrmid SWP [ #0c MUL ] ADD
	( play ) .Audio0/pitch [ LIT &ch $1 ] #03 AND #40 SFT ADD DEO

JMP2r

@op-midi ": "Send 20 "a 20 "midi 20 "note $1
	&*

	STH2k
	( channel ) get-port-right1-value [ ,&ch STR ]
	( octave ) STH2kr INC2 get-port-right1-value


@@ 421,10 480,12 @@ JMP2r
		JMP2r
	&done
	POP2

JMP2r

@op-pitch "; "Send 20 "a 20 "raw 20 "pitch 20 "byte $1
	&*

	STH2k
	( octave ) get-port-right1-value
	( note ) STH2kr INC2 get-port-right1-raw


@@ 432,20 493,24 @@ JMP2r
	( has bang ) get-bang ?&is-bang [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r write-type
	( get note ) chrmid SWP [ #0c MUL ] ADD .Console/write DEO

JMP2r

@op-byte "/ "Send 20 "a 20 "raw 20 "hexadecimal 20 "byte $1
	&*

	STH2k
	( hn ) get-port-right1-value
	( ln ) STH2kr INC2 get-port-right1-value
	( has bang ) get-bang ?&is-bang [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r write-type
	#0f AND SWP #0f AND #40 SFT ADD .Console/write DEO

JMP2r

@op-self "$ "Load 20 "orca 20 "file $1
	&*

	STH2k
	&while
		INC2 DUP2 get-port-right-raw LIT ". NEQ ?&while


@@ 453,11 518,14 @@ JMP2r
	( has bang ) get-bang ?&is-bang [ POP2r JMP2r ] &is-bang
	.head LDZ2 INC STH2kr get-word inject-file
	( animate ) .types/io STH2r

!write-type

@op-null
	&*

	POP2

JMP2r

~src/manifest.tal