( Multiset Playground )

|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|10 @Console &vector $2 &read $1 &pad $5 &write $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|a0 @File &vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|000

	@drag $2
	@craft $2
	@valid &fwd $1 &bwd $1 &craft $1
	@touch-origin &x $2 &y $2
	@bagged-mask $1
	@overlay $1
	@selection $2
	@scroll $2
	@Acc/buf $40 &bufend
	@Bag/count $1
	@timers &step $1 &unstep $1 &organize $1 &clear $1
	@size &w $2 &h $2

|100

@on-reset ( -> )
	( | meta )
	;meta #06 DEO2
	( | theme )
	#f0cf .System/r DEO2
	#f0ca .System/g DEO2
	#f0c5 .System/b DEO2
	Theme/<read>
	( | size )
	#0228 #0198 <set-size>
	( | autofill )
	#01 ;rules STA
	#01 ;rules #0004 ADD2 STA
	#01 ;rules #0042 ADD2 STA
	#01 ;rules #0082 ADD2 STA
	#02 ;rules #00c0 ADD2 STA
	( | read files )
	Symbols/<read>
	Project/<read>
	<start-edit-mode>
	BRK

@meta $1
	( name ) "Tote 0a
	( details ) "A 20 "Multiset 20 "Playground 0a
	( author ) "By 20 "Hundred 20 "Rabbits 0a
	( date ) "9 20 "Nov 20 "2024 $1 00

(
@|helpers )

