( draw your brains out )

|00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $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 &modx $2 &mody $2
|a0 @File &vector $2 &success $1 &success-lb $1 &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

|000

	@src $40
	@canvas &width $2 &height $2 &length $2 &x $2 &y $2 &changed $1
	@brush &color $1 &shape $1 &patt $1 &tool $1 &natural $1 &erase $1 &blend $1
	@menu &hide $1

|100

@on-reset ( -> )
	;meta #06 DEO2
	( | theme )
	#fb70 .System/r DEO2
	#fb70 .System/g DEO2
	#fb70 .System/b DEO2
	<load-theme>
	<load-patterns>
	<prng-init>
	( | size 512x320 )
	#0200 #0140 <set-size>
	( | vectors )
	;on-console .Console/vector DEO2
	;on-control .Controller/vector DEO2
	;on-mouse .Mouse/vector DEO2
	;on-frame .Screen/vector DEO2
	( | defaults )
	[ LIT2 03 -brush/color ] STZ
	[ LIT2 01 -brush/tool ] STZ
	[ LIT2 02 -brush/shape ] STZ
	[ LIT2 00 -brush/natural ] STZ
	update-spray
	( | soft reboot )
	.src LDZ ?on-soft
	.Console/type DEI ?{ ;dict/default ;src <scpy>
		<open-file> }
	BRK

@on-soft ( -> )
	<open-file>
	BRK

@meta $1
	( name ) "Oekaki 0a
	( desc ) "Drawing 20 "Program 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "19 20 "Sep 20 "2024 $1
	( exts ) 00

(
@|vectors )

@on-console ( -> )
	.Console/read DEI DUP #20 GTH ?{ POP <open-file>
		BRK }
	src/<push>
	BRK

