( Dev/Mouse )

%RTN { JMP2r }
%8+  { #0008 ADD2 }
%++  { #0001 ADD2 }
%--  { #0001 SUB2 }

;touch1 { xc 2 yc 2 r 2 }
;touch2 { xc 2 yc 2 r 2 }

;color { byte 1 }
;addr { short 2 }
;pointer { x 2 y 2 }
;circle { xc 2 yc 2 x 2 y 2 r 2 d 2 }

|0100 ;System { vector 2 pad 6 r 2 g 2 b 2 }
|0120 ;Screen { vector 2 width 2 height 2 pad 2 x 2 y 2 addr 2 color 1 }
|0160 ;Mouse  { vector 2 x 2 y 2 state 1 chord 1 }

( program )

|0200

	( theme ) #03fd =System.r #0ef3 =System.g #0bf2 =System.b
	( vectors ) ,on-screen =Screen.vector
	( vectors ) ,on-mouse =Mouse.vector

BRK

@on-screen

	( clear ) ~touch1.xc ~touch1.yc ~touch1.r #00 ,draw-circle JSR2
	( clear ) ~touch2.xc ~touch2.yc ~touch2.r #00 ,draw-circle JSR2

	~touch1.r ++ =touch1.r
	~touch2.r ++ =touch2.r

	( draw ) ~touch1.xc ~touch1.yc ~touch1.r #03 ,draw-circle JSR2
	( draw ) ~touch2.xc ~touch2.yc ~touch2.r #02 ,draw-circle JSR2

	~touch1.xc ~touch1.yc #23 ,touch1.r #0001 ADD2 ,draw-byte JSR2
	~touch2.xc ~touch2.yc #28 ,touch2.r #0001 ADD2 ,draw-byte JSR2

BRK

@on-mouse
 	
	,draw-cursor JSR2

	~Mouse.state #01 NEQ ,$no-touch1 JNZ2
		( clear )   ~touch1.xc ~touch1.yc ~touch1.r #00 ,draw-circle JSR2
		( update )  ~Mouse.x =touch1.xc ~Mouse.y =touch1.yc #0000 =touch1.r
		( release ) #00 =Mouse.state
	$no-touch1
	~Mouse.state #10 NEQ ,$no-touch2 JNZ2
		( clear )   ~touch2.xc ~touch2.yc ~touch2.r #00 ,draw-circle JSR2
		( update )  ~Mouse.x =touch2.xc ~Mouse.y =touch2.yc #0000 =touch2.r
		( release ) #00 =Mouse.state
	$no-touch2

BRK 

@draw-cursor ( -- )

	( clear last cursor )
	,clear_icn =Screen.addr 
	~pointer.x =Screen.x 
	~pointer.y =Screen.y 
	#30 =Screen.color

	( record pointer positions )
	~Mouse.x =pointer.x ~Mouse.y =pointer.y

	( draw new cursor )
	,cursor_icn =Screen.addr 
	~pointer.x =Screen.x 
	~pointer.y =Screen.y 
	#31 ~Mouse.state #00 NEQ ADD =Screen.color

RTN

@draw-circle ( xc yc r color )

	( load ) =color =circle.r =circle.yc =circle.xc
	#0000 =circle.x ~circle.r =circle.y
	~circle.r #0002 MUL2 #0003 SUB2 =circle.d
	( draw ) ,$seg JSR2
	$loop
		( incr ) ~circle.x ++ =circle.x
		~circle.d #0000 #0001 ADD2 LTS2 ^$else JNZ
			( decr ) ~circle.y -- =circle.y
			~circle.x ~circle.y SUB2 #0004 MUL2 ~circle.d ADD2 #000a ADD2 =circle.d
			,$end JMP2
		$else
			~circle.x #0004 MUL2 ~circle.d ADD2 #0006 ADD2 =circle.d
		$end
		( draw ) ,$seg JSR2
		~circle.y ~circle.x #0001 SUB2 GTS2 ^$loop JNZ
	RTN
	$seg
		~circle.xc ~circle.x ADD2 =Screen.x ~circle.yc ~circle.y ADD2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.x SUB2 =Screen.x ~circle.yc ~circle.y ADD2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.x ADD2 =Screen.x ~circle.yc ~circle.y SUB2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.x SUB2 =Screen.x ~circle.yc ~circle.y SUB2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.y ADD2 =Screen.x ~circle.yc ~circle.x ADD2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.y SUB2 =Screen.x ~circle.yc ~circle.x ADD2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.y ADD2 =Screen.x ~circle.yc ~circle.x SUB2 =Screen.y ~color =Screen.color
		~circle.xc ~circle.y SUB2 =Screen.x ~circle.yc ~circle.x SUB2 =Screen.y ~color =Screen.color

RTN

@draw-byte ( x y color addr -- )

	=addr STH
	=Screen.y
	=Screen.x
	,font_hex #00 ~addr PEK2 #04 SFT #0008 MUL2 ADD2 =Screen.addr
	STHr DUP STH =Screen.color
	,font_hex #00 ~addr PEK2 #0f AND #0008 MUL2 ADD2 =Screen.addr
	~Screen.x 8+ =Screen.x
	STHr =Screen.color

RTN

@clear_icn   [ 0000 0000 0000 0000 ]
@cursor_icn  [ 80c0 e0f0 f8e0 1000 ]

@font_hex
[
	003c 464a 5262 3c00 0018 0808 0808 1c00
	003c 4202 3c40 7e00 003c 421c 0242 3c00
	000c 1424 447e 0400 007e 407c 0242 3c00
	003c 407c 4242 3c00 007e 0204 0810 1000
	003c 423c 4242 3c00 003c 4242 3e02 3c00
	003c 4242 7e42 4200 007c 427c 4242 7c00 
	003c 4240 4042 3c00 007c 4242 4242 7c00 
	007e 4078 4040 7e00 007e 4078 4040 4000
]