%id-to-rule ( id* -- rule* ) {
	#70 SFT2 ;rules ADD2 }

%id-to-sym ( id* -- addr* ) {
	DUP ADD ;Symbols/table ADD2 LDA2 }

%id-to-anchor ( id* -- anchor* ) {
	DUP ADD ;anchors ADD2 LDA2 }

%get-sym-id ( symbol* -- id ) {
	#0004 ADD2 LDA }

%sym-to-mask ( symbol* -- mask ) {
	get-sym-id #00 SWP ;masks ADD2 LDA }

%selected-symbol ( -- symbol* ) {
	.selection LDZ2 ;Symbols/buf SUB2 }

%selected-mask ( -- mask* ) {
	selected-symbol #05 SFT2 ;masks ADD2 }

%ABS2 {
		DUP2k #1f SFT2 MUL2 SUB2 }

(
@|edit-mode )

@<start-edit-mode> ( -- )
	( | release )
	[ LIT2 00 -Mouse/state ] DEO
	( | initalize )
	#ffff .valid STZ2
	#ffff .craft STZ2
	#ffff .drag STZ2
	#0000 .selection STZ2
	[ LIT2 ff -valid/craft ] STZ
	( | vectors )
	;on-mouse-edit .Mouse/vector DEO2
	;on-frame-edit .Screen/vector DEO2
	Bag/<to-acc>
	Bag/<update>
	<update-rules>
	<validate>
	( >> )

@<reqdraw-edit> ( -- )
	[ LIT2 01 _on-frame-edit/reqdraw ] STR
	JMP2r

@on-frame-edit ( -> )
	( | passive evaluation )
	[ LIT &timer $1 ] INCk #07 AND ,&timer STR
	?{ <eval-passive> }
	( >> )
	&drag ( -> )
	( | 30fps )
	[ LIT2 00 &f $1 ] EQU DUP ,&f STR
	?{ BRK }
	( | step timer )
	[ LIT2 00 -timers/step ] LDZ EQUk ?{
		#01 SUBk .timers/step STZ
		NEQk ?{ <draw-step-button> }
		POP }
	POP2
	( | unstep timer )
	[ LIT2 00 -timers/unstep ] LDZ EQUk ?{
		#01 SUBk .timers/unstep STZ
		NEQk ?{ <draw-unstep-button> }
		POP }
	POP2
	( | redraw )
	[ LIT &reqdraw 01 ] ?{ BRK }
	[ LIT2 00 _&reqdraw ] STR
	<redraw-edit>
	BRK

@on-mouse-edit ( -> )
	<draw-cursor-touch>
	( | scroll )
	.Mouse/scrolly DEI2 ORAk ?on-mouse-scroll
	POP2
	( | picking )
	[ LIT2 &last $1 -Mouse/state ] DEI DUP ,&last STR
	DUP2 #0001 NEQ2 ?{ <handle-touch> }
	DUP2 #0101 NEQ2 ?{ <handle-drag> }
	DUP2 #0000 NEQ2 ?{ <handle-hover> }
	#0100 NEQ2 ?{ <drop> }
	BRK

@on-mouse-scroll ( y* -> )
	#ffff EQU2 ?{
		( down ) .scroll LDZ2 #0008 ADD2 !&set }
	( up ) .scroll LDZ2 #0008 SUB2
	( >> )
	&set ( y* -> )
	DUP2 #0308 LTH2 ?{ POP2 BRK }
	.scroll STZ2
	<redraw-edit>
	BRK

@<handle-touch> ( -- )
	.Mouse/x DEI2 .touch-origin/x STZ2
	.Mouse/y DEI2 .touch-origin/y STZ2
	[ LIT2 00 -bagged-mask ] STZ
	;on-frame-edit/drag .Screen/vector DEO2
	.Mouse/x DEI2 #0048 LTH2 ?<start-drag-spawn>
	.Mouse/x DEI2 #00e8 LTH2 ?<start-drag-rule>
	( >> )

@<start-drag-bag> ( -- )
	.Mouse/x DEI2 .size/w LDZ2 #0058 SUB2 LTH2 ?{
		.Mouse/y DEI2 .size/h LDZ2 #0030 SUB2 SUB2 #0020 LTH2 ?&menu }
	[ LIT2 01 -bagged-mask ] STZ
	&continue ( -- )
	Bag/pick .drag STZ2 !<redraw-edit>

	&menu ( -- )
	.Mouse/x DEI2 .size/w LDZ2 #0058 SUB2 SUB2 #0028 DIV2 NIP ?{ !<unstep> }
	<step> !Bag/<organize>

@<start-drag-spawn> ( -- )
	( x ) .Mouse/x DEI2 #0008 SUB2 #45 SFT2
	( y ) .Mouse/y DEI2 #0010 SUB2 #0018 DIV2 ADD2 NIP Bag/<push-mouse> !<start-drag-bag>/continue

@<start-drag-rule> ( -- )
	( rule* ) .Mouse/y DEI2 .scroll LDZ2 ADD2 #0010 SUB2 #0018 DIV2 id-to-rule
	( copy for swap ) DUP2 ,&rule STR2
	( pos ) .Mouse/x DEI2 #0058 SUB2
	( ) DUP2 #fff0 GTH2 ?&sidebar
	#0012 DIV2 STH
	POP [ LITr 00 ]
	( | lhs )
	DUP2 ,&lhs STR2
	DUP2 #0040 ADD2 SWP2
	&>l ( -- )
		LDAk #00 EQUk ?{
			&>ll ( -- )
				NEQkr STHr ?{
					( dec ) OVR2 LDAk #01 SUB ROT ROT STA
					( spawn ) OVR2 [ LIT2 &lhs $2 ] SUB2 NIP Bag/<push-mouse>
					<update-rules> }
				INCr INC GTHk ?&>ll }
		POP2 INC2 GTH2k ?&>l
	POP2
	( | touched arrow )
	STH2kr NEQ ?{
		POP2r POP2 [ LIT2 &rule $2 ] !<change-meta> }
	INCr
	( | rhs )
	DUP2 ,&rhs STR2
	DUP2 #0040 ADD2 SWP2
	&>r ( -- )
		LDAk #00 EQUk ?{
			&>rr ( -- )
				NEQkr STHr ?{
					( dec ) OVR2 LDAk #01 SUB ROT ROT STA
					( spawn ) OVR2 [ LIT2 &rhs $2 ] SUB2 NIP Bag/<push-mouse>
					<update-rules> }
				INCr INC GTHk ?&>rr }
		POP2 INC2 GTH2k ?&>r
	POP2 POP2 POP2r
	( | start picking )
	Bag/pick .drag STZ2 !<redraw-edit>

	&sidebar ( rule* x* -- )
	POP2 !<swap-rules>

@clamp-x ( x* -- x* )
	DUP2 #0008 SUB2 #8000 LTH2 ?{ POP2 #0008 JMP2r }
	.size/w LDZ2 #0018 SUB2 LTH2k ?{ NIP2 JMP2r }
	POP2 JMP2r

@clamp-y ( y* -- y* )
	DUP2 #0008 SUB2 #8000 LTH2 ?{ POP2 #0008 JMP2r }
	.size/h LDZ2 #0018 SUB2 LTH2k ?{ NIP2 JMP2r }
	POP2 JMP2r

@is-click ( -- flag )
	( x ) .Mouse/x DEI2 .touch-origin/x LDZ2 SUB2 ABS2
	( y ) .Mouse/y DEI2 .touch-origin/y LDZ2 SUB2 ABS2 ADD2 #0004 LTH2 JMP2r

@<handle-hover> ( -- )
	.Mouse/x DEI2 #0050 SUB2 #0098 GTH2 ?{
		( | rules )
		.Mouse/y DEI2 #0010 SUB2 .scroll LDZ2 ADD2 #0018 DIV2 NIP !<set-overlay> }
	#ff !<set-overlay>

@<handle-drag> ( -- )
	.drag LDZ2 INC2k ORA ?{ POP2 JMP2r }
	( | detect lock )
	DUP2 sym-to-mask .bagged-mask LDZ AND ?&locked
	( | drag )
	.Mouse/x DEI2 #0008 SUB2 clamp-x OVR2 STA2
	INC2 INC2 .Mouse/y DEI2 #0006 SUB2 clamp-y OVR2 STA2
	<detect-craft>
	&locked ( drag* -- )
	POP2 !<reqdraw-edit>

@<detect-craft> ( -- )
	.drag LDZ2 INC2k INC2 LDA2 ,&y STR2
	LDA2 ,&x STR2
	;Bag/bufend ;Bag/buf
	&>l ( -- )
		( exists ) LDA2k #0000 EQU2 ?{
			( not self ) DUP2 .drag LDZ2 EQU2 ?{
				( x ) LDA2k #0010 SUB2 [ LIT2 &x $2 ] SUB2 #ffe0 LTH2 ?{
					( y ) INC2k INC2 LDA2 #0010 SUB2 [ LIT2 &y $2 ] SUB2 #ffe0 LTH2 ?{
						NIP2 .craft STZ2
						#02 !<validate-craft> } } } }
		#0005 ADD2 GTH2k ?&>l
	POP2 POP2 #ffff .craft STZ2
	JMP2r

@<drop> ( -- )
	;on-frame-edit .Screen/vector DEO2
	.drag LDZ2 INC2 ORA ?{ !&end }
	( no rule ) .drag LDZ2 LDA2 #0048 LTH2 ?&destroy
	( no rule ) .drag LDZ2 LDA2 #00e0 GTH2 ?<drop-bag>
	( y ) .drag LDZ2 INC2 INC2 LDA2 #0008 SUB2 .scroll LDZ2 ADD2 #0018 DIV2 id-to-rule
	( x ) DUP2 count-hs #00 SWP INC #0012 MUL2 #0048 ADD2
	( rhs ) .drag LDZ2 LDA2 GTH2 ?{ #0040 ADD2 }
	( id ) [ LIT2 00 -drag ] LDZ2 get-sym-id ADD2
	( inc ) LDAk INC ROT ROT STA
	<update-rules>
	&destroy ( -- )
	is-click ?<start-paint-mode>
	#0000 .drag LDZ2 STA2
	Project/<write>
	&end ( -- )
	#ffff .drag STZ2
	Bag/<to-acc>
	Bag/<update> !<reqdraw-edit>

@<drop-bag> ( -- )
	is-click ?<touch-craft>
	.craft LDZ2 INC2 ORA ?<drag-craft>
	( | drag normal )
	.drag LDZ2 get-sym-id #00 SWP id-to-anchor ORA #00 EQU ?{ Bag/<organize> }
	Project/<write>
	#ffff .drag STZ2
	Bag/<to-acc>
	Bag/<update> !<reqdraw-edit>

@<drag-craft> ( -- )
	.craft LDZ2 LDA2k ;Bag/anchor-x STA2
	INC2 INC2 LDA2 ;Bag/anchor-y STA2
	#02 <validate-craft>
	<run-craft>
	Bag/<to-acc>
	Bag/<update> !<reqdraw-edit>

@<touch-craft> ( -- )
	.drag LDZ2 .craft STZ2
	.craft LDZ2 LDA2k ;Bag/anchor-x STA2
	INC2 INC2 LDA2 ;Bag/anchor-y STA2
	#01 <validate-craft>
	<run-craft>
	Bag/<to-acc>
	Bag/<update> !<reqdraw-edit>

@<set-overlay> ( rule -- )
	DUP .overlay LDZ EQU ?{ .overlay STZ !<reqdraw-edit> }
	POP JMP2r

(
@|paint-mode )

@<start-paint-mode> ( -- )
	[ LIT2 00 -Mouse/state ] DEO
	.drag LDZ2 get-sym-id #00 SWP id-to-sym .selection STZ2
	( | drop )
	#0000 .drag LDZ2 STA2
	#ffff .drag STZ2
	Bag/<update>
	( | draw )
	;on-mouse-paint .Mouse/vector DEO2
	;on-frame-paint .Screen/vector DEO2
	( >> )

@<reqdraw-paint> ( -- )
	[ LIT2 01 _on-frame-paint/reqdraw ] STR
	JMP2r

@on-frame-paint ( -> )
	( 30fps ) [ LIT2 00 &f $1 ] EQUk ,&f STR
	ORA ?{ BRK }
	( | organize timer )
	[ LIT2 00 -timers/organize ] LDZ EQUk ?{
		#01 SUBk .timers/organize STZ
		NEQk ?{ <draw-organize-button> }
		POP }
	POP2
	( | clear timer )
	[ LIT2 00 -timers/clear ] LDZ EQUk ?{
		#01 SUBk .timers/clear STZ
		NEQk ?{ <draw-clear-button> }
		POP }
	POP2
	( | redraw )
	[ LIT &reqdraw 01 ] ?{ BRK }
	[ LIT2 00 _&reqdraw ] STR
	<redraw-paint>
	BRK

@on-mouse-paint ( -> )
	.Mouse/x DEI2 #0098 LTH2 ?&canvas
	.Mouse/x DEI2 #00d0 LTH2 ?&shapes
	<draw-cursor-touch>
	( only touch ) .Mouse/state DEI ?{ BRK }
	( | button )
	.Mouse/y DEI2 .size/h LDZ2 SUB2 #ffd0 LTH2 ?{
		.Mouse/x DEI2 .size/w LDZ2 SUB2 #ff80 GTH2 ?&menu }
	( x ) .Mouse/x DEI2 #0038 SUB2 #04 SFT2 NIP #0c SUB
	( y ) .Mouse/y DEI2 #0010 SUB2 #04 SFT2 NIP Symbol/<anchor>
	BRK

	&menu ( -- )
	[ LIT2 00 -Mouse/state ] DEO
	.Mouse/x DEI2 .size/w LDZ2 SUB2
	( ) DUP #d0 GTH ?&menu-close
	( ) DUP #a8 GTH ?&menu-organize
	&menu-clear ( x* -- )
	[ LIT2 04 -timers/clear ] STZ
	<draw-clear-button>
	POP2 Bag/<clear>
	Bag/<update>
	Project/<write>
	<reqdraw-paint>
	BRK

	&menu-close ( x* -- )
	POP2 <start-edit-mode>
	BRK

	&menu-organize ( x* -- )
	[ LIT2 04 -timers/organize ] STZ
	<draw-organize-button>
	POP2 Bag/<organize>
	BRK

	&shapes ( -> )
	<draw-cursor-touch>
	.Mouse/state DEI ?{ BRK }
	( x ) .Mouse/x DEI2 #0098 SUB2 #45 SFT2
	( y ) .Mouse/y DEI2 #0010 SUB2 #0018 DIV2 ADD2
	( sym* ) id-to-sym .selection STZ2
	<reqdraw-paint>
	[ LIT2 00 -Mouse/state ] DEO
	BRK

	&canvas ( -> )
	( | cursor )
	[ LIT &last $1 ] .Mouse/state DEI DUP ,&last STR
	( | down )
	.Mouse/x DEI2 #0010 SUB2 DUP2 #0080 LTH2 ?{ POP2 POP2 BRK }
	.Mouse/y DEI2 #0010 SUB2 DUP2 #0080 GTH2 ?&options
	#c5 ;draw-chr <update-cursor>
	( | detect mode )
	ROT2
	( | save on release )
	DUP2 #0100 NEQ2 ?{ Symbols/<write> }
	DUP2 #0001 EQU2 ?&detect
	AND ?{ POP2 POP2 BRK }
	( x y ) #03 SFT ROT #03 SFT NIP2 SWP Symbol/<set-pixel>
	BRK

	&options ( states* x* y* -> )
	<draw-cursor-touch>
	.Mouse/state DEI ?{ POP2 POP2 POP2 BRK }
	( y ) #0090 SUB2 #04 SFT2 NIP
	( x ) ROT ROT #04 SFT2 NIP SWP
	( erase ) ORAk ?{ Symbol/<erase> }
	( snarf ) DUP2 #0100 NEQ2 ?{ Snarf/<write> }
	( paste ) DUP2 #0200 NEQ2 ?{ Snarf/<read> }
	( dir ) DUP2 #0500 NEQ2 ?{ Symbol/<change-dir> }
	( hide ) DUP2 #0600 NEQ2 ?{ Symbol/<toggle-hide> }
	( lock ) DUP2 #0700 NEQ2 ?{ Symbol/<toggle-lock> }
	POP2 POP2 [ LIT2 00 -Mouse/state ] DEO
	BRK

	&detect ( x* y* state* -> )
	POP2
	( x y ) #03 SFT ROT #03 SFT NIP2 SWP #40 SFT ORA Symbol/get-pixel ?{
		( paint ) #00 ;Symbol/paint-mode STA
		BRK }
	( erase ) #01 ;Symbol/paint-mode STA
	BRK

(
@|rules )

@count-hs ( hs* -- length )
	[ LITr 00 ] DUP2 #0040 ADD2 SWP2
	&>l ( -- )
		LDAk STH
		ADDr INC2 GTH2k ?&>l
	POP2 POP2 STHr JMP2r

@<validate> ( -- )
	<validate-bwd>
	( >> )

@<validate-fwd> ( -- )
	;rules/end ;rules
	&>l ( -- )
		DUP2 ;Acc/buf compare-rules ?{
			#0080 ADD2 GTH2k ?&>l
		[ LIT2 ff -valid/fwd ] STZ
		POP2 POP2 JMP2r }
	;rules SUB2 #07 SFT2 .valid/fwd STZ
	POP POP2 JMP2r

@<validate-bwd> ( -- )
	;rules ;rules/end
	&>l ( -- )
		#0080 SUB2 DUP2 #0040 ADD2 ;Acc/buf compare-rules ?{
			NEQ2k ?&>l
		POP2 POP2 [ LIT2 ff -valid/bwd ] STZ
		JMP2r }
	;rules SUB2 #07 SFT2 .valid/bwd STZ
	POP POP2 JMP2r

@<validate-craft> ( type -- )
	,&meta STR
	.drag LDZ2 get-sym-id ,&a STR
	.craft LDZ2 get-sym-id ,&b STR
	[ LITr 00 ] ;rules/end ;rules
	&>l ( -- )
		#00 STHkr ;rules/meta ADD2 LDA [ LIT &meta $1 ] NEQ ?{
			DUP2 [ LIT2 00 &a $1 ] ADD2 LDA #00 EQU ?{
				DUP2 [ LIT2 00 &b $1 ] ADD2 LDA #00 EQU ?{
					DUP2 ;Acc/buf compare-rules #00 EQU ?{
						[ LITr -valid/craft ] STZr
						POP2 POP2 JMP2r } } } }
		INCr #0080 ADD2 GTH2k ?&>l
	POP2 POP2 POPr [ LIT2 ff -valid/craft ] STZ
	JMP2r

