~rabbits/oekaki

5fb5505ae59f04276c05ebc5cdb1d30127ffb426 — neauoire 6 months ago b6b502e
Housekeeping
1 files changed, 98 insertions(+), 100 deletions(-)

M src/oekaki.tal
M src/oekaki.tal => src/oekaki.tal +98 -100
@@ 127,6 127,9 @@
		<toggle-blend> }
	POP BRK

(
@|controls )

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


@@ 142,6 145,101 @@
	[ LIT2 01 -menu/hide ] STZ
	!<clear-menu>

@<set-tool> ( tool -- )
	.brush/tool STZ
	!<draw-menu>

@<set-shape> ( size -- )
	#0f AND .brush/shape STZ
	!<draw-menu>

@<set-patt> ( patt -- )
	.brush/patt STZ
	!<draw-menu>

@<set-blend> ( blend -- )
	.brush/blend STZ
	!<draw-menu>

@<set-color> ( color -- )
	.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> ( x* y* color -- x* y* )
	#01 STH2
	( bounds x ) OVR2 INC2 .canvas/width LDZ2 GTH2 ?&outside
	( bounds y ) DUP2 .canvas/height LDZ2 GTH2 ?&outside
	( 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
	&outside ( `color* -- )
		POP2r JMP2r

@<flip-horizontal> ( -- )
	.canvas/height LDZ2 #0000
	&v ( -- )
		STH2k .canvas/width LDZ2 #01 SFT2 #0000
	&h ( -- )
		( a ) DUP2 STH2kr get-pixel STH
		( b ) OVR2 .canvas/width LDZ2 SWP2 SUB2 SWP2 get-pixel STH
		( a ) SWPr STHr <set-pixel>
		( b ) NIP2 STHr <set-pixel>
		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-shape ( -- addr* )
	;shapes-icns [ LIT2 00 -brush/shape ] LDZ #30 SFT2 ADD2 JMP2r

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

@get-brush-type ( -- fn* )
	.Mouse/state DEI #02 LTH ?{ ;dec-pixel JMP2r }
	;inc-pixel JMP2r

(
@|tools )



@@ 232,106 330,6 @@
		!<redraw-all>

(
@|brush )

@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-shape ( -- addr* )
	;shapes-icns [ LIT2 00 -brush/shape ] LDZ #30 SFT2 ADD2 JMP2r

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

@get-brush-type ( -- fn* )
	.Mouse/state DEI #02 LTH ?{ ;dec-pixel JMP2r }
	;inc-pixel JMP2r

@<set-tool> ( tool -- )
	.brush/tool STZ
	!<draw-menu>

@<set-shape> ( size -- )
	#0f AND .brush/shape STZ
	!<draw-menu>

@<set-patt> ( patt -- )
	.brush/patt STZ
	!<draw-menu>

@<set-blend> ( blend -- )
	.brush/blend STZ
	!<draw-menu>

@<set-color> ( color -- )
	.brush/color STZ
	<draw-pointer>
	!<draw-menu>

(
@|main )

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

@<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

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

@get-tile-addr ( x* y* -- x* y* addr* )
	get-tile-id #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

@<set-pixel> ( x* y* color -- x* y* )
	#01 STH2
	( bounds x ) OVR2 INC2 .canvas/width LDZ2 GTH2 ?&outside
	( bounds y ) DUP2 .canvas/height LDZ2 GTH2 ?&outside
	( 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
	&outside ( `color* -- )
		POP2r JMP2r

(
@|filters )

@inc-pixel ( x* y* -- )