@on-control ( -> )
	.Controller/button DEI
	( ) DUP #08 NEQ ?{ <toggle-menu> }
	#01 AND ?on-control-options
	.Controller/key DEI
	( | keys )
	DUP [ LIT "1 ] NEQ ?{ #00 <set-color> }
	DUP [ LIT "2 ] NEQ ?{ #01 <set-color> }
	DUP [ LIT "3 ] NEQ ?{ #02 <set-color> }
	DUP [ LIT "4 ] NEQ ?{ #03 <set-color> }
	DUP [ LIT "q ] NEQ ?{ #00 <set-shape> }
	DUP [ LIT "w ] NEQ ?{ #02 <set-shape> }
	DUP [ LIT "e ] NEQ ?{ #04 <set-shape> }
	DUP [ LIT "r ] NEQ ?{ #06 <set-shape> }
	DUP [ LIT "s ] NEQ ?{ #00 <set-tool> }
	DUP [ LIT "d ] NEQ ?{ #01 <set-tool> }
	DUP [ LIT "f ] NEQ ?{ #02 <set-tool> }
	DUP [ LIT "h ] NEQ ?{ <flip-horizontal> }
	DUP [ LIT "n ] NEQ ?{ <change-nature> }
	DUP #5b NEQ ?{
		.brush/shape LDZ #01 SUB <set-shape> }
	DUP #5d NEQ ?{ .brush/shape LDZ INC <set-shape> }
	DUP #08 NEQ ?{ <make-file> }
	DUP #09 NEQ ?{ <toggle-menu> }
	DUP #1b NEQ ?{ <center> }
	POP BRK

@on-control-options ( -> )
	.Controller/key DEI
	( | keys )
	DUP [ LIT "n ] NEQ ?{ <make-file> }
	DUP [ LIT "s ] NEQ ?{ <save-file> }
	DUP [ LIT "o ] NEQ ?{ <open-file> }
	DUP [ LIT "v ] NEQ ?{ <paste-snarf> }
	DUP [ LIT "q ] NEQ ?{ #010f DEO }
	POP BRK

@on-mouse ( -> )
	.menu/hide LDZ ?{
		.Mouse/x DEI2 #000f LTH2 ?on-mouse-menu }
	[ LIT2 00 -Mouse/state ] DEI
	( ) DUP #01 GTH .brush/erase STZ
	( ) NEQ [ LIT &last $1 ] OVR ,&last STR
	( fn* ) #10 SFT ORA #10 SFT
	( tool ) .brush/tool LDZ
	( alt override ) [ LIT2 02 -Controller/button ] DEI NEQ ?{ POP #03 }
	#30 SFT ADD
	( load ) #00 SWP ;tools ADD2 LDA2 JSR2 BRK

@on-mouse-menu ( -> )
	#43 [ LIT2 00 -Mouse/state ] DEI NEQ STHk SUB ;hand-icn #00 STHr #30 SFT2 ADD2 <update-cursor>
	.Mouse/state DEI ?{ BRK }
	.Mouse/y DEI2 #0002 SUB2 #000a DIV2 NIP
	( | tool )
	DUP #05 GTH ?{ <set-tool>
		<release-mouse>
		BRK }
	#06 SUB
	( | shape )
	DUP #07 GTH ?{
		.brush/shape LDZ #33 SFT ADD <set-shape>
		<release-mouse>
		BRK }
	#09 SUB
	( | nature )
	DUP #02 GTH ?{ <set-nature>
		<release-mouse>
		BRK }
	DUP #03 NEQ ?{ <toggle-blend>
		<release-mouse> }
	#05 SUB
	( | patt )
	DUP #0a GTH ?{ <set-patt>
		<release-mouse>
		BRK }
	#0a SUB
	( | save )
	DUP #01 NEQ ?{ <save-file>
		<release-mouse>
		BRK }
	POP BRK

@<draw-pict-rect> ( xmin xmax ymin ymax -- )
	INC ,&yn STR
	,&yi STR
	INC ,&xn STR
	,&xi STR
	[ LIT2 05 -Screen/auto ] DEO
	[ LIT2 &yn $1 &yi $1 ]
	&>v ( -- )
		[ LIT2 &xn $1 &xi $1 ]
		( xi yi ) ROTk ROT POP
		( *x *y ) SWP #00 SWP #30 SFT2 ROT #00 SWP #30 SFT2 get-tile-addr .Screen/addr DEO2
		.canvas/y LDZ2 ADD2 .Screen/y DEO2
		.canvas/x LDZ2 ADD2 .Screen/x DEO2
		&>h ( -- )
			[ LIT2 81 -Screen/sprite ] DEO
			INC GTHk ?&>h
		POP2 INC GTHk ?&>v
	POP2 JMP2r

@on-frame ( -> )
	[ LIT2 00 &reqdraw $1 ] EQU ?{
		( x ) [ LIT2 &rect/xmin ff &rect/xmax 00 ]
		( y ) [ LIT2 &rect/ymin ff &rect/ymax 00 ] <draw-pict-rect>
		[ LIT2 00 _&reqdraw ] STR
		[ LIT2 ff _&rect/xmin ] STR
		[ LIT2 ff _&rect/ymin ] STR
		[ LIT2 00 _&rect/xmax ] STR
		[ LIT2 00 _&rect/ymax ] STR }
	BRK

(
@|methods )

@src/<push> ( char -- )
	[ LIT2 00 &ptr -src ] INCk ,&ptr STR
	STZ2
	JMP2r

@src/<cat> ( str* -- )
	LDAk src/<push>
	INC2 LDAk ?&<cat>
	POP2 JMP2r

(
@|controls )

@<release-mouse> ( -- )
	[ LIT2 00 -Mouse/state ] DEO
	JMP2r

@<toggle-menu> ( -- )
	.menu/hide LDZk #00 EQU SWP STZ !<redraw-all>

@<toggle-blend> ( -- )
	[ LIT2 00 -brush/blend ] LDZ EQU .brush/blend STZ !<draw-menu>

@<change-nature> ( -- )
	.brush/natural LDZ INC
	( >> )

@<set-nature> ( val -- )
	DUP .brush/natural LDZ NEQ ?{ POP JMP2r }
	#03 DIVk MUL SUB .brush/natural STZ !<draw-menu>

@<hide-menu> ( -- )
	.menu/hide LDZ ?{
		[ LIT2 01 -menu/hide ] STZ !<redraw-all> }
	JMP2r

@<set-tool> ( tool -- )
	DUP #05 LTH ?{ POP JMP2r }
	DUP .brush/tool LDZ NEQ ?{ POP JMP2r }
	.brush/tool STZ !<draw-menu>

@<set-shape> ( size -- )
	#28 DIVk MUL SUB .brush/shape STZ
	[ LIT2 00 -brush/natural ] STZ !<draw-menu>

@<set-patt> ( patt -- )
	DUP .brush/patt LDZ NEQ ?{ POP JMP2r }
	.brush/patt STZ !<draw-menu>

@<set-color> ( color -- )
	DUP .brush/color LDZ NEQ ?{ POP JMP2r }
	.brush/color STZ
	<draw-pointer> !<draw-menu>

@<set-size> ( w* h* -- )
	.Screen/height DEO2
	.Screen/width DEO2
	( | w )
	.Screen/width DEI2 DUP2 .canvas/width STZ2
	#04 SFT2
	( | h )
	.Screen/height DEI2 DUP2 .canvas/height STZ2
	#04 SFT2
	( | length )
	MUL2 #60 SFT2 .canvas/length STZ2
	JMP2r

@<set-pixel-raw> ( x* y* color -- x* y* )
	STH
	[ LITr 01 ]
	( get tile addr ) get-tile-addr STH2
	( get glyph vertical offset ) DUP2 #0007 AND2 STH2
	ADD2r
	( make bit mask ) OVR2 NIP #07 AND #80 SWP SFT
	( ch0 without ) DUP #ff EOR LDAkr STHr AND
	( ch0 with ) OVR OVR2r ANDr STHr MUL ORA STH2kr STA
	( move to ch2 ) LIT2r 0008 ADD2r
	( ch0 without ) DUP #ff EOR LDAkr STHr AND
	( ch0 with ) SWP SWP2r SFTr STHr MUL ORA STH2r STA
	JMP2r

@<set-state> ( state -- )
	DUP .canvas/changed LDZ EQU ?{
		( set ) .canvas/changed STZ !<draw-state> }
	POP JMP2r

@<flip-horizontal> ( -- )
	.canvas/height LDZ2 #0000
	&>v ( -- )
		STH2k .canvas/width LDZ2 #01 SFT2 #0000
		&>h ( -- )
			( a ) DUP2 STH2kr get-pixel STH
			( b ) OVR2 INC2 .canvas/width LDZ2 SWP2 SUB2 SWP2 get-pixel STH
			( a ) SWPr STHr <set-pixel-raw>
			( b ) NIP2 STHr <set-pixel-raw>
			POP2 POP2 INC2 GTH2k ?&>h
		POP2 POP2 POP2r INC2 GTH2k ?&>v
	POP2 POP2 !<redraw-all>

(
@|helpers )

@get-tile-addr ( x* y* -- x* y* addr* )
	( x ) OVR2 #03 SFT2
	( y ) OVR2 #03 SFT2 .canvas/width LDZ2 #03 SFT2 MUL2 ADD2
	( ) #40 SFT2 ;pict ADD2 JMP2r

@get-pixel ( x* y* -- x* y* color )
	( get tile addr ) get-tile-addr STH2
	( get glyph vertical offset ) DUP2 #0007 AND2 STH2
	ADD2r
	( make bit mask ) OVR2 NIP #07 AND #80 SWP SFT
	( ch1 ) DUP LDAkr STHr AND #00 NEQ SWP
	( ch2 ) STH2r #0008 ADD2 LDA AND #00 NEQ DUP ADD ORA JMP2r

@get-touch-x ( -- x* )
	.Mouse/x DEI2 .canvas/x LDZ2 SUB2 JMP2r

@get-touch-y ( -- y* )
	.Mouse/y DEI2 .canvas/y LDZ2 SUB2 JMP2r

@get-brush-patt ( -- addr* )
	[ LIT2 08 -brush/patt ] LDZ NEQ ?{ update-spray ;spray JMP2r }
	;patterns-icns [ LIT2 00 -brush/patt ] LDZ #30 SFT2 ADD2 JMP2r

@get-speed ( x1* y1* x2* y2* -- distance* )
	( abs y2 - y1 ) ROT2 SUB2 abs2 STH2
	( abs x1 - x2 ) SUB2 abs2 STH2r
	( max + min/2 ) OVR2 OVR2
	( min ) GTH2k [ JMP SWP2 POP2 ] STH2
	( max ) LTH2k [ JMP SWP2 POP2 ] #01 SFT2 STH2r ADD2 JMP2r

(
@|tools )

@tools [
	=move/hover =move/down =move/up =move/drag
	=pen/hover =pen/down =pen/up =pen/drag
	=line/hover =line/down =line/up =line/drag
	=rect/hover =rect/down =rect/up =rect/drag
	=selector/hover =selector/down =selector/up =selector/drag ]

@pen
	&hover ( -- )
	!<draw-pointer>

	&down ( -- )
	[ LIT2 04 -Controller/button ] DEI AND ?&down-shift
	( natural ) [ LIT2 00 -brush/natural ] LDZ EQU ?{ #0000 ;natural/last STA2 }
	get-touch-x #0003 SUB2 ,&last-x STR2
	get-touch-y #0003 SUB2 ,&last-y STR2
	JMP2r

	&down-shift ( -- )
	( ) ,&last-x LDR2 ,&last-y LDR2
	( natural ) [ LIT2 00 -brush/natural ] LDZ EQU ?{ natural }
	( ) get-touch-x #0003 SUB2
	( ) get-touch-y #0003 SUB2 ;<paint-dot>
	<do-line> !<release-mouse>

	&up ( -- )
	JMP2r

	&drag ( -- )
	( ) .Mouse/x DEI2 #0010 GTH2 ?{ <hide-menu> }
	[ LIT2 &last-x $2 ] [ LIT2 &last-y $2 ]
	( natural ) [ LIT2 00 -brush/natural ] LDZ EQU ?{ natural }
	( ) get-touch-x #0003 SUB2 DUP2 ,&last-x STR2
	( ) get-touch-y #0003 SUB2 DUP2 ,&last-y STR2
	( ) ;<paint-dot>
	<do-line> !<draw-pointer>

@line
	&hover ( -- )
	#41 ;selector-icn !<update-cursor>

	&down ( -- )
	.Mouse/x DEI2 #0003 ADD2 ,&x STR2
	.Mouse/y DEI2 #0003 ADD2 ,&y STR2
	get-touch-x ,&real-x STR2
	get-touch-y ,&real-y STR2
	JMP2r

	&up ( -- )
	<clear-guide>
	( ) [ LIT2 &real-x $2 ] [ LIT2 &real-y $2 ]
	( ) get-touch-x
	( ) get-touch-y ;<paint-dot> !<do-line>

	&drag ( -- )
	( ) .Mouse/x DEI2 #0010 GTH2 ?{ <hide-menu> }
	<clear-guide>
	( ) [ LIT2 &x $2 ] [ LIT2 &y $2 ]
	( ) .Mouse/x DEI2 #0003 ADD2 .Mouse/y DEI2 #0003 ADD2 ;<guide-dot>
	<do-line>
	#4f ;selector-icn !<update-cursor>/no-clear

@rect
	&hover ( -- )
	#41 ;selector-icn !<update-cursor>

	&down ( -- )
	.Mouse/x DEI2 #0003 ADD2 ,&x STR2
	.Mouse/y DEI2 #0003 ADD2 ,&y STR2
	get-touch-x ,&real-x STR2
	get-touch-y ,&real-y STR2
	JMP2r

	&up ( -- )
	<clear-guide>
	( ) [ LIT2 &real-x $2 ] [ LIT2 &real-y $2 ]
	( ) get-touch-x INC2 get-touch-y INC2 !<paint-rect>

	&drag ( -- )
	( ) .Mouse/x DEI2 #0010 GTH2 ?{ <hide-menu> }
	<clear-guide>
	( ) [ LIT2 &x $2 ] [ LIT2 &y $2 ]
	( ) .Mouse/x DEI2 #0003 ADD2 .Mouse/y DEI2 #0003 ADD2 <guide-rect>
	#4f ;selector-icn !<update-cursor>/no-clear

@move
	&hover ( -- )
	( draw cursor ) #41 ;hand-icn !<update-cursor>

	&down ( -- )
	( draw cursor ) #43 ;hand-icn/down <update-cursor>
	.Mouse/x DEI2 ,&x STR2
	.Mouse/y DEI2 ,&y STR2
	( set origin ) JMP2r

	&up ( -- )
	( draw cursor ) #43 ;hand-icn <update-cursor> !<redraw-all>

	&drag ( -- )
	( ) .Mouse/x DEI2 #0010 GTH2 ?{ <hide-menu> }
	( draw cursor ) #42 ;hand-icn/down <update-cursor>
	.Mouse/x DEI2
	( ) DUP2 [ LIT2 &x $2 ] SUB2 .canvas/x LDZ2 ADD2 .canvas/x STZ2
	( ) ,&x STR2
	.Mouse/y DEI2
	( ) DUP2 [ LIT2 &y $2 ] SUB2 .canvas/y LDZ2 ADD2 .canvas/y STZ2
	( ) ,&y STR2 !<redraw-all>

@selector
	&hover ( -- )
	#41 ;selector-icn !<update-cursor>

	&down ( -- )
	( record mode ) [ LIT2 01 -Mouse/state ] DEI EQU ,&paste STR
	.Mouse/x DEI2 ,&x STR2
	.Mouse/y DEI2 ,&y STR2
	get-touch-x ,&real-x STR2
	get-touch-y ,&real-y STR2
	JMP2r

	&up ( -- )
	[ LIT &paste $1 ] ?{ !<paste-snarf> }
	<clear-guide>
	( ) [ LIT2 &real-x $2 ] #33 SFT2 [ LIT2 &real-y $2 ] #33 SFT2
	( ) get-touch-x #33 SFT2 get-touch-y #33 SFT2 !<snarf-rect>

	&drag ( -- )
	( ) .Mouse/x DEI2 #0010 GTH2 ?{ <hide-menu> }
	,&paste LDR ?{ JMP2r }
	<clear-guide>
	( ) [ LIT2 &x $2 ] [ LIT2 &y $2 ]
	( ) .Mouse/x DEI2 .Mouse/y DEI2 <guide-rect>
	#43 ;selector-icn !<update-cursor>

(
@|filters )

@patt-pixel ( x* y* -- x* y* f )
	( y* ) DUP2 #0007 AND2 get-brush-patt ADD2 LDA STH
	( ) OVR2 NIP #80 SWP #07 AND SFT STHr AND JMP2r

@set-pixel ( x* y* -- )
	DUP2 .canvas/height LDZ2 LTH2 ?{ POP2 POP2 JMP2r }
	OVR2 .canvas/width LDZ2 LTH2 ?{ POP2 POP2 JMP2r }
	patt-pixel ?{ POP2 POP2 JMP2r }
	.brush/color LDZ !<blend-pixel>/force

@dec-pixel ( x* y* -- )
	DUP2 .canvas/height LDZ2 LTH2 ?{ POP2 POP2 JMP2r }
	OVR2 .canvas/width LDZ2 LTH2 ?{ POP2 POP2 JMP2r }
	patt-pixel ?{ POP2 POP2 JMP2r }
	get-pixel DUP ?{ POP2 POP2 POP JMP2r }
	#01 SUB !<blend-pixel>

@inc-pixel ( x* y* -- )
	DUP2 .canvas/height LDZ2 LTH2 ?{ POP2 POP2 JMP2r }
	OVR2 .canvas/width LDZ2 LTH2 ?{ POP2 POP2 JMP2r }
	patt-pixel ?{ POP2 POP2 JMP2r }
	get-pixel DUP #03 NEQ ?{ POP2 POP2 POP JMP2r }
	INC
	( >> )

@<blend-pixel> ( x* y* color -- )
	DUP .brush/color LDZ INC LTH ?{ POP POP2 POP2 JMP2r }
	&force ( x* y* color -- )
	STH
	[ LITr 01 ]
	( x y ) OVR2 OVR2 <push-reqdraw>
	( get tile addr ) get-tile-addr STH2
	( get glyph vertical offset ) DUP2 #0007 AND2 STH2
	ADD2r
	( make bit mask ) OVR2 NIP #07 AND #80 SWP SFT
	( ch0 without ) DUP #ff EOR LDAkr STHr AND
	( ch0 with ) OVR OVR2r ANDr STHr MUL ORA STH2kr STA
	( move to ch2 ) LIT2r 0008 ADD2r
	( ch0 without ) DUP #ff EOR LDAkr STHr AND
	( ch0 with ) SWP SWP2r SFTr STHr MUL ORA STH2kr STA
	POP2r POP2 POP2 JMP2r

@<do-line> ( x1* y1* x2* y2* fn* -- )
	,&fn STR2
	,&y2 STR2
	,&x2 STR2
	STH2
	STH2
	( | x )
	[ LIT2 ADD2r SUB2r ] ,&x2 LDR2 STH2kr SUB2k abs2 ,&dx STR2
	SWP2 lts2 [ JMP SWP POP ] ,&sx STR
	SWP2r
	( | y )
	[ LIT2 ADD2r SUB2r ] ,&y2 LDR2 STH2kr SUB2k abs2 #0000 SWP2 SUB2 ,&dy STR2
	SWP2 lts2 [ JMP SWP POP ] ,&sy STR
	,&dx LDR2 ,&dy LDR2 ADD2
	&>while ( -- )
		( draw ) OVR2r STH2r STH2kr [ LIT2 &fn $2 ] JSR2
		( y ) STH2kr [ LIT2 &y2 $2 ] NEQ2 ?{
			( x ) OVR2r STH2r [ LIT2 &x2 $2 ] EQU2 ?&end }
		( e -> e2 ) DUP2k ADD2 DUP2
		( y ) [ LIT2 &dy $2 ] lts2 ?{
			( e+dy ) SWP2 ,&dy LDR2 ADD2 SWP2
			( x1+sx ) SWP2r [ LIT2r 0001 ] [ &sx $1 ] SWP2r }
		( x ) [ LIT2 &dx $2 ] gts2 ?{
			( e+dx ) ,&dx LDR2 ADD2
			( y1+sy ) [ LIT2r 0001 ] [ &sy $1 ] }
		!&>while
	&end POP2 POP2r POP2r JMP2r

@<guide-dot> ( x* y* -- )
	.Screen/y DEO2
	.Screen/x DEO2
	[ LIT2 41 -Screen/pixel ] DEO
	JMP2r

@<paint-dot> ( x* y* -- )
	( | brush type )
	;set-pixel ;dec-pixel ;inc-pixel .brush/erase LDZ ?{ SWP2 }
	POP2 .brush/blend LDZ ?{ SWP2 }
	POP2 ,&fn STR2
	( | brush shape )
	;shapes-icns [ LIT2 00 -brush/shape ] LDZ #30 SFT2 ADD2 ,&patt STR2
	,&y STR2
	,&x STR2
	#4000
	&>l ( -- )
		#00 OVR
		( addr* ) DUP2 #03 SFT [ LIT2 &patt $2 ] ADD2 LDA STH
		( mask ) #80 OVR #07 AND SFT STHr AND #00 EQU ?{
			( x* ) DUP2 #07 AND [ LIT2 &x $2 ] ADD2
			( y* ) OVR2 #03 SFT [ LIT2 &y $2 ] ADD2
			( fn ) [ LIT2 &fn $2 ] JSR2 }
		POP2 INC GTHk ?&>l
	POP2 #01 !<set-state>

@natural ( x* y* -- x* y* )
	( speed ) OVR2 OVR2 get-touch-x get-touch-y get-speed
	( clamp down ) #0004 SUB2 DUP2 #8000 LTH2 ?{ POP2 #0000 }
	( average ) [ LIT2 &last $2 ] ADD2 #01 SFT2 DUP2 ,&last STR2
	( max ) NIP #07 LTHk [ JMP SWP POP ]
	( inv ) .brush/natural LDZ #02 LTH ?{ #07 SWP SUB }
	#07 AND .brush/shape LDZ #33 SFT ADD .brush/shape STZ
	JMP2r

@normalize-rect ( x1* y1* x2* y2* -- )
	STH2
	ROT2 SWP2 [ LTH2k JMP SWP2 ]
	( not-same ) EQU2k #00 SWP ADD2
	( y1 y2 ) ROT2 STH2r [ LTH2k JMP SWP2 ]
	( not-same ) EQU2k #00 SWP ADD2
	( ) ROT2 SWP2 JMP2r

(
@|file )

@<make-file> ( -- )
	;pict .canvas/length LDZ2 mclr #00 <set-state> !<redraw-all>

@<save-file> ( -- )
	;src .File/name DEO2
	.canvas/length LDZ2 .File/length DEO2
	;pict .File/write DEO2
	#00 !<set-state>

@<open-file> ( -- )
	#00 <set-state>
	#00 ;src/ptr LDA #0004 SUB2 ;dict/icn-ext scmp ?<open-icn>
	#00 ;src/ptr LDA #0004 SUB2 ;dict/tga-ext scmp ?<open-tga>
	;src .File/name DEO2
	.canvas/length LDZ2 .File/length DEO2
	;pict .File/read DEO2 !<redraw-all>

@<open-icn> ( -- )
	;src .File/name DEO2
	#0008 .File/length DEO2
	;pict ,&ptr STR2
	&>s ( -- )
		[ LIT2 &ptr $2 ] DUP2 #0010 ADD2 ,&ptr STR2
		feof ?&end
		!&>s

	&end ( -- )
	( | cat chr ext )
	;dict/chr-ext src/<cat> !<redraw-all>

@<open-tga> ( -- )
	;src .File/name DEO2
	#0012 .File/length DEO2
	;tga .File/read DEO2
	( | cat chr ext )
	;dict/chr-ext src/<cat>
	( | flip endianness )
	;tga/x LDA2k SWP SWP2 STA2
	;tga/y LDA2k SWP SWP2 STA2
	;tga/w LDA2k SWP SWP2 STA2
	;tga/h LDA2k SWP SWP2 STA2
	( | get parser )
	;tga/image-type LDA
	( ) DUP #02 EQU ?&rawt
	( ) DUP #03 EQU ?&rawm
	POP
	( | error )
	;&error-txt <pstr>/
	#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 <pstr>/
	#0a18 DEO
	JMP2r

	&rawt ( type -- )
	POP ;tga-rawt #0004 !parse-tga

	&rawm ( type -- )
	POP ;tga-rawm #0001 !parse-tga

	&error-txt ( err )
	"Unsupported 20 "image-type: 20 $1

@parse-tga ( filter* length* -- )
	( | cache size )
	.File/length DEO2
	,&filter STR2
	;tga/w LDA2 ,&w STR2
	( | paint )
	[ LIT2 01 -Screen/auto ] DEO
	#0000 [ LIT2r 0000 ]
	&stream ( -- )
	;&pixel feof ?&end
	STH2kr ;&pixel [ LIT2 &filter $2 ] JSR2 <set-pixel-raw>
	POP2 INC2 DUP2 [ LIT2 &w $2 ] NEQ2 ?&stream
	( lb ) POP2 #0000 INC2r !&stream
	&end POP2 POP2r !<redraw-all>
	&pixel $4

@<snarf-rect> ( x* y* x2* y2* -- )
	;dict/snarf-ext .File/name DEO2
	,&y2 STR2
	,&x2 STR2
	,&y1 STR2
	,&x1 STR2
	( | store size )
	,&y2 LDR2 ,&y1 LDR2 SUB2 ,&height STR2
	,&x2 LDR2 ,&x1 LDR2 SUB2 ,&width STR2
	#0004 .File/length DEO2
	;&size .File/write DEO2
	#0010 .File/length DEO2
	,&width LDR2 #0000 NEQ2 ,&height LDR2 #0000 NEQ2 AND ?{ JMP2r }
	( | copy block )
	[ LIT2 &y2 $2 ] [ LIT2 &y1 $2 ]
	&>v ( -- )
		STH2k [ LIT2 &x2 $2 ] [ LIT2 &x1 $2 ]
		&>h ( -- )
			STH2kr get-tile-addr .File/write DEO2
			POP2
			( ) #0008 ADD2 GTH2k ?&>h
		POP2 POP2 POP2r
		( ) #0008 ADD2 GTH2k ?&>v
	POP2 POP2 JMP2r
	&size &width $2 &height $2

@<paste-snarf> ( -- )
	;dict/snarf-ext .File/name DEO2
	#0002 .File/length DEO2
	;&width .File/read DEO2
	;&height .File/read DEO2
	( | split in rows, get data length )
	[ LIT2 &width $2 ] #43 SFT2 .File/length DEO2
	get-touch-y #33 SFT2 DUP2 [ LIT2 &height $2 ] ADD2 SWP2
	&>l ( -- )
		get-touch-x #33 SFT2 OVR2 get-tile-addr .File/read DEO2
		POP2 POP2 #0008 ADD2 GTH2k ?&>l
	POP2 POP2 !<redraw-all>

(
@|filters )

@tga-rawt ( rgba* -- color )
	STH2
	( b ) #00 LDAkr STHr INC2r
	( g ) #00 LDAkr STHr INC2r
	( r ) #00 LDAr STHr
	( res ) ADD2 ADD2 #0003 DIV2 NIP #06 SFT #03 SWP SUB JMP2r

@tga-rawm ( grey* -- color )
	( res ) LDA #06 SFT JMP2r

(
@|luts )

@tga-types-txts
	&null "missing-type $1
	&rawc "RAW-color $1
	&rawt "RAW-true $1
	&rawm "RAW-mono $1
	&rlec "RLE-color $1
	&rlet "RLE-true $1
	&rlem "RLE-mono $1
	&void "unknown-type $1

@tga-types [
	=tga-types-txts/null =tga-types-txts/rawc
	=tga-types-txts/rawt =tga-types-txts/rawm
	=tga-types-txts/void =tga-types-txts/void
	=tga-types-txts/void =tga-types-txts/void
	=tga-types-txts/void =tga-types-txts/rlec
	=tga-types-txts/rlet =tga-types-txts/rlem ]

(
@|drawing )

@<center> ( -- )
	.canvas/width LDZ2 .Screen/width DEI2 SUB2 .canvas/x STZ2
	.canvas/height LDZ2 .Screen/height DEI2 SUB2 .canvas/y STZ2
	( >> )

@<redraw-all> ( -- )
	#0000 DUP2 .Screen/y DEO2
	.Screen/x DEO2
	[ LIT2 83 -Screen/pixel ] DEO
	.canvas/x LDZ2 .canvas/y LDZ2
	( >> )

@<draw-pict> ( x* y* -- )
	.Screen/y DEO2
	DUP2 ,&anchor STR2
	.Screen/x DEO2
	;pict .Screen/addr DEO2
	[ LIT2 05 -Screen/auto ] DEO
	.canvas/height LDZ2 #03 SFT2 NIP #00
	&>v ( -- )
		.canvas/width LDZ2 #03 SFT2 NIP #00
		&>h ( -- )
			[ LIT2 81 -Screen/sprite ] DEO
			INC GTHk ?&>h
		POP2
		( ) [ LIT2 &anchor $2 ] .Screen/x DEO2
		( ) .Screen/y DEI2k #0008 ADD2 ROT DEO2
		INC GTHk ?&>v
	POP2

@<draw-menu> ( -- )
	[ LIT2 00 -menu/hide ] LDZ EQU ?{ JMP2r }
	( | background )
	#000f .Screen/x DEO2
	#0000 .Screen/y DEO2
	[ LIT2 93 -Screen/pixel ] DEO
	#000e .Screen/x DEO2
	[ LIT2 91 -Screen/pixel ] DEO
	#0003 .Screen/x DEO2
	[ LIT2 04 -Screen/auto ] DEO
	( | tools )
	;tools-icns .Screen/addr DEO2
	#0500
	&>l-tools ( -- )
		#00 OVR #000a MUL2 INC2 INC2 .Screen/y DEO2
		DUP .brush/tool LDZ NEQ #0a MUL .Screen/sprite DEO
		INC GTHk ?&>l-tools
	POP2
	( | shapes )
	;shapes-icns [ LIT2 00 -brush/shape ] LDZ #63 SFT2 ADD2 .Screen/addr DEO2
	#0800
	&>l-shapes ( -- )
		#00 OVR #06 ADD #000a MUL2 INC2 INC2 .Screen/y DEO2
		DUP [ LIT2 07 -brush/shape ] LDZ AND NEQ #0a MUL .Screen/sprite DEO
		INC GTHk ?&>l-shapes
	POP2
	( | nature )
	;nature-icns .Screen/addr DEO2
	#0300
	&>l-nature ( -- )
		#00 OVR #0f ADD #000a MUL2 INC2 INC2 .Screen/y DEO2
		DUP .brush/natural LDZ NEQ #0a MUL .Screen/sprite DEO
		INC GTHk ?&>l-nature
	POP2
	( | blend )
	;blend-icns [ LIT2 00 -brush/blend ] LDZ #30 SFT2 ADD2 .Screen/addr DEO2
	#00b6 .Screen/y DEO2
	[ LIT2 0a -Screen/sprite ] DEO
	( | patterns )
	;patterns-icns .Screen/addr DEO2
	#0900
	&>l-patterns ( -- )
		#00 OVR #14 ADD #000a MUL2 INC2 INC2 .Screen/y DEO2
		DUP .brush/patt LDZ NEQ #0a MUL .Screen/sprite DEO
		INC GTHk ?&>l-patterns
	POP2
	( >> )

@<draw-state> ( -- )
	.menu/hide LDZ ?{
		;state-icn .Screen/addr DEO2
		#0003 .Screen/x DEO2
		[ LIT2 00 -Screen/auto ] DEO
		#0130 .Screen/y DEO2
		#000a .canvas/changed LDZ [ JMP SWP POP ] .Screen/sprite DEO }
	JMP2r

@<guide-rect> ( x* y* x* y* -- )
	normalize-rect STH2
	STH2
	( | vertical a )
	OVR2 .Screen/x DEO2
	DUP2 .Screen/y DEO2
	OVR2r STH2r OVR2 SUB2 #4102 <pixel-times>
	( | horizontal a )
	OVR2 .Screen/x DEO2
	DUP2 .Screen/y DEO2
	OVR2 STH2kr SWP2 SUB2 #4101 <pixel-times>
	( | vertical b )
	DUP2r [ LITr -Screen/x ] DEO2r
	DUP2 .Screen/y DEO2
	OVR2r STH2r OVR2 SUB2 #4102 <pixel-times>
	( | horizontal b )
	OVR2 .Screen/x DEO2
	OVR2r [ LITr -Screen/y ] DEO2r
	OVR2 STH2kr SWP2 SUB2 INC2 #4101 <pixel-times>
	POP2r POP2r POP2 POP2 JMP2r

@<pixel-times> ( times* color auto -- )
	.Screen/auto DEO
	STH
	[ LITr -Screen/pixel ] #0000 SWP2 SUB2
	&>u ( -- )
		DEOkr
		INC2 ORAk ?&>u
	POP2 POP2r JMP2r

@<paint-rect> ( x1* y1* x2* y2* -- )
	normalize-rect SWP2 ,&x2 STR2
	ROT2 ,&x1 STR2
	SWP2
	&>v ( -- )
		STH2k [ LIT2 &x2 $2 ] [ LIT2 &x1 $2 ]
		&>h ( -- )
			DUP2 STH2kr <paint-dot>
			INC2 GTH2k ?&>h
		POP2 POP2 POP2r INC2 GTH2k ?&>v
	POP2 POP2 JMP2r

@update-spray ( -- )
	prng ,&seed STR2
	#0800
	&>l ( -- )
		( patt ) prng [ LIT2 &seed $2 ] AND2 AND
		( save ) OVR #00 SWP ;spray ADD2 STA
		INC GTHk ?&>l
	POP2 JMP2r

@<clear-guide> ( -- )
	#0000 DUP2 .Screen/x DEO2
	.Screen/y DEO2
	[ LIT2 c0 -Screen/pixel ] DEO
	JMP2r

@<draw-pointer> ( -- )
	[ LIT2 00 -brush/color ] LDZ EQU ?&eraser
	.brush/erase LDZ ?&eraser
	[ LIT2 40 -brush/color ] LDZ ADD ;pointer-icn <update-cursor>
	( | indicator )
	;<draw-cursor>/x LDA2 ;<draw-cursor>/y LDA2
	( ) get-pixel #03 DIVk MUL SUB #41 ADD .Screen/pixel DEO
	POP2 POP2 JMP2r
	&eraser #43 ;eraser-icn
	( >> )

@<update-cursor> ( color addr* -- )
	[ LIT2 00 -Screen/auto ] DEO
	;fill-icn .Screen/addr DEO2
	#40 <draw-cursor> &no-clear .Screen/addr DEO2
	.Mouse/x DEI2 ,<draw-cursor>/x STR2
	.Mouse/y DEI2 ,<draw-cursor>/y STR2
	( >> )

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

@<load-patterns> ( -- )
	( | ...continue after loading theme )
	#0020 .File/length DEO2
	;patterns-icns .File/read DEO2
	#0080 .File/length DEO2
	;shapes-icns .File/read DEO2
	JMP2r

(
@|requests )

@<push-reqdraw> ( x* y* -- )
	( y >> 3 ) #03 SFT2 NIP DUPk
	( y < y1 ) ;on-frame/rect/ymin LDA GTH ?{ DUP ;on-frame/rect/ymin STA }
	( y > y2 ) ;on-frame/rect/ymax LDA LTH ?{ DUP ;on-frame/rect/ymax STA }
	POP
	( x >> 3 ) #03 SFT2 NIP DUPk
	( x < x1 ) ;on-frame/rect/xmin LDA GTH ?{ DUP ;on-frame/rect/xmin STA }
	( x > x2 ) ;on-frame/rect/xmax LDA LTH ?{ DUP ;on-frame/rect/xmax STA }
	POP #01 ;on-frame/reqdraw STA
	JMP2r

(
@|stdlib )

@<prng-init> ( -- )
	[ LIT2 00 -DateTime/second ] DEI
	( ) [ LIT2 00 -DateTime/minute ] DEI #60 SFT2 EOR2
	( ) [ LIT2 00 -DateTime/hour ] DEI #c0 SFT2 EOR2 ,prng/x STR2
	[ LIT2 00 -DateTime/hour ] DEI #04 SFT2
	( ) [ LIT2 00 -DateTime/day ] DEI #10 SFT2 EOR2
	( ) [ LIT2 00 -DateTime/month ] DEI #60 SFT2 EOR2
	( ) .DateTime/year DEI2 #a0 SFT2 EOR2 ,prng/y STR2
	JMP2r

@prng ( -- number* )
	[ LIT2 &x $2 ]
	( ) DUP2 #50 SFT2 EOR2
	( ) DUP2 #03 SFT2 EOR2
	( ) [ LIT2 &y $2 ] DUP2 ,&x STR2
	DUP2 #01 SFT2 EOR2 EOR2
	( ) ,&y STR2k POP JMP2r

@abs2 ( a* -- f )
	DUP2 #0f SFT2 EQU ?{ #0000 SWP2 SUB2 }
	JMP2r

@gts2 ( a* b* -- f )
	SWP2
	( >> )

@lts2 ( a* b* -- f )
	SUB2 POP #07 SFT JMP2r

@mclr ( src* len* -- )
	OVR2 ADD2 SWP2
	&>l ( -- )
		[ LIT2r 0000 ] STH2k STA2r
		INC2 GTH2k ?&>l
	POP2 POP2 JMP2r

@scmp ( a* b* -- f )
	STH2
	&>l ( a* b* -- f )
		LDAk LDAkr STHr NEQk ?&d
		DUP EOR EQUk ?&d
		POP2 INC2 INC2r !&>l

	&d ( a* c1 c2 b* -- f )
	NIP2 POP2r EQU JMP2r

@<scpy> ( src* dst* -- )
	STH2
	&>w ( -- )
		LDAk #00 STH2kr STA2
		INC2r INC2 LDAk ?&>w
	POP2 POP2r JMP2r

@feof ( buf* -- eof )
	.File/read DEO2
	[ LIT2 00 -File/success-lb ] DEI EQU JMP2r

@<load-theme> ( -- )
	;&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

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

@<pstr> ( str* -- )
	LDAk #18 DEO
	INC2 & LDAk ?<pstr>
	POP2 JMP2r

(
@|assets )

@nature-icns [
	0e1f 3b7f fefc f870 0e1f 1b3f 3e78 6080
	0106 1e7c fcd8 f870 ]

@blend-icns [ 0102 050a 152b 57af 0103 070f 1f3f 7fff ]

@patterns-icns [
	ffff ffff ffff ffff aa55 aa55 aa55 aa55
	aa00 aa00 aa00 aa00 8844 2211 8844 2211
	1122 4488 1122 4488 aa00 5500 aa00 5500
	8800 4400 2200 1100 8800 1100 2200 4400
	3225 5288 88c8 88f8 ]

@shapes-icns [
	0000 0010 0000 0000 0000 0018 1800 0000
	0000 183c 3c18 0000 0018 3c7e 7e3c 1800
	003c 7e7e 7e7e 3c00 187e 7eff ff7e 7e18
	3c7e ffff ffff 7e3c 7eff ffff ffff ff7e
	0000 0010 1000 0000 0000 0018 1800 0000
	0000 1018 1808 0000 0000 1818 1818 0000
	0010 1818 1818 0800 0018 1818 1818 1800
	1018 1818 1818 1808 1818 1818 1818 1818
	0000 0018 0000 0000 0000 0018 1800 0000
	0000 001c 3800 0000 0000 003c 3c00 0000
	0000 003e 7c00 0000 0000 007e 7e00 0000
	0000 007f fe00 0000 0000 00ff ff00 0000
	0000 0010 0800 0000 0000 0018 1800 0000
	0000 1038 1c08 0000 0000 3038 1c0c 0000
	0020 7038 1c0e 0400 0060 7038 1c0e 0600
	40e0 7038 1c0e 0702 c0e0 7038 1c0e 0703
	0000 0008 1000 0000 0000 0018 1800 0000
	0000 081c 3810 0000 0000 0c1c 3830 0000
	0004 0e1c 3870 2000 0006 0e1c 3870 6000
	0207 0e1c 3870 e040 0307 0e1c 3870 e0c0 ]

@tools-icns [
	0205 02f8 7838 5888 0215 2220 2020 20c0
	0205 0208 1020 4080 02f5 aad4 aad6 aafe
	02d5 8200 8200 82d6 ]

@fill-icn [ ffff ffff ffff ffff ]

@pointer-icn [ 80c0 e0f0 f8e0 1000 ]

@eraser-icn [ c0e0 7038 1c0a 0400 ]

@selector-icn [ 0010 106c 1010 0000 ]

@hand-icn [ 4040 787c fcfc 7c38 ]
	&down [ 0000 787c fcfc 7c38 ]

@state-icn [ 183c 66c3 c366 3c18 ]

@dict
	&default "pict40x28.chr $1
	&icn-ext ".icn $1
	&chr-ext ".chr $1
	&tga-ext ".tga $1
	&snarf-ext ".snarf $1

(
@|memory )

@tga &id-length $1 &color-map $1 &image-type $1 &map $5 &position &x $2 &y $2 &size &w $2 &h $2 &depth $1 &descriptor $1

@spray $8

@pict $a400