@<change-meta> ( rule* -- )
	;rules SUB2 #07 SFT2 ;rules/meta ADD2 LDAk INC #03 AND ROT ROT STA !<reqdraw-edit>

@<swap-rules> ( rule* -- )
	( | types )
	DUP2 ;rules SUB2 #07 SFT2 ;rules/meta ADD2 LDA2k SWP SWP2 STA2
	( | registers )
	DUP2 #0080 ADD2 SWP2
	&>l ( -- )
		DUP2 ,&a-addr STR2
		LDAk ,&b STR
		DUP2 #0080 ADD2 LDAk ,&a STR
		,&b-addr STR2
		[ LIT &a $1 ] [ LIT2 &a-addr $2 ] STA
		[ LIT &b $1 ] [ LIT2 &b-addr $2 ] STA
		INC2 GTH2k ?&>l
	POP2 POP2 <validate>
	<update-rules> !<redraw-edit>

@<update-rules> ( -- )
	[ LIT2r =reachable ]
	( ) ;rules/end ;rules
	&>l ( -- )
		DUP2 validate-rule STH2kr STA
		INC2r #0080 ADD2 GTH2k ?&>l
	POP2 POP2 POP2r JMP2r

@validate-rule ( rule* -- flag )
	;rules OVR2 DUP2 ,&src STR2
	&>l ( -- )
		#0080 SUB2 GTH2k ?&reachable
		DUP2 [ LIT2 &src $2 ] compare-rules ?&unreachable
		!&>l

	&reachable ( to* from* -- flag )
	POP2 POP2
	( grows? ) DUP2 #0040 ADD2 compare-rules DUP ADD INC JMP2r

	&unreachable ( to* from* -- flag )
	POP2 POP2 POP2 #02 JMP2r

@compare-rules ( b* a* -- match )
	[ LIT2r 0000 ] SWP2 STH2
	DUP2 #0040 ADD2 SWP2
	&>mask-loop ( -- )
		LDAkr STHr #00 EQU ?{ SWP2r INC2r SWP2r }
		( valid ) LDAk LDAkr STHr SWP GTH ?{ INC2r INC2 GTH2k ?&>mask-loop }
	POP2r EQU2 STHr #00 NEQ AND POPr JMP2r

(
@|core )

@<run-craft> ( -- )
	[ LIT2 ff -valid/craft ] LDZ EQU ?{
		Bag/<to-acc>
		.valid/craft LDZ .valid/fwd STZ
		<step>
		[ LIT2 ff -valid/craft ] STZ }
	#ffff .craft STZ2
	#ffff .drag STZ2
	JMP2r

@<unstep> ( -- )
	[ LIT2 ff -valid/bwd ] LDZ NEQ ?{ JMP2r }
	[ LIT2 04 -timers/unstep ] STZ
	<draw-unstep-button>
	[ LIT2 00 -valid/bwd ] LDZ id-to-rule
	( | unapply )
	[ LITr -Acc/buf ]
	( ) DUP2 #0020 ADD2 SWP2
	&>l ( -- )
		( inc ) LDAk LDZkr STH
		ADDr
		( dec ) DUP2 #0040 ADD2 LDA STH
		SUBr
		( save ) OVRr STZr
		INCr INC2 GTH2k ?&>l
	POP2 POP2 POPr Acc/<to-bag> !Bag/<update>

@<step> ( -- )
	[ LIT2 ff -valid/fwd ] LDZ NEQ ?{ JMP2r }
	[ LIT2 04 -timers/step ] STZ
	<draw-step-button>
	[ LIT2 00 -valid/fwd ] LDZ id-to-rule
	( | apply )
	[ LITr -Acc/buf ]
	( ) DUP2 #0020 ADD2 SWP2
	&>l ( -- )
		DUP2 #0040 ADD2 LDA STH
		LDAk STHr SWP SUB STHkr .Acc/buf SUB <mod-things>
		INCr INC2 GTH2k ?&>l
	POP2 POP2 POPr !Bag/<update>

@<mod-things> ( count id -- )
	OVR ?{ POP2 JMP2r }
	OVR #80 AND ?{ !<inc-things> }
	( | prioritize dragged )
	.drag LDZ2 #ffff EQU2 ?{
		DUP .drag LDZ2 #0004 ADD2 LDA NEQ ?{
			#0000 .drag LDZ2 STA2
			SWP INC SWP } }
	OVR ?{ POP2 JMP2r }
	( | prioritize craft )
	.craft LDZ2 #ffff EQU2 ?{
		DUP .craft LDZ2 #0004 ADD2 LDA NEQ ?{
			#0000 .craft LDZ2 STA2
			SWP INC SWP } }
	OVR ?{ POP2 JMP2r }

