~rabbits/orca-toy

afd929befdcb94745a671475f5840f9cf65defe7 — Devine Lu Linvega 22 days ago 623c0a0 
Made new helpers
patch browse .tar.gz 
2 files changed, 200 insertions(+), 128 deletions(-)

M src/library.tal
M src/orca.tal

M src/library.tal => src/library.tal +96 -96
@@ 11,9 11,9 @@
@op-a ( add )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( a-val ) #0001 SUB2 get-port-left-value
	( b-raw ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( a-val ) get-port-left1-value
	( b-raw ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36
	( res ) ADD


@@ 25,9 25,9 @@
@op-b ( subtract )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 get-port-left-value
	( get b ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( get a ) get-port-left1-value
	( get b ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36
	( res ) SUB DUP #80 LTH ?&bounce #24 SWP SUB &bounce


@@ 39,9 39,9 @@
@op-c ( clock )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get rate ) #0001 SUB2 get-port-left-value DUP #00 EQU ADD
	( get mod ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( get rate ) get-port-left1-value DUP #00 EQU ADD
	( get mod ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36 DUP #00 EQU ADD
	( res ) #00 SWP ROT #00 SWP .timer/frame LDZ2 SWP2 DIV2 SWP2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] NIP


@@ 53,9 53,9 @@
@op-d ( delay )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get rate ) #0001 SUB2 get-port-left-value DUP #00 EQU ADD
	( get mod ) STH2kr INC2 get-port-right-value DUP #00 EQU ADD
	( set type ) .types/op STH2kr write-type
	( get rate ) get-port-left1-value DUP #00 EQU ADD
	( get mod ) STH2kr get-port-right1-value DUP #00 EQU ADD
	( res ) MUL #00 SWP .timer/frame LDZ2 SWP2 ( MOD2 ) [ DIV2k MUL2 SUB2 ] #0000 EQU2
	( bang on equal ) #fc MUL LIT ". ADD
	( output ) STH2r !set-port-output-below


@@ 65,10 65,10 @@
@op-e ( east )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR
	( wall ) .head/x LDZ INC .grid/width LDZ EQU ?&collide
	( cell ) STH2kr INC2 ;data/cells ADD2 LDA LIT ". NEQ ?&collide
	( cell ) STH2kr INC2 read-cell LIT ". NEQ ?&collide
	( write new ) [ LIT &self $1 ] STH2kr INC2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide


@@ 79,9 79,9 @@
@op-f ( if )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 get-port-left-raw
	( get b ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( get a ) get-port-left1-raw
	( get b ) STH2kr get-port-right1-raw
	( bang on equal ) EQU [ #fc MUL LIT ". ADD ]
	( output ) STH2r !set-port-output-below
	&? "F "Bangs 20 "if 20 "inputs 20 "are 20 "equal $1


@@ 90,13 90,13 @@
@op-g ( generator )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0003 SUB2 get-port-left-value
		( load ) #00 SWP ADD2
	( y ) STH2kr #0002 SUB2 get-port-left-value
		( load ) #00 SWP INC2 [ #00 .grid/width LDZ MUL2 ] ADD2
	,&save STR2
	( len ) STH2kr #0001 SUB2 get-port-left-value DUP #00 EQU ADD
	( len ) STH2kr get-port-left1-value DUP #00 EQU ADD
	#00
	&l
		( load ) #00 OVR STH2kr INC2 ADD2 get-port-right-raw


@@ 112,8 112,8 @@ JMP2r
@op-h ( hold )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get cell ) #00 .grid/width LDZ ADD2 ;data/cells ADD2 LDA
	( set type ) .types/op STH2kr write-type
	( get cell ) #00 .grid/width LDZ ADD2 read-cell
	( output ) STH2r !set-port-output-below
	&? "H "Holds 20 "southward 20 "operand $1



@@ 121,12 121,12 @@ JMP2r
@op-i ( increment )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( step ) #0001 SUB2 get-port-left-value
	( mod ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( step ) get-port-left1-value
	( mod ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36 DUP #00 EQU ADD
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA chrb36 ] ADD SWP ( MOD ) [ DIVk MUL SUB ]
	( res ) SWP STH2kr #00 .grid/width LDZ ADD2 read-cell chrb36 ADD SWP ( MOD ) [ DIVk MUL SUB ]
	( set case ) [ LIT &case $1 ] set-case
	( output ) STH2r !set-port-output-below
	&? "I "Increments 20 "southward 20 "operand $1


@@ 135,7 135,7 @@ JMP2r
@op-j ( jumper )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( get above ) #00 .grid/width LDZ SUB2 get-port-left-raw
	( ignore cable )
	DUP chrb36 #13 NEQ ?&no-wire


@@ 143,7 143,7 @@ JMP2r
	( skip down )
	STH2r
	&while
		#00 .grid/width LDZ ADD2 DUP2 ;data/cells ADD2 LDA chrb36 #13 EQU
		#00 .grid/width LDZ ADD2 DUP2 read-cell chrb36 #13 EQU
		?&while
	( set below ) !set-port-output
	&? "J "Outputs 20 "northward 20 "operand $1


@@ 152,8 152,8 @@ JMP2r
@op-k ( konkat )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	#0001 SUB2 get-port-left-value #00
	( set type ) .types/op STH2kr write-type
	get-port-left1-value #00
	&l
		#00 OVR STH2kr INC2 ADD2 STH2k get-port-right-raw
		DUP LIT ". EQU ?&skip


@@ 173,9 173,9 @@ JMP2r
@op-l ( lesser )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 get-port-left-value
	( get b ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( get a ) get-port-left1-value
	( get b ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36
	( res ) [ LTHk JMP SWP POP ]


@@ 187,9 187,9 @@ JMP2r
@op-m ( multiply )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get a ) #0001 SUB2 get-port-left-value
	( get b ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( get a ) get-port-left1-value
	( get b ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36
	( res ) MUL


@@ 201,10 201,10 @@ JMP2r
@op-n ( north )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR
	( wall ) .head/y LDZ #01 SUB #ff EQU ?&collide
	( cell ) STH2kr #00 .grid/width LDZ SUB2 ;data/cells ADD2 LDA LIT ". NEQ ?&collide
	( cell ) STH2kr #00 .grid/width LDZ SUB2 read-cell LIT ". NEQ ?&collide
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ SUB2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide


@@ 215,9 215,9 @@ JMP2r
@op-o ( read )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0002 SUB2 get-port-left-value INC #00 SWP ADD2
	( y ) STH2kr #0001 SUB2 get-port-left-value #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( y ) STH2kr get-port-left1-value #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) get-port-right-raw
	( output ) STH2r !set-port-output-below
	&? "O "Reads 20 "operand 20 "with 20 "offset $1


@@ 226,17 226,17 @@ JMP2r
@op-p ( push )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( key ) #0002 SUB2 get-port-left-value
	( len ) STH2kr #0001 SUB2 get-port-left-value DUP #00 EQU ADD
	( len ) STH2kr get-port-left1-value DUP #00 EQU ADD
	#00
	&l
		#00 OVR STH2kr #00 .grid/width LDZ ADD2 ADD2 STH2
		( lock ) #01 STH2kr ;data/locks ADD2 STA
		( type ) .types/locked STH2r ;data/types ADD2 STA
		( lock ) #01 STH2kr write-lock
		( type ) .types/locked STH2r write-type
		INC GTHk ?&l
	POP
	( read ) STH2kr INC2 get-port-right-raw
	( read ) STH2kr get-port-right1-raw
	( output ) ROT ROT ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2r #00 .grid/width LDZ ADD2 ADD2
		!set-port-output
	&? "P "Writes 20 "eastward 20 "operand $1


@@ 245,13 245,13 @@ JMP2r
@op-q ( query )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0003 SUB2 get-port-left-value
		( load ) #00 SWP INC2 ADD2
	( y ) STH2kr #0002 SUB2 get-port-left-value
		( load ) #00 SWP [ #00 .grid/width LDZ MUL2 ] ADD2
	,&load STR2
	( len ) STH2kr #0001 SUB2 get-port-left-value DUP #00 EQU ADD
	( len ) STH2kr get-port-left1-value DUP #00 EQU ADD
		( save ) #00 OVR STH2kr #00 .grid/width LDZ ADD2 SWP2 SUB2 INC2 ,&save STR2
	#00
	&l


@@ 268,9 268,9 @@ JMP2r
@op-r ( random )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( a-min ) #0001 SUB2 get-port-left-value
	( b-max ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( a-min ) get-port-left1-value
	( b-max ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36 DUP #00 EQU ADD
	( mod ) OVR SUB prng ADD SWP DUP #00 EQU ADD ( MOD ) [ DIVk MUL SUB ] ADD


@@ 282,10 282,10 @@ JMP2r
@op-s ( south )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR
	( wall ) .head/y LDZ INC .grid/height LDZ EQU ?&collide
	( cell ) STH2kr #00 .grid/width LDZ ADD2 ;data/cells ADD2 LDA LIT ". NEQ ?&collide
	( cell ) STH2kr #00 .grid/width LDZ ADD2 read-cell LIT ". NEQ ?&collide
	( write new ) [ LIT &self $1 ] STH2kr #00 .grid/width LDZ ADD2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide


@@ 296,14 296,14 @@ JMP2r
@op-t ( track )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( key ) #0002 SUB2 get-port-left-value
	( len ) STH2kr #0001 SUB2 get-port-left-value DUP #00 EQU ADD
	( len ) STH2kr get-port-left1-value DUP #00 EQU ADD
	#00
	&l
		#00 OVR STH2kr INC2 ADD2 STH2
		( lock ) #01 STH2kr ;data/locks ADD2 STA
		( type ) .types/locked STH2r ;data/types ADD2 STA
		( lock ) #01 STH2kr write-lock
		( type ) .types/locked STH2r write-type
		INC GTHk ?&l
	POP
	( read ) ( MOD ) [ DIVk MUL SUB ] #00 SWP STH2kr INC2 ADD2 get-port-right-raw


@@ 314,9 314,9 @@ JMP2r
@op-u ( Uclid )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( step ) #0001 SUB2 get-port-left-value
	( max ) STH2kr INC2 get-port-right-value DUP #00 EQU ADD STH2
	( set type ) .types/op STH2kr write-type
	( step ) get-port-left1-value
	( max ) STH2kr get-port-right1-value 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 ) [ DIV2k MUL2 SUB2 ]


@@ 330,9 330,9 @@ JMP2r
@op-v ( variable )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( key ) #0001 SUB2 get-port-left-raw
	( val ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( key ) get-port-left1-raw
	( val ) STH2kr get-port-right1-raw
	DUP LIT ". EQU ?&idle
	OVR chrb36 ?&save
	( load )


@@ 349,10 349,10 @@ JMP2r
@op-w ( west )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	;data/cells ADD2 LDA ,&self STR
	( set type ) .types/op STH2kr write-type
	read-cell ,&self STR
	( wall ) .head/x LDZ #01 SUB #ff EQU ?&collide
	( cell ) STH2kr #0001 SUB2 ;data/cells ADD2 LDA LIT ". NEQ ?&collide
	( cell ) STH2kr #0001 SUB2 read-cell LIT ". NEQ ?&collide
	( write new ) [ LIT &self $1 ] STH2kr #0001 SUB2 set-port-raw
	( erase old ) LIT ". STH2r !set-port-raw
	&collide


@@ 363,10 363,10 @@ JMP2r
@op-x ( write )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( set type ) .types/op STH2kr write-type
	( x ) STH2kr #0002 SUB2 get-port-left-value #00 SWP ADD2
	( y ) STH2kr #0001 SUB2 get-port-left-value INC #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) STH2r INC2 get-port-right-raw
	( y ) STH2kr get-port-left1-value INC #00 SWP #00 .grid/width LDZ MUL2 ADD2
	( val ) STH2r get-port-right1-raw
	( output ) ROT ROT !set-port-output
	&? "X "Writes 20 "operand 20 "with 20 "offset $1



@@ 374,15 374,15 @@ JMP2r
@op-y ( yumper )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( get above ) #0001 SUB2 get-port-left-raw
	( set type ) .types/op STH2kr write-type
	( get above ) get-port-left1-raw
	( ignore cable )
	DUP chrb36 #22 NEQ ?&no-wire
		POP POP2r JMP2r &no-wire
	( skip down )
	STH2r
	&while
		INC2 DUP2 ;data/cells ADD2 LDA chrb36 #22 EQU
		INC2 DUP2 read-cell chrb36 #22 EQU
		?&while
	( set below ) !set-port-output
	&? "Y "Outputs 20 "westward 20 "operand $1


@@ 391,12 391,12 @@ JMP2r
@op-z ( lerp )

	STH2k
	( set type ) .types/op STH2kr ;data/types ADD2 STA
	( rate ) #0001 SUB2 get-port-left-value
	( target ) STH2kr INC2 get-port-right-raw
	( set type ) .types/op STH2kr write-type
	( rate ) get-port-left1-value
	( target ) STH2kr get-port-right1-raw
		( get case ) DUP ciuc ,&case STR
		( to value ) chrb36
	( val ) STH2kr #00 .grid/width LDZ ADD2 [ ;data/cells ADD2 LDA chrb36 ]
	( val ) STH2kr #00 .grid/width LDZ ADD2 read-cell chrb36
	( res ) lerp
	( set case ) [ LIT &case $1 ] set-case
	( output ) STH2r !set-port-output-below


@@ 406,7 406,7 @@ JMP2r

@op-bang ( bang )

	LIT ". ROT ROT ;data/cells ADD2 STA
	LIT ". ROT ROT write-cell

JMP2r
	&? "* "Bangs 20 "neighboring 20 "operands $1


@@ 415,17 415,17 @@ JMP2r

	STH2k
	( set itself )
	.types/comment STH2kr ;data/types ADD2 STA
	.types/comment STH2kr write-type
	( get edge )
	#00 .grid/width LDZ .head/x LDZ SUB ADD2
	STH2r INC2
	&l
		( set lock ) STH2k #01 STH2r ;data/locks ADD2 STA
		( set lock ) STH2k #01 STH2r write-lock
		( set type if unset )
		DUP2 ;data/types ADD2 LDA ?&skip
			( set type ) STH2k .types/comment STH2r ;data/types ADD2 STA
		DUP2 read-type ?&skip
			( set type ) STH2k .types/comment STH2r write-type
			&skip
		( stop at hash ) DUP2 ;data/cells ADD2 LDA LIT "# EQU ?&end
		( stop at hash ) DUP2 read-cell LIT "# EQU ?&end
		INC2 GTH2k ?&l
	&end
	POP2 POP2


@@ 436,12 436,12 @@ JMP2r
@op-synth ( synth )

	STH2k
	( channel ) INC2 get-port-right-value [ ,&ch STR ]
	( octave ) STH2kr INC2 INC2 get-port-right-value
	( channel ) get-port-right1-value [ ,&ch STR ]
	( octave ) STH2kr INC2 get-port-right1-value
	( note ) STH2kr #0003 ADD2 get-port-right-raw
	( has note ) DUP LIT ". NEQ ?&has-note [ POP2 POP2r JMP2r ] &has-note
	( has bang ) get-bang ?&is-bang [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( 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



@@ 451,8 451,8 @@ JMP2r
@op-midi ( midi )

	STH2k
	( channel ) INC2 get-port-right-value [ ,&ch STR ]
	( octave ) STH2kr INC2 INC2 get-port-right-value
	( channel ) get-port-right1-value [ ,&ch STR ]
	( octave ) STH2kr INC2 get-port-right1-value
	( note ) STH2kr #0003 ADD2 get-port-right-raw
	( velocity ) STH2kr #0004 ADD2 get-port-right-raw [ ,&vel STR ]
	( length ) STH2kr #0005 ADD2 get-port-right-value


@@ 462,7 462,7 @@ JMP2r

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

	( animate ) .types/io STH2r ;data/types ADD2 STA
	( animate ) .types/io STH2r write-type

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


@@ 495,11 495,11 @@ JMP2r
@op-pitch ( pitch )

	STH2k
	( octave ) INC2 get-port-right-value
	( note ) STH2kr INC2 INC2 get-port-right-raw
	( octave ) get-port-right1-value
	( note ) STH2kr INC2 get-port-right1-raw
	( has note ) DUP LIT ". NEQ ?&has-note [ POP2 POP2r JMP2r ] &has-note
	( has bang ) get-bang ?&is-bang [ POP2 POP2r JMP2r ] &is-bang
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( animate ) .types/io STH2r write-type
	( get note ) chrmid SWP [ #0c MUL ] ADD .Console/write DEO

JMP2r


@@ 508,10 508,10 @@ JMP2r
@op-byte ( byte )

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

JMP2r


@@ 525,7 525,7 @@ JMP2r
	POP2
	( has bang ) get-bang ?&is-bang [ POP2r JMP2r ] &is-bang
	.head LDZ2 INC STH2kr get-word inject-file
	( animate ) .types/io STH2r ;data/types ADD2 STA
	( animate ) .types/io STH2r write-type

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


M src/orca.tal => src/orca.tal +104 -32
@@ 608,9 608,9 @@ JMP2r
	( cache )
	DUP2 .head/addr STZ2
	( skip locked )
	DUP2 ;data/locks ADD2 LDA ?&locked
	DUP2 read-lock ?&locked
	( run unlocked )
	DUP2 ;data/cells ADD2 LDA
	DUP2 read-cell
	#00 SWP #20 SUB DUP ADD ;op-ascii ADD2 LDA2 JMP2
	&locked
	POP2


@@ 753,7 753,7 @@ JMP2r
			STH2kr .head/addr STZ2
			STH2kr get-char-at-addr get-color draw-chr-color
			( underline )
			STH2kr ;data/locks ADD2 LDA #02 NEQ ?&no-lock
			STH2kr read-lock #02 NEQ ?&no-lock
				.Screen/x DEI2k #0008 SUB2 ROT DEO2
				;underline-icn .Screen/addr DEO2
				#0f .Screen/sprite DEO


@@ 774,7 774,7 @@ JMP2r
@get-color ( -- char type )

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



@@ 782,7 782,7 @@ JMP2r

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

	;data/cells ADD2 LDA
	read-cell
	DUP LIT ". NEQ ?&no-bar
		POP
		.guide/grid LDZ ?&do-grid


@@ 796,7 796,7 @@ JMP2r
			&dot POP2 LIT ". JMP2r
			&no-dot
		DUP2 is-selected ?&dot
		.head/addr LDZ2 ;data/types ADD2 LDA ?&dot
		.head/addr LDZ2 read-type ?&dot
		POP2 #20
	&no-bar



@@ 806,7 806,7 @@ JMP2r

	;&word #0020 mclr
	&while
		INC2 DUP2 ;data/cells ADD2 LDA
		INC2 DUP2 read-cell
			DUP LIT ". EQU ?&skip
				DUP ;&word sput
				&skip


@@ 966,7 966,7 @@ JMP2r
	&ver
		.grid/width LDZ #00
		&hor
			OVR2 NIP OVR SWP get-cell ;data/cells ADD2 .File/write DEO2
			OVR2 NIP OVR SWP get-addr ;data/cells ADD2 .File/write DEO2
			INC GTHk ?&hor
		POP2
		( linebreak ) ;&lb .File/write DEO2


@@ 1018,7 1018,7 @@ JMP2r
		STHk
		.selection/x2 LDZ INC .selection/x1 LDZ
		&hor
			DUP STHkr get-cell ;data/cells ADD2 .File/write DEO2
			DUP STHkr get-addr ;data/cells ADD2 .File/write DEO2
			INC GTHk ?&hor
		POP2 POPr
		( linebreak ) ;&lb .File/write DEO2


@@ 1051,7 1051,7 @@ JMP2r

&row

	OVRk get-cell ;data/cells ADD2 LDA
	OVRk get-addr read-cell
	LIT "# LIT ". ROT OVR EQU [ JMP SWP POP ]

JMP2r


@@ 1063,31 1063,64 @@ 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 SWP ciuc #24 MUL ADD #00 SWP ;notes ADD2 LDA JMP2r
@ciuc ( char -- bool ) DUP #40 GTH SWP #5b LTH AND JMP2r
@ci-key ( char -- bool ) DUP #20 GTH SWP #7b LTH AND JMP2r
@ciuc ( char -- bool ) LIT "A SUB #1a LTH JMP2r
@ci-key ( char -- bool ) #20 SUB #5b LTH JMP2r

@set-case ( value case -- raw ) SWP b36chr DUP #60 GTH ROT AND #50 SFT SUB JMP2r
(
@|primitives )

@set-cell ( x y c -- ) ROT ROT get-cell ;data/cells ADD2 STA JMP2r
@get-cell ( x y -- addr* ) #00 SWP #00 .grid/width LDZ MUL2 ROT #00 SWP ADD2 JMP2r
@set-case ( value case -- raw )

@get-port-right-value ( addr* -- value ) get-port-right-raw !chrb36
@get-port-left-value ( addr* -- value ) get-port-left-raw !chrb36
	SWP b36chr DUP #60 GTH ROT AND #50 SFT SUB

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

	( set type ) STH2k .types/pl STH2r ;data/types ADD2 STA
	( get data ) ;data/cells ADD2 LDA
@get-addr ( x y -- addr* )

	#00 SWP #00 .grid/width LDZ MUL2 ROT #00 SWP ADD2

JMP2r

@get-port-right1-value ( addr* -- value )

	INC2

@get-port-right-value ( addr* -- value )

	get-port-right-raw

!chrb36

@get-port-left1-value ( addr* -- value )

	#0001 SUB2

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

	get-port-left-raw

!chrb36

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

	#0001 SUB2

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

	( type ) STH2k .types/pl STH2r write-type

!read-cell

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

	INC2

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

	( set lock ) STH2k #02 STH2kr ;data/locks ADD2 STA
	( set type ) .types/pr STH2r ;data/types ADD2 STA
	( get data ) ;data/cells ADD2 LDA
	( lock ) STH2k #02 STH2kr write-lock
	( type ) .types/pr STH2r write-type

JMP2r
!read-cell

@set-port-output-below ( value addr* -- )



@@ 1095,21 1128,60 @@ JMP2r

@set-port-output ( value addr* -- )

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

JMP2r
!write-cell

@set-port-raw ( value addr* -- )

	( set lock ) STH2k #01 STH2kr ;data/locks ADD2 STA
	( set type ) #00 STH2r ;data/types ADD2 STA
	( set data ) ;data/cells ADD2 STA
	( lock ) STH2k #01 STH2kr write-lock
	( type ) #00 STH2r write-type

!write-cell

@read-cell ( addr* -- cell )

	;data/cells ADD2 LDA

JMP2r

@set-cell ( x y c -- )

	ROT ROT get-addr

@write-cell ( cell addr* -- )

	;data/cells ADD2 STA

JMP2r

@read-type ( addr* -- cell )

	;data/types ADD2 LDA

JMP2r

( generics )
@write-type ( type addr* -- )

	;data/types ADD2 STA

JMP2r

@read-lock ( addr* -- lock )

	;data/locks ADD2 LDA

JMP2r

@write-lock ( lock addr* -- )

	;data/locks ADD2 STA

JMP2r

(
@|stdlib )

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