uxn/projects/examples/devices/mouse.tal

( Mouse: Paint with 3 colors with each mouse button. )

|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &modx $2 &mody $2

|0000

	@length $2
	@frame $2
	@pen &x $2 &y $2 &x2 $2 &y2 $2
	@pointer &x $2 &y $2 &lastx $2 &lasty $2 &state $1

|0100

@on-reset ( -> )
	( | theme )
	#68af .System/r DEO2
	#79bf .System/g DEO2
	#8ace .System/b DEO2
	( | vectors )
	;on-mouse .Mouse/vector DEO2
	;on-frame .Screen/vector DEO2
	<draw-mouse>
	BRK

(
@|vectors )

@on-frame ( -> )
	.Mouse/state DEI ?{
		;run DUP2 JSR2 JSR2 }
	BRK

@on-mouse ( -> )
	( | clear last cursor )
	.pointer/x LDZ2 .Screen/x DEO2
	.pointer/y LDZ2 .Screen/y DEO2
	;fill-icn .Screen/addr DEO2
	[ LIT2 40 -Screen/sprite ] DEO
	<draw-mouse>
	( | draw new cursor )
	;pointer-icn .Screen/addr DEO2
	#00 .Screen/auto DEO
	.Mouse/x DEI2 DUP2 .pointer/x STZ2
	.Screen/x DEO2
	.Mouse/y DEI2 DUP2 .pointer/y STZ2
	.Screen/y DEO2
	#45 .Mouse/state DEI #00 NEQ #05 MUL ADD .Screen/sprite DEO
	( | on down )
	.Mouse/state DEI #00 NEQ .pointer/state LDZ #00 EQU AND ?&down
	( | on drag )
	.Mouse/state DEI ?&drag
	.Mouse/state DEI .pointer/state STZ
	BRK
	&down ( -> )
		#0000 DUP2 .length STZ2
		.frame STZ2
		<clear-screen>
		( | record start position )
		.Mouse/x DEI2 DUP2 .pointer/x STZ2
		.pointer/lastx STZ2
		.Mouse/y DEI2 DUP2 .pointer/y STZ2
		.pointer/lasty STZ2
		.Mouse/state DEI .pointer/state STZ
		BRK
	&drag ( -> )
		( | record )
		;stroke .length LDZ2 #20 SFT2 ADD2 STH2 .pointer/x LDZ2 .pointer/lastx LDZ2 SUB2 STH2kr STA2
		.pointer/y LDZ2 .pointer/lasty LDZ2 SUB2 STH2r INC2 INC2 STA2
		( | move ptr )
		.length LDZ2 INC2 .length STZ2
		( | draw line )
		.pointer/lastx LDZ2 .pointer/lasty LDZ2 .pointer/x LDZ2 .pointer/y LDZ2 #01 <draw-line>
		( | record last position )
		.Mouse/x DEI2 DUP2 .pointer/lastx STZ2
		DUP2 .pen/x STZ2
		.pen/x2 STZ2
		.Mouse/y DEI2 DUP2 .pointer/lasty STZ2
		DUP2 .pen/y STZ2
		.pen/y2 STZ2
		.Mouse/state DEI DUP #01 NEQ INC ;run/color STA
		.pointer/state STZ
		BRK

(
@|main )

@run ( -- )
	( | read )
	;stroke .frame LDZ2 #20 SFT2 ADD2 STH2 .pen/x LDZ2 STH2kr LDA2 ADD2 .pen/x STZ2
	.pen/y LDZ2 STH2r INC2 INC2 LDA2 ADD2 .pen/y STZ2
	( | line )
	.pen/x LDZ2 .pen/y LDZ2 .pen/x2 LDZ2 .pen/y2 LDZ2 .frame LDZ2 #01 SFT2 NIP #01 AND [ LIT &color $1 ] ADD INC <draw-line>
	( | history )
	.pen/x LDZ2 .pen/x2 STZ2
	.pen/y LDZ2 .pen/y2 STZ2
	( | incr frame )
	.frame LDZ2 INC2 .length LDZ2 INC2
	( mod2 ) DIV2k MUL2 SUB2 .frame STZ2
	JMP2r

@<draw-mouse> ( -- )
	( | clear )
	#0010 DUP2 .Screen/x DEO2
	.Screen/y DEO2
	#16 .Screen/auto DEO
	;fill-icn .Screen/addr DEO2
	#40 .Screen/sprite DEOk
	DEO
	( | buttons )
	#0300
	&l ( -- )
		#01 OVR #40 SFT SFT .Mouse/state DEI AND #00 EQU ?{
			#0010 .Screen/y DEO2
			#00 OVR #40 SFT2 ;button-icn ADD2 .Screen/addr DEO2
			#45 .Screen/sprite DEO }
		INC GTHk ?&l
	POP2
	( | outline )
	#0010 .Screen/y DEO2
	;mouse-icn .Screen/addr DEO2
	#16 .Screen/auto DEO
	#4a .Screen/sprite DEOk
	DEO
	JMP2r

@<draw-line> ( x1* y1* x2* y2* color -- )
	,&color STR
	,&y STR2
	,&x STR2
	,&y2 STR2
	,&x2 STR2
	,&x LDR2 ,&x2 LDR2 SUB2 abs2 ,&dx STR2
	#0000 ,&y LDR2 ,&y2 LDR2 SUB2 abs2 SUB2 ,&dy STR2
	#ffff [ LIT2 00 _&x2 ] LDR2 ,&x LDR2 lts2 DUP2 ADD2 ADD2 ,&sx STR2
	#ffff [ LIT2 00 _&y2 ] LDR2 ,&y LDR2 lts2 DUP2 ADD2 ADD2 ,&sy STR2
	[ LIT2 &dx $2 ] [ LIT2 &dy $2 ] ADD2 STH2
	&while ( -- )
		[ LIT2 &x2 $2 ] DUP2 .Screen/x DEO2
		[ LIT2 &x $2 ] EQU2 [ LIT2 &y2 $2 ] DUP2 .Screen/y DEO2
		[ LIT2 &y $2 ] EQU2 [ LIT2 &color $1 -Screen/pixel ] DEO
		AND ?&end
		STH2kr DUP2 ADD2 DUP2 ,&dy LDR2 lts2 ?&skipy
		STH2r ,&dy LDR2 ADD2 STH2 ,&x2 LDR2 [ LIT2 &sx $2 ] ADD2 ,&x2 STR2
	&skipy ( -- )
		,&dx LDR2 gts2 ?&while
	STH2r ,&dx LDR2 ADD2 STH2 ,&y2 LDR2 [ LIT2 &sy $2 ] ADD2 ,&y2 STR2
	!&while
	&end POP2r JMP2r

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

@lts2 ( a* b* -- f )
	#8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r

@gts2 ( a* b* -- f )
	#8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r

@<clear-screen> ( -- )
	#0000 DUP2 .Screen/x DEO2
	.Screen/y DEO2
	#80 .Screen/pixel DEO
	JMP2r

@fill-icn [ ffff ffff ffff ffff ]

@pointer-icn [ 80c0 e0f0 f8e0 1000 ]

@mouse-icn [
	000d 1212 1212 121d 00b0 4848 4848 48b8
	1010 1010 1008 0700 0808 0808 0810 e000 ]

@button-icn [
	000c 1e1e 1e1e 1e0c 0000 0000 0000 0000
	0001 0303 0303 0301 0080 c0c0 c0c0 c080
	0000 0000 0000 0000 0030 7878 7878 7830 ]

(
@|memory )

@stroke