@<dec-things> ( count id -- )
	SWP
	&>l ( -- )
		OVR Bag/<take-auto>
		INC DUP ?&>l
	POP2 JMP2r

@<inc-things> ( count id -- )
	#00 ROT SUB
	&>l ( -- )
		OVR Bag/<push-auto>
		INC DUP ?&>l
	POP2 JMP2r

@<eval-passive> ( -- )
	[ LITr 00 ] ;rules/end ;rules
	&>l ( -- )
		#00 STHkr ;rules/meta ADD2 LDA #03 NEQ ?{
			DUP2 ;Acc/buf compare-rules #00 EQU ?{
				Bag/<to-acc>
				POP2 POP2 [ LITr -valid/fwd ] STZr
				<step> !<reqdraw-edit> } }
		INCr #0080 ADD2 GTH2k ?&>l
	POP2 POP2 POPr JMP2r

(
@|Accumulator )

@Acc/<clear> ( -- )
	[ LIT2 -&bufend -&buf ]
	&>clear-loop ( -- )
		#00 OVR STZ
		INC GTHk ?&>clear-loop
	POP2 JMP2r

@Acc/<to-bag> ( -- )
	Bag/<clear>
	[ LITr 00 ] [ LIT2 -Acc/bufend -Acc/buf ]
	&>bag-loop ( -- )
		#00 OVR .Acc/buf SUB Bag/<set-dir>
		( ) LDZk #00 EQUk ?{
			&>bag-loop2 ( -- )
				STHkr Bag/<push-auto>
				INC GTHk ?&>bag-loop2 }
		POP2 INCr INC GTHk ?&>bag-loop
	POP2 POPr JMP2r

@<set-anchor> ( id* -- )
	id-to-anchor ORAk ?{ POP2 JMP2r }
	( y ) #00 SWP #40 SFT2 #0010 ADD2 ;Bag/anchor-y STA2
	( x ) #00 SWP #40 SFT2 #00f8 ADD2 ;Bag/anchor-x STA2
	JMP2r

@Bag/<set-dir> ( id* -- )
	;masks ADD2 LDA #06 SFT
	( north ) DUP #03 NEQ ?{
		#0000 ;&dir-x STA2
		#fff0 ;&dir-y STA2
		POP JMP2r }
	( west ) DUP #02 NEQ ?{
		#fff0 ;&dir-x STA2
		#0000 ;&dir-y STA2
		POP JMP2r }
	( south ) #01 NEQ ?{
		#0000 ;&dir-x STA2
		#0010 ;&dir-y STA2
		JMP2r }
	( | east )
	#0010 ;&dir-x STA2
	#0000 ;&dir-y STA2
	JMP2r

(
@|Bag )

@Bag/pick ( -- thing* )
	;&buf ;&bufend
	&>pick-loop ( -- )
		#0005 SUB2 LDA2k #0000 EQU2 ?{ DUP2 Bag/<try-pick>
			?&found }
		NEQ2k ?&>pick-loop
	POP2 #ffff &found NIP2 JMP2r

@Bag/find-free ( -- bag/thing* )
	;&bufend ;&buf
	&>find-loop ( -- )
		LDA2k ORA ?{ NIP2 JMP2r }
		#0005 ADD2 GTH2k ?&>find-loop
	POP2 POP2 ;&buf JMP2r

@Bag/<try-pick> ( pos* -- flag )
	( x ) LDA2k .Mouse/x DEI2 SWP2 SUB2 #0010 LTH2 ?{ POP2 #00 JMP2r }
	( y ) INC2 INC2 LDA2 .Mouse/y DEI2 SWP2 SUB2 #0010 LTH2 ?{ #00 JMP2r }
	#01 JMP2r

@Bag/<push-mouse> ( id -- )
	DUP #20 LTH ?{ POP JMP2r }
	/find-free STH2
	.Mouse/x DEI2 #0008 SUB2 STH2kr INC2r INC2r STA2
	.Mouse/y DEI2 #0008 SUB2 STH2kr INC2r INC2r STA2
	STH2r STA
	Bag/<to-acc> !&<update>

@Bag/<push-auto> ( id -- )
	#00 OVR <set-anchor>
	/find-free STH2
	[ LIT2 &anchor-x 00f8 ]
	( ) DUP2 [ LIT2 &dir-x 0010 ] ADD2 ,&anchor-x STR2
	STH2kr INC2r INC2r STA2
	[ LIT2 &anchor-y 0010 ]
	( ) DUP2 [ LIT2 &dir-y 0000 ] ADD2 ,&anchor-y STR2
	STH2kr INC2r INC2r STA2
	STH2r STA
	JMP2r

@Bag/<take-auto> ( id -- )
	STH
	;Bag/bufend ;Bag/buf
	&>take-loop ( -- )
		LDA2k #0000 EQU2 ?{
			DUP2 #0004 ADD2 LDA STHkr EQU ?&take-found }
		#0005 ADD2 GTH2k ?&>take-loop &take-found #0000 SWP2 STA2
	POP2 POPr JMP2r

@Bag/<clear> ( -- )
	;&bufend ;&buf
	&>clear-loop ( -- )
		#0000 OVR2 STA2
		#0005 ADD2 GTH2k ?&>clear-loop
	POP2 POP2
	( resetx ) #00f8 ;&anchor-x STA2
	( resety ) #0010 ;&anchor-y STA2
	JMP2r

@Bag/<to-acc> ( -- )
	Acc/<clear>
	;&bufend ;&buf
	&>l ( -- )
		LDA2k #0000 EQU2 ?{
			DUP2 get-sym-id
			( inc register ) .Acc/buf ADD LDZk INC SWP STZ }
		#0005 ADD2 GTH2k ?&>l
	POP2 POP2 !<validate>

@Bag/<organize> ( -- )
	Bag/<to-acc>
	Acc/<to-bag>
	Bag/<update>
	Project/<write> !<reqdraw-paint>

@Bag/<update> ( -- )
	( i ) [ LITr 00 ]
	( ) ;&bufend ;&buf
	&>count-loop ( -- )
		LDA2k #0000 EQU2 ?{ INCr }
		#0005 ADD2 GTH2k ?&>count-loop
	POP2 POP2
	( save ) [ LITr -&count ] STZr
	JMP2r

(
@|Project )

@Project/<read> ( -- )
	;&filename .File/name DEO2
	;&buf ;&bufend OVR2 SUB2 .File/length DEO2
	.File/read DEO2
	JMP2r

@Project/<write> ( -- )
	;&filename .File/name DEO2
	;&buf ;&bufend OVR2 SUB2 .File/length DEO2
	.File/write DEO2
	JMP2r

	&filename "project.tote $1

(
@|Symbols )

@Symbols/<read> ( -- )
	;&filename .File/name DEO2
	;&buf ;&bufend OVR2 SUB2 .File/length DEO2
	.File/read DEO2
	JMP2r

@Symbols/<write> ( -- )
	;&filename .File/name DEO2
	;&buf ;&bufend OVR2 SUB2 .File/length DEO2
	.File/write DEO2
	JMP2r

	&filename "symbols.icn $1

(
@|Snarf )

@Snarf/<write> ( -- )
	;&txt .File/name DEO2
	#0020 .File/length DEO2
	.selection LDZ2 .File/write DEO2
	JMP2r

@Snarf/<read> ( -- )
	;&txt .File/name DEO2
	#0020 .File/length DEO2
	.selection LDZ2 .File/read DEO2 !<reqdraw-paint>

	&txt ".snarf $1

@Theme/<read> ( -- )
	;&path .File/name DEO2
	#0002 .File/length DEO2
	;&r .File/read DEO2
	;&g .File/read DEO2
	;&b .File/read DEO2
	[ LIT2 00 -File/success-lb ] DEI EQU ?{
		[ LIT2 &r $2 ] .System/r DEO2
		[ LIT2 &g $2 ] .System/g DEO2
		[ LIT2 &b $2 ] .System/b DEO2 }
	JMP2r

	&path ".theme $1

