\ mouse server action
\ the whole screen is devided into 16x16 pixel sections. When pressing one
\ of the mouse keys, the apprpriate action is taken.
\ requires Forthmacs 3.2/2.76 or later
terminals  also
create mouse-indexes	here  64 128 * chars dup allot erase
create mouse-actions	here  256 cells dup allot erase
create mouse-helps	here  256 cells dup allot erase

: action>index		\ ( help action -- i )
	false locals| index action help |
	256 1 do mouse-actions i cells+ token@ action = if i is index leave then loop
	index if index exit then
	256 1	do	mouse-actions i cells+ @ 0=
			if	action  mouse-actions i cells+ token!
				help mouse-helps i cells+ !
				i is index leave
			then
		loop
	index 0= abort" No mouse action available"
	index ;

0 constant mouse-x
0 constant mouse-y
0 constant mouse-button
0 constant mouse-field
0 constant mouse-help

code get-mouse-position	( -- )
	h# 1c			swix
	r0	r0	1 #asr	mov
	r0	'body mouse-x pcr str
	r2	'body mouse-button pcr str
	r1	r1	1 #asr	mov
	r3	'body (lines)	adr
	r3	r3 )		ldr
	r1	r3	r1	sub
	r1	1		decr
	r1	'body mouse-y pcr str
	r0	r0	4 #asr	mov
	r1	r1	4 #asr	mov
	r0	r0	r1 7 #asl add
	r1	h# 1fff	#	mov
	r0	r0	r1	and
	r1	'body mouse-indexes adr
	r0	r0 r1 ib byte	ldr	\ r0 = index
	r1	'body mouse-actions adr	\ r1 = actions-array
	r3	r1	r0 2 #asl add
	r3	'body mouse-field pcr str
	r2	'body mouse-helps adr	\ r2 = help array
	r3	r2	r0 2 #asl add
	r3	r3 )		ldr
	r3	'body mouse-help pcr str
	 c;

create mouse-par 64 allot
code set-mouse-speed	( buffer -- )
	r0	d# 21 #		mov
	r1	mouse-par	adr
		7		swix c;
: slow-mouse	2 mouse-par c!  1 mouse-par 1+ c!  1 mouse-par 2+ c!  set-mouse-speed ;
: fast-mouse	2 mouse-par c!  3 mouse-par 1+ c!  3 mouse-par 2+ c!  set-mouse-speed ;

: mouse-action-cell	( help action x y -- )
	2>r action>index 2r> 7 lshift + mouse-indexes + c! ;
: mouse-action-field	( help action upper-x upper-y width height )
	locals| height width upper-y upper-x action help |
	upper-y height bounds
	do	upper-x width bounds
		do help action i j mouse-action-cell loop
	loop ;
: mouse-action-p-field	( help action upper-cx upper-cy cwidth cheight )
	locals| height width upper-y upper-x action help |
	upper-y 4 rshift height 4 rshift bounds
	do	upper-x 4 rshift width 4 rshift bounds
		do help action i j mouse-action-cell loop
	loop ;

: r-butt?		( -- f)	mouse-button 1 = ;
: m-butt?		( -- f)	mouse-button 2 = ;
: l-butt?		( -- f)	mouse-button 4 = ;

0 1 2constant help-text-pos
0 constant lasthelp
: mouse-xy?		( -- cursor-x cursor-y )
	mouse-x (width) /  mouse-y (height) / ;

: .help-text
	locals| help |
	help lasthelp = ?exit help-text-pos + 0< ?exit help 0= ?exit
	help is lasthelp
	temp-single at-xy?  (fg) (bg)  get-cursor-status
	cursor-off help-text-pos at-xy  black light-grey set-font-colours
	help ". 80 to-column
	set-cursor-status set-font-colours at-xy ;	