(
@|Symbol )

@Symbol/get-pixel ( pos -- flag )
	STHk
	( quad-x ) #0f AND #03 SFT
	( quad-y ) STHkr #17 SFT ADD
	( addr* ) #30 SFT #00 SWP .selection LDZ2 ADD2
	( get cell ) #00 STHkr #04 SFT #07 AND ADD2
	( get pixel ) LDA #07 STHkr #07 AND SUB SFT
	( value ) #01 AND POPr JMP2r

@Symbol/get-pixel-addr ( x y -- addr* )
	( quad-x ) SWP #0f AND #03 SFT
	( quad-y ) OVR #13 SFT ADD
	( addr* ) #30 SFT #00 SWP .selection LDZ2 ADD2
	( get cell ) ROT #00 SWP #07 AND ADD2 JMP2r

@Symbol/<set-pixel> ( x y -- )
	DUP2 /get-pixel-addr [ LIT &paint-mode $1 ] ?{
		( | paint pixel )
		SWP2 POP #07 AND #07 SWP SUB #40 SFT #01 SWP SFT STH
		LDAk STHr ORA ROT ROT STA !<reqdraw-paint> }
	( | erase pixel )
	SWP2 POP #07 AND #07 SWP SUB #40 SFT #01 SWP SFT #ff EOR STH
	LDAk STHr AND ROT ROT STA !<reqdraw-paint>

@Symbol/<erase> ( -- )
	.selection LDZ2 DUP2 #0020 ADD2 SWP2
	&>l ( -- )
		#0000 OVR2 STA2
		INC2 INC2 GTH2k ?&>l
	POP2 POP2 !<reqdraw-paint>

@Symbol/<anchor> ( x y -- )
	( | clamp )
	DUP #15 LTH ?{ #ff00 AND2 }
	OVR #12 LTH ?{ #00ff AND2 }
	STH2k selected-symbol #15 SFT2 ;anchors ADD2
	( changed? ) LDA2k STH2r EQU2 ?{ STA2 !<reqdraw-paint> }
	POP2 POP2 JMP2r

@Symbol/<change-dir> ( -- )
	selected-mask LDAk
	( value ) DUP #06 SFT INC #60 SFT
	( mask ) SWP #3f AND ORA ROT ROT STA !<reqdraw-paint>

@Symbol/<toggle-hide> ( -- )
	selected-mask LDAk #04 EOR ROT ROT STA !<reqdraw-paint>

@Symbol/<toggle-eval> ( -- )
	selected-mask LDAk #02 EOR ROT ROT STA !<reqdraw-paint>

@Symbol/<toggle-lock> ( -- )
	selected-mask LDAk #01 EOR ROT ROT STA !<reqdraw-paint>

(
@|drawing )

@<redraw-paint> ( -- )
	( | clear )
	#00d8 .Screen/x DEO2
	#0000 .Screen/y DEO2
	[ LIT2 80 -Screen/pixel ] DEO
	( | draw )
	#00d8 <draw-pane-create>
	( | paint surface )
	[ LIT2 00 -Screen/auto ] DEO
	#00
	&>w ( -- )
		( x ) #00 OVR #0f AND #30 SFT2 #0010 ADD2 .Screen/x DEO2
		( y ) #00 OVR #34 SFT #0010 ADD2 .Screen/y DEO2
		( pixel ) #00 OVR Symbol/get-pixel #30 SFT2 ;pixel-icn ADD2 .Screen/addr DEO2
		[ LIT2 05 -Screen/sprite ] DEO
		INC DUP ?&>w
	POP
	( | menu )
	[ LIT2 16 -Screen/auto ] DEO
	;erase-icn #0010 #00a0 <draw-icon-at>
	;copy-icn #0020 #00a0 <draw-icon-at>
	;paste-icn #0030 #00a0 <draw-icon-at>
	;dir-icn selected-mask LDA #06 SFT #00 SWP #50 SFT2 ADD2
	( ) #0060 #00a0 <draw-icon-at>
	;visible-icn selected-mask LDA #04 AND ?{ #0020 ADD2 }
	#0070 #00a0 <draw-icon-at>
	;lock-icn selected-mask LDA #01 AND ?{ #0020 ADD2 }
	#0080 #00a0 <draw-icon-at>
	<draw-bag>
	<draw-clear-button>
	<draw-organize-button>
	.size/w LDZ2 #0030 SUB2 .Screen/x DEO2
	.size/h LDZ2 #0030 SUB2 .Screen/y DEO2
	;close-icn #00 <draw-button-active>
	( | anchors )
	[ LIT2 16 -Screen/auto ] DEO
	#2000
	&>l ( -- )
		#00 OVR id-to-anchor STH2k #0000 EQU2 ?{
			( y ) #00 STHkr #40 SFT2 #0010 ADD2 .Screen/y DEO2
			( x ) #00 SWPr STHkr #40 SFT2 #00f8 ADD2 .Screen/x DEO2
			( addr ) #00 OVR id-to-sym .selection LDZ2 OVR2 .Screen/addr DEO2
			EQU2 #05 MUL #0a ADD .Screen/sprite DEOk DEO }
		POP2r INC GTHk ?&>l
	POP2 JMP2r

@<redraw-edit> ( -- )
	( | clear )
	#0050 .Screen/x DEO2
	#0000 .Screen/y DEO2
	[ LIT2 80 -Screen/pixel ] DEO
	( | draw )
	#0048 <draw-pane-create>
	<draw-bag>
	<draw-rules>
	<draw-step-button> !<draw-unstep-button>

@<draw-button> ( addr* down state -- )
	?<draw-button-active>
	POP
	( | inactive )
	[ LIT2 36 -Screen/auto ] DEO
	;button-disabled-icn .Screen/addr DEO2
	[ LIT2 0a -Screen/sprite ] DEOk DEOk DEOk DEO
	( | foreground )
	[ LIT2 16 -Screen/auto ] DEO
	.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
	.Screen/y DEI2 #0018 SUB2 .Screen/y DEO2
	.Screen/addr DEO2
	[ LIT2 0a -Screen/sprite ] DEOk DEO
	JMP2r

@<draw-button-active> ( addr* down -- )
	#00 NEQ #10 SFT [ LITr 00 ] STH
	( | background )
	[ LIT2 36 -Screen/auto ] DEO
	;button-enabled-chr STH2kr #70 SFT2 ADD2 .Screen/addr DEO2
	[ LIT2 81 -Screen/sprite ] DEOk DEOk DEOk DEO
	( | foreground )
	[ LIT2 16 -Screen/auto ] DEO
	( x* ) .Screen/x DEI2 #0008 ADD2
	( y* ) .Screen/y DEI2 #0018 SUB2 STH2r ADD2 !<draw-icon-at>

@<draw-pane-create> ( x* -- )
	( | background )
	DUP2 .Screen/x DEO2
	#0000 .Screen/y DEO2
	[ LIT2 92 -Screen/pixel ] DEO
	( | items )
	[ LIT2 16 -Screen/auto ] DEO
	DUP2 #0038 SUB2 ,&anchor-x STR2
	#2000
	&>l ( -- )
		#00 OVR
		( color ) DUP2 ;masks ADD2 LDA #02 SFT #01 AND #05 MUL #05 SWP SUB ;<draw-icon>/color STA
		( x ) DUP2 #04 SFT #0018 MUL2 [ LIT2 &anchor-x $2 ] ADD2 .Screen/x DEO2
		( y ) DUP2 #0f AND #0018 MUL2 #0010 ADD2 .Screen/y DEO2
		id-to-sym <draw-icon>
		INC GTHk ?&>l
	POP2 #05 ;<draw-icon>/color STA
	( | selection )
	.selection LDZ2 #0000 EQU2 ?{
		selected-symbol #05 SFT2
		( x ) DUP2 #04 SFT #0018 MUL2 ,&anchor-x LDR2 ADD2 .Screen/x DEO2
		( y ) #0f AND #0018 MUL2 #000c ADD2 .Screen/y DEO2
		[ LIT2 16 -Screen/auto ] DEO
		;drag-chr .Screen/addr DEO2
		[ LIT2 85 -Screen/sprite ] DEO }
	( | spacer )
	.Screen/x DEO2
	#0000 .Screen/y DEO2
	[ LIT2 02 -Screen/auto ] DEO
	;frill-chr .Screen/addr DEO2
	#3381 !<draw-times>

@<draw-bag> ( -- )
	<draw-bag-overlay>
	;Bag/bufend ;Bag/buf
	&>l ( -- )
		DUP2 <draw-thing>
		#0005 ADD2 GTH2k ?&>l
	POP2 POP2
	( | draw anchor )
	.drag LDZ2 INC2k ORA ?{ POP2 JMP2r }
	get-sym-id #00 SWP id-to-anchor ORAk ?{ POP2 JMP2r }
	( y ) #00 SWP #40 SFT2 #000d ADD2 .Screen/y DEO2
	( x ) #00 SWP #40 SFT2 #00f8 ADD2 .Screen/x DEO2
	( addr ) ;drop-chr .Screen/addr DEO2
	[ LIT2 85 -Screen/sprite ] DEO
	JMP2r

@<draw-bag-overlay> ( -- )
	.overlay LDZ ?{ JMP2r }
	[ LITr 00 ] [ LIT2 00 -overlay ] LDZ #70 SFT2 ;rules ADD2 DUP2 #0040 ADD2 SWP2
	&>l ( -- )
		LDAk #00 EQU ?{ #0a00 STHkr <draw-thing-anchored> }
		DUP2 #0040 ADD2 LDA #00 EQU ?{ #0f00 STHkr <draw-thing-anchored> }
		INCr INC2 GTH2k ?&>l
	POP2 POP2 POPr JMP2r

@<draw-thing-anchored> ( color id* -- )
	[ LIT2 16 -Screen/auto ] DEO
	DUP2 id-to-anchor ORAk ?{ POP2 POP2 POP JMP2r }
	( y ) #00 SWP #40 SFT2 #0010 ADD2 .Screen/y DEO2
	( x ) #00 SWP #40 SFT2 #00f8 ADD2 .Screen/x DEO2
	id-to-sym .Screen/addr DEO2
	.Screen/sprite DEOk DEO
	JMP2r

@<draw-thing> ( addr* -- )
	( exists ) LDA2k ORA ?{ POP2 JMP2r }
	( in bag ) LDA2k #00e0 LTH2 ?{
		( offscreen ) LDA2k .size/w LDZ2 LTH2 ?{ POP2 JMP2r }
		( hidden ) DUP2 sym-to-mask #04 AND #00 EQU ?{ POP2 JMP2r } }
	DUP2 .drag LDZ2 EQU2 ?<draw-thing-dragged>
	DUP2 .craft LDZ2 NEQ2 ?{
		[ LIT2 ff -valid/craft ] LDZ EQU ?{ <draw-thing-outline> } }
	( >> )

@<draw-thing-icon> ( addr* -- )
	[ LIT2 16 -Screen/auto ] DEO
	LDA2k .Screen/x DEO2
	INC2 INC2 LDA2k .Screen/y DEO2
	INC2 INC2 LDA #00 SWP id-to-sym !<draw-icon>

@<draw-thing-dragged> ( addr* -- )
	DUP2 sym-to-mask #01 AND ?<draw-thing-locked>
	[ LIT2 16 -Screen/auto ] DEO
	LDA2k .Screen/x DEO2
	INC2k INC2 LDA2k .Screen/y DEO2
	INC2 INC2 LDA #00 SWP id-to-sym STH2k .Screen/addr DEO2
	( | shadow )
	LDA2k #0048 LTH2 ?{
		[ LIT2 0a -Screen/sprite ] DEOk DEO }
	( | fill )
	LDA2k .Screen/x DEO2
	INC2 INC2 LDA2 #0003 SUB2 .Screen/y DEO2
	[ LITr -Screen/addr ] DEO2r
	[ LIT2 05 -Screen/sprite ] DEOk DEO
	( | drag icon )
	.Screen/y DEI2k #0013 SUB2 ROT DEO2
	;drag-chr .Screen/addr DEO2
	[ LIT2 85 -Screen/sprite ] DEO
	JMP2r

@<draw-thing-locked> ( addr* -- )
	<draw-thing-outline> !<draw-thing-icon>

@<draw-thing-outline> ( bag* -- )
	[ LIT2 36 -Screen/auto ] DEO
	;craft-icn .Screen/addr DEO2
	LDA2k #0008 SUB2 .Screen/x DEO2
	INC2k INC2 LDA2 #0008 SUB2 .Screen/y DEO2
	[ LIT2 0a -Screen/sprite ] DEOk DEOk DEOk DEO
	JMP2r

@<draw-rules> ( -- )
	#0010 .scroll LDZ2 SUB2 .Screen/y DEO2
	[ LIT2 16 -Screen/auto ] DEO
	[ LITr 00 ] ;rules/end ;rules
	&>l ( -- )
		( | skip outside of view )
		.Screen/y DEI2 #0010 ADD2 .size/w LDZ2 GTH2 ?{
			#00 STHkr ;reachable ADD2 LDA #05 MUL ;<draw-icon>/color STA
			( | fwd arrow )
			STHkr .valid/fwd LDZ NEQ ?{
				#0046 .Screen/x DEO2
				.Screen/y DEI2 ;valid-icn .Screen/addr DEO2
				[ LIT2 0f -Screen/sprite ] DEOk DEO
				.Screen/y DEO2 }
			#0058 .Screen/x DEO2
			DUP2 <draw-hs>
			STHkr <draw-arrow>
			DUP2 #0040 ADD2 <draw-hs>
			( | bwd arrow )
			STHkr .valid/bwd LDZ NEQ ?{
				;valid-icn .Screen/addr DEO2
				.Screen/x DEI2k #0008 ADD2 ROT DEO2
				[ LIT2 1a -Screen/sprite ] DEOk DEO
				.Screen/y DEI2k #0010 SUB2 ROT DEO2 } }
		.Screen/y DEI2k #0018 ADD2 ROT DEO2
		INCr #0080 ADD2 GTH2k ?&>l
	POP2 POP2 POPr
	( | restore color )
	#05 ;<draw-icon>/color STA
	( | spacer )
	#00e0 .Screen/x DEO2
	#0000 .Screen/y DEO2
	[ LIT2 02 -Screen/auto ] DEO
	;dotted-icn .Screen/addr DEO2
	#3305
	( >> )

@<draw-times> ( times color -- )
	STH
	[ LITr -Screen/sprite ] #00 SWP SUB
	&>w ( -- )
		DEOkr
		INC DUP ?&>w
	POP POP2r JMP2r

@<draw-hs> ( addr* -- )
	[ LITr 00 ]
	( ) DUP2 #0040 ADD2 SWP2
	&>l ( -- )
		LDAk STHkr <draw-register>
		INCr INC2 GTH2k ?&>l
	POP2 POP2 POPr JMP2r

@<draw-register> ( count id -- )
	( empty ) OVR ?{ POP2 JMP2r }
	#00 SWP id-to-sym ,&addr STR2
	[ LITr -Screen/y ] DEI2kr ROTr
	( ) #00 SWP SUB
	&>w ( -- )
		[ LIT2 &addr $2 ] <draw-icon>
		.Screen/x DEI2k #0012 ADD2 ROT DEO2
		( anchor ) DEO2kr
		INC DUP ?&>w
	POP POP2r POPr JMP2r

@<draw-arrow> ( id -- )
	( meta ) #00 OVR ;rules/meta ADD2 LDA
	( meta sprite ) #00 SWP #50 SFT2 ;arrows-icn ADD2 .Screen/addr DEO2
	( x ) [ LITr -Screen/x ] DEI2r
	( y ) [ LITr -Screen/y ] DEI2r
	( draw ) .valid/craft LDZ EQU #0a MUL #05 ADD .Screen/sprite DEOk DEO
	( y ) [ LITr -Screen/y ] DEO2r
	( x ) [ LIT2r 0012 ] ADD2r [ LITr -Screen/x ] DEO2r
	JMP2r

@<draw-clear-button> ( -- )
	.size/w LDZ2 #0080 SUB2 .Screen/x DEO2
	.size/h LDZ2 #0030 SUB2 .Screen/y DEO2
	;clear-icn .timers/clear LDZ .Bag/count LDZ !<draw-button>

@<draw-organize-button> ( -- )
	.size/w LDZ2 #0058 SUB2 .Screen/x DEO2
	.size/h LDZ2 #0030 SUB2 .Screen/y DEO2
	;organize-icn .timers/organize LDZ .Bag/count LDZ !<draw-button>

@<draw-step-button> ( -- )
	.size/w LDZ2 #0030 SUB2 .Screen/x DEO2
	.size/h LDZ2 #0030 SUB2 .Screen/y DEO2
	;Symbols/transmute .timers/step LDZ .valid/fwd LDZ INC !<draw-button>

@<draw-unstep-button> ( -- )
	.size/w LDZ2 #0058 SUB2 .Screen/x DEO2
	.size/h LDZ2 #0030 SUB2 .Screen/y DEO2
	;Symbols/reverse .timers/unstep LDZ .valid/bwd LDZ INC !<draw-button>

@<draw-icon-at> ( addr* x* y* -- )
	.Screen/y DEO2
	.Screen/x DEO2
	( >> )

@<draw-icon> ( addr* -- )
	.Screen/addr DEO2
	[ LIT2 &color 05 -Screen/sprite ] DEOk DEO
	JMP2r

@<draw-cursor-touch> ( -- )
	#c5 ;touch-chr .Mouse/state DEI ?{ #0040 ADD2 }
	( >> )

@<update-cursor> ( color addr* -- )
	;fill-icn .Screen/addr DEO2
	#40 <draw-cursor>
	.Screen/addr DEO2
	.Mouse/x DEI2 #0004 SUB2 ,<draw-cursor>/x STR2
	.Mouse/y DEI2 #0005 SUB2 ,<draw-cursor>/y STR2
	( >> )

@<draw-cursor> ( color -- )
	[ LIT2 16 -Screen/auto ] DEO
	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	.Screen/sprite DEOk DEO
	JMP2r

(
@|stdlib )

@<phex> ( short* -: )
	SWP /b
	&b ( byte -: )
	DUP #04 SFT /c
	&c ( byte -: )
	#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #19 DEO
	JMP2r

@<set-size> ( x* y* -- )
	.Screen/height DEO2
	.Screen/width DEO2
	.Screen/width DEI2 .size/w STZ2
	.Screen/height DEI2 .size/h STZ2
	JMP2r



@Symbols/table
	=&tri
	=&lozenge
	=&square
	=&hexagon
	=&circle
	=&left
	=&quad4
	=&quad3
	=&num1
	=&num2
	=&num3
	=&num4
	=&rabbit-left
	=&dog-left
	=&blank1
	=&reverse

	=&tri-empty
	=&lozenge-empty
	=&square-empty
	=&hexagon-empty
	=&circle-empty
	=&right
	=&quad1
	=&quad2
	=&num1-neg
	=&num2-neg
	=&num3-neg
	=&num4-neg
	=&rabbit-right
	=&dog-right
	=&blank2
	=&transmute

@dotted-icn [ 0100 0100 0100 0100 ]
@pixel-icn [ 0000 0010 0000 0000 7cfe fefe fefe 7c00 ]
@frill-chr [ 2020 2040 8080 8040 c0c0 c080 0000 0080 ]

@drag-chr [
	0007 0f0f 0703 0100 0000 0707 0301 0000
	00e0 f0f0 e0c0 8000 0000 e0e0 c080 0000 ]

@drop-chr [
	0007 0808 0402 0100 0000 0707 0301 0000
	00e0 1010 2040 8000 0000 e0e0 c080 0000 ]

@valid-icn [
	0000 0000 0000 0000 0000 0000 3038 3c3e
	0000 0000 0000 0000 3e3c 3830 0000 0000 ]

@arrows-icn [
	0000 0000 0000 003f 0000 0000 3038 3cfe
	3f00 0000 0000 0000 fe3c 3830 0000 0000
	0000 0000 3038 3c3f 0000 0000 0000 00fe
	3f3c 3830 0000 0000 fe00 0000 0000 0000
	0000 0000 0000 003f 0000 0000 3078 fcfe
	3f00 0000 0000 0000 fefc 7830 0000 0000
	0000 0000 0000 0036 0000 0000 3038 3cfe
	3600 0000 0000 0000 fe3c 3830 0000 0000 ]

@close-icn [
	0000 0018 1c0e 0703 0000 0018 3870 e0c0
	0307 0e1c 1800 0000 c0e0 7038 1800 0000 ]

@organize-icn [
	0000 0012 0000 1200 0000 0048 0000 4800
	0012 0000 1200 0000 0048 0000 4800 0000 ]

@erase-icn [
	003f 2021 2522 2c22 00fc 0404 4484 6484
	2521 2020 2020 3f00 4404 7c48 5060 c000 ]

@clear-icn [
	0102 1f20 3f10 1010 8040 f804 fc08 0808
	1010 1010 1010 1f00 0808 0808 0808 f800 ]

@copy-icn [
	003f 2021 2327 2121 00fc 0484 c4e4 8484
	2120 2020 2020 3f00 8404 7c48 5060 c000 ]

@paste-icn [
	003f 2021 2121 2723 00fc 0484 8484 e4c4
	2120 2020 2020 3f00 8404 7c48 5060 c000 ]

@dir-icn [
	0000 0000 0004 063f 0000 0000 0000 183c
	3f06 0400 0000 0000 3c18 0000 0000 0000
	0000 0101 0107 0301 0000 8080 80e0 c080
	0000 0103 0301 0000 0000 80c0 c080 0000
	0000 0000 0000 183c 0000 0000 0020 60fc
	3c18 0000 0000 0000 fc60 2000 0000 0000
	0000 0103 0301 0000 0000 80c0 c080 0000
	0103 0701 0101 0000 80c0 e080 8080 0000 ]

@lock-icn [
	0000 0007 0f0c 0c0c 0000 00e0 f030 3030
	1f1f 1f1f 1f1f 0000 f8f8 f8f8 f8f8 0000
	0000 070f 0c0c 0000 0000 e0f0 3030 3030
	1f1f 1f1f 1f1f 0000 f8f8 f8f8 f8f8 0000 ]

@visible-icn [
	0000 0000 0000 0000 0000 0000 0000 0000
	4020 1807 0000 0000 0204 18e0 0000 0000
	0000 0000 0718 2347 0000 0000 e018 c4e2
	0707 0300 0000 0000 e0e0 c000 0000 0000 ]

@touch-chr [
	0000 0000 0000 0817 0000 0000 0000 0008
	0000 0000 0000 00c0 0000 0000 0000 0000
	1010 2010 1008 0700 0f0f 1f0f 0f07 0000
	2010 1010 2020 c000 c0e0 e0e0 c0c0 0000
	0000 0000 0814 1417 0000 0000 0008 0808
	0000 0000 0000 00c0 0000 0000 0000 0000
	1010 2010 1008 0700 0f0f 1f0f 0f07 0000
	2010 1010 2020 c000 c0e0 e0e0 c0c0 0000 ]

@draw-chr [
	0000 0000 0f0e 0c08 0000 0000 0005 0307
	0000 0000 0080 4020 0000 0000 0000 80c0
	0402 0100 0000 0000 0301 0000 0000 0000
	1008 0482 4224 1800 e0f0 f87c 3c18 0000 ]

@craft-icn [
	0007 1820 2040 4040 00ff 0000 0000 0000
	00ff 0000 0000 0000 00e0 1804 0402 0202
	4040 4040 4040 4040 0000 0000 0000 0000
	0000 0000 0000 0000 0202 0202 0202 0202
	4040 4040 4040 4040 0000 0000 0000 0000
	0000 0000 0000 0000 0202 0202 0202 0202
	4040 4020 2018 0700 0000 0000 0000 ff00
	0000 0000 0000 ff00 0202 0204 0418 e000 ]

@button-disabled-icn [
	0c30 4040 8080 0000 cd00 0000 0000 0000
	b300 0000 0000 0000 300c 0202 0101 0001
	8080 0000 8080 0080 0000 0000 0000 0000
	0000 0000 0000 0000 0100 0001 0100 0001
	8000 8080 0000 8080 0000 0000 0000 0000
	0000 0000 0000 0000 0100 0101 0000 0101
	0000 8080 4040 300c 0000 0000 0000 00cd
	0000 0000 0000 00b3 0000 0101 0202 0c30 ]

@button-enabled-chr [
	0f30 4040 8080 8080 000f 3f3f 7f7f 7f7f
	ff00 0000 0000 0000 00ff ffff ffff ffff
	ff00 0000 0000 0000 00ff ffff ffff ffff
	f00c 0202 0101 0101 00f0 fcfc fefe fefe
	8080 8080 8080 8080 7f7f 7f7f 7f7f 7f7f
	0000 0000 0000 0000 ffff ffff ffff ffff
	0000 0000 0000 0000 ffff ffff ffff ffff
	0101 0101 0101 0101 fefe fefe fefe fefe
	8080 8080 8080 8080 7f7f 7f7f 7f7f 7f7f
	0000 0000 0000 0000 ffff ffff ffff ffff
	0000 0000 0000 0000 ffff ffff ffff ffff
	0101 0101 0101 0101 fefe fefe fefe fefe
	8080 8080 4040 300f 7f7f 7f7f 3f3f 0f00
	0000 0000 0000 00ff ffff ffff ffff ff00
	0000 0000 0000 00ff ffff ffff ffff ff00
	0101 0101 0202 0cf0 fefe fefe fcfc f000 ]
&down [ 
	0000 0f30 4040 8080 0000 000f 3f3f 7f7f
	0000 ff00 0000 0000 0000 00ff ffff ffff
	0000 ff00 0000 0000 0000 00ff ffff ffff
	0000 f00c 0202 0101 0000 00f0 fcfc fefe
	8080 8080 8080 8080 7f7f 7f7f 7f7f 7f7f
	0000 0000 0000 0000 ffff ffff ffff ffff
	0000 0000 0000 0000 ffff ffff ffff ffff
	0101 0101 0101 0101 fefe fefe fefe fefe
	8080 8080 8080 8080 7f7f 7f7f 7f7f 7f7f
	0000 0000 0000 0000 ffff ffff ffff ffff
	0000 0000 0000 0000 ffff ffff ffff ffff
	0101 0101 0101 0101 fefe fefe fefe fefe
	8080 8080 4040 300f 7f7f 7f7f 3f3f 0f00
	0000 0000 0000 00ff ffff ffff ffff ff00
	0000 0000 0000 00ff ffff ffff ffff ff00
	0101 0101 0202 0cf0 fefe fefe fcfc f000 ] 


@fill-icn [
	ffff ffff ffff ffff ffff ffff ffff ffff
	ffff ffff ffff ffff ffff ffff ffff ffff ]

@Symbols/buf
	&tri [
	0103 0307 070f 0f1f 80c0 c0e0 e0f0 f0f8
	1f3f 3f7f 7fff ff7f f8fc fcfe feff fffe ]
	&lozenge [
	0103 070f 1f3f 7fff 80c0 e0f0 f8fc feff
	ff7f 3f1f 0f07 0301 fffe fcf8 f0e0 c080 ]
	&square [
	7fff ffff ffff ffff feff ffff ffff ffff
	ffff ffff ffff ff7f ffff ffff ffff fffe ]
	&hexagon [
	0107 1f7f ffff ffff 80e0 f8fe ffff ffff
	ffff ffff 7f1f 0701 ffff ffff fef8 e080 ]
	&circle [
	030f 1f3f 7f7f ffff c0f0 f8fc fefe ffff
	ffff 7f7f 3f1f 0f03 ffff fefe fcf8 f0c0 ]
	&left [
	030f 1f3f 7f7f ffff c030 0804 0202 0101
	ffff 7f7f 3f1f 0f03 0101 0202 0408 30c0 ]
	&quad4 [
	030f 1f3f 7f7f ffff c030 0804 0202 0101
	8080 4040 2010 0c03 0101 0202 0408 30c0 ]
	&quad3 [
	030c 1020 4040 8080 c030 0804 0202 0101
	ffff 7f7f 3f1f 0f03 0101 0202 0408 30c0 ]
	&num1 [
	0000 0000 0107 070f 0000 0000 80e0 e0f0
	0f07 0701 0000 0000 f0e0 e080 0000 0000 ]
	&num2 [
	0000 0000 0000 0000 187e 7eff ff7e 7e18
	187e 7eff ff7e 7e18 0000 0000 0000 0000 ]
	&num3 [
	0107 070f 0f07 0701 80e0 e0f0 f0e0 e080
	187e 7eff ff7e 7e18 187e 7eff ff7e 7e18 ]
	&num4 [
	187e 7eff ff7e 7e18 187e 7eff ff7e 7e18
	187e 7eff ff7e 7e18 187e 7eff ff7e 7e18 ]
	&rabbit-left [
	0102 0202 021e 2048 0080 8080 8080 4030
	403c 0206 0404 0c11 0804 0219 2141 4182 ]
	&dog-left [
	011f 20c8 807c 0404 c0c0 c090 9c5e 4d25
	0404 0405 090a 366c 120a 0412 2222 12f2 ]
	&blank1 $20
	&reverse [
	0000 0000 1030 61ff 0000 0000 6f92 24fc
	ff61 3010 0000 0000 fc24 926f 0000 0000 ]

	&tri-empty [
	0102 0204 0408 0810 8040 4020 2010 1008
	1020 2040 4080 807f 0804 0402 0201 01fe ]
	&lozenge-empty [
	0102 0408 1020 4080 8040 2010 0804 0201
	8040 2010 0804 0201 0102 0408 1020 4080 ]
	&square-empty [
	7f80 8080 8080 8080 fe01 0101 0101 0101
	8080 8080 8080 807f 0101 0101 0101 01fe ]
	&hexagon-empty [
	0106 1860 8080 8080 8060 1806 0101 0101
	8080 8080 6018 0601 0101 0101 0618 6080 ]
	&circle-empty [
	030c 1020 4040 8080 c030 0804 0202 0101
	8080 4040 2010 0c03 0101 0202 0408 30c0 ]
	&right [
	030c 1020 4040 8080 c0f0 f8fc fefe ffff
	8080 4040 2010 0c03 ffff fefe fcf8 f0c0 ]
	&quad1 [
	030c 1020 4040 8080 c0f0 f8fc fefe ffff
	8080 4040 2010 0c03 0101 0202 0408 30c0
	&quad2 [
	030c 1020 4040 8080 c030 0804 0202 0101
	8080 4040 2010 0c03 ffff fefe fcf8 f0c0 ]
	&num1-neg [
	0000 0000 0107 060c 0000 0000 80e0 6030
	0c06 0701 0000 0000 3060 e080 0000 0000 ]
	&num2-neg [
	0000 0000 0000 0000 187e 66c3 c366 7e18
	187e 66c3 c366 7e18 0000 0000 0000 0000 ]
	&num3-neg [
	0107 060c 0c06 0701 80e0 6030 3060 e080
	187e 66c3 c366 7e18 187e 66c3 c366 7e18 ]
	&num4-neg [
	187e 66c3 c366 7e18 187e 66c3 c366 7e18
	187e 66c3 c366 7e18 187e 66c3 c366 7e18 ]
	&rabbit-right [
	0001 0101 0101 020c 8040 4040 4078 0412
	1020 4098 8482 8241 023c 4060 2020 3088 ]
	&dog-right [
	0303 0309 397a b2a4 80f8 0413 013e 2020
	4850 2048 4444 484f 2020 20a0 9050 6c36 ]
	&blank2 $20
	&transmute [
	3048 8787 4830 001f 0000 f8fc 0c0c 0cfc
	3f30 3030 3f1f 0000 f800 0c12 e1e1 120c ]
	&bufend

@reachable $30 ( 1 byte per rule )

@Project/buf
@anchors $40 ( x y )
@rules
	$80 $80 $80 $80 $80 $80 $80 $80
	$80 $80 $80 $80 $80 $80 $80 $80
	$80 $80 $80 $80 $80 $80 $80 $80
	$80 $80 $80 $80 $80 $80 $80 $80
	$80 $80 $80 $80 $80 $80 $80 $80
	$80 $80 $80 $80 $80 $80 $80 $80 &end
@Bag &buf $3e8 &bufend $18 ( x* y* id )
@masks $20 ( bitmask: dir-x dir-y - - - hide eval lock )
@rules/meta $30 ( bitmask: - - - - - - - - )
@Project/bufend