\ Pop Up Menus
\
\ Pop Up a pseudo-menu anywhere on the screen.
\ Uses left mouse button!
\ It is assumed that the left mouse button  is already down.
\
\ The calls are typically made in this order:
\   POPUP.OPEN ( xleft ytop width nitems title/0 -- window | 0 )
\   POPUP.DRAW.TEXT ( addr count item# -- , draw item text )
\   POPUP.SCAN  ( -- item# true | 0 , loop until done )
\   POPUP.CLOSE ( -- )
\
\ You can change the colors used by calling:
\   POPUP.SET.COLORS ( forecolor backcolor -- )
\
\ Author: Phil Burk
\ Copyright 1991 Phil Burk

getmodule includes
include? { ju:locals
include? ev-last-code ju:amiga_events

ANEW TASK-POPUP_MENUS

\ Glue Routines to call Amiga Libraries --------------------

: RectFill() ( rastport x1 y1 x2 y2 -- )
	callvoid>abs graphics_lib RectFill
;

: Move() ( rastport x y -- , Move to new position. )
     callvoid>abs graphics_lib move
;
: Draw() ( rastport x y -- , Draw to new position. )
     callvoid>abs graphics_lib draw
;

: SetDrMd()  ( rastport mode -- , Set drawing mode )
    callvoid>abs graphics_lib SetDrMd
;

: SetAPen()  ( rastport mode -- , Set pen color )
    callvoid>abs graphics_lib SetAPen
;

: SetBPen()  ( rastport mode -- , Set background pen color )
    callvoid>abs graphics_lib SetBPen
;

: Text() ( rastport addr count -- , draw characters )
     callvoid>abs graphics_lib text
;

: GET.WORKBENCH.SCREEN ( -- screen )
\ check to see if library needs to be opened
	intuition_lib @ dup 0=
	IF
		drop intuition? intuition_lib @
	THEN
	>rel \ get IntuitionBase
	s@ ib_ActiveScreen dup 0=
	IF
		." No screen active!" abort
	THEN
;

\ Data Structures and Constants  -------------------------
variable POP-HIGH      \ currently highlighted
variable POP-PICKED    \ item number picked , 0 based
variable POP-NUM-ITEMS \ number of items allowed for
variable POP-WINDOW
variable POP-RASTPORT

2 value POP_Y_START
6 value POP_X_START

10 value POP_LINE_HEIGHT
200 value POP_TEXT_WIDTH

640 value POP_SCREEN_WIDTH \ modified by POPUP.OPEN
200 value POP_SCREEN_HEIGHT

1 value POP_FORE_COLOR
0 value POP_BACK_COLOR

\ Graphics routines for PopUp RastPort ----------------

: POP.MOVE ( x y -- )
	pop-rastport @ -rot Move()
;
: POP.DRAW ( x y -- )
	pop-rastport @ -rot Draw()
;

: POP.COLOR! ( color -- )
	pop-rastport @ swap SetAPen()
;

: POP.BCOLOR! ( color -- )
	pop-rastport @ swap SetBPen()
;

\ ------------------------------------------------------

: POP.N>XY ( n -- x y , top left of Nth item )
	pop_x_start swap
	pop_line_height * pop_y_start +
;

: POP.XY>N { x y | flag -- n true | false , which item is selected? }
	0 -> flag
\ check to see if in X bounds
	x pop_x_start dup pop_text_width + within?
	IF
		y pop_y_start -  pop_line_height +
		dup 0<
		IF
			drop
		ELSE
			pop_line_height /  ( calc which line )
\
\ make sure N is legal
			dup pop-num-items @ < dup -> flag not
			IF
				drop
			THEN
		THEN
	THEN
	flag
;

: POP.COMP.N ( n -- , unconditionally COMPlement an item )
\ set Exclusive OR drawing mode
	pop-rastport @
	dup 0= abort" POP.COMP.N - no rastport!"
	2 SetDrMd() \ XOR mode!!!
\
\ draw rectangle over item
	pop-rastport @
	swap POP.n>xy
	over pop_text_width +
	over pop_line_height +
	RectFill()
\
\ restore drawing mode
	pop-rastport @ JAM2 SetDrMd()
;

: POP.DEHIGHLIGHT ( -- , dehighlight previous if any )
	pop-high @ dup 0< \ any currently highlighted?
	IF
		drop
	ELSE
		pop.comp.n
		-1 pop-high !
	THEN
;

: POP.HIGHLIGHT ( x y -- , highlight the current choice )
	pop.xy>n
	IF
		dup pop-high @ =
		IF
			drop \ already highlighted
		ELSE
			pop.dehighlight
\ remember which one is highlighted
			dup pop-high !
			pop.comp.n
		THEN
	ELSE
		pop.dehighlight
	THEN
;

: POP.PICK ( x y -- )
	pop.xy>n
	IF
		pop-picked !
	THEN
;

: POP.PROCESS { class | result -- done? , process events from IDCMP }
	false -> result
	class
	CASE
		MOUSEBUTTONS OF   ( only respond to Mouse UP )
			ev-last-code @ SELECTUP =
			IF
				ev.getxy00 POP.pick
				true -> result
			THEN
		ENDOF

		MOUSEMOVE OF
			ev.getxy00 POP.highlight
		ENDOF

		CLOSEWINDOW OF true -> result ENDOF

		warning" POPUP.LOOP -- Unrecognized event!"
	ENDCASE
	result
;

: POPUP.SCAN  ( -- item true | 0 , loop until done )
	-1 pop-picked !
\
	BEGIN
		pop-window @ ev.wait
		pop-window @ ev.getclass dup
		IF pop.process
		THEN
	UNTIL
\
	pop-picked @ dup 0<
	IF
		drop false
	ELSE
		true
	THEN
;

: POPUP.DRAW.TEXT ( addr count n -- , draw item text )
	pop-rastport @ 0= abort" POPUP.SET.TEXT - No rastport!"
	dup pop-num-items @ < not abort" POPUP.SET.TEXT - Item# too high!"
\
\ draw text
	POP.n>xy pop_line_height + 2- pop.move
	pop_fore_color pop.color!
	pop_back_color pop.bcolor!
	pop-rastport @ -rot Text()
	
;

: POP.DRAW.BOX { x1 y1 x2 y2 -- }
	x1 y1 pop.move
	x2 y1 pop.draw
	x2 y2 pop.draw
	x1 y2 pop.draw
	x1 y1 pop.draw
;

: POP.CALC.HEIGHT ( nitems -- height )
	pop_line_height * pop_y_start 2* + 2+
;

: POP.CALC.WIDTH ( inwidth -- width )
	pop_x_start 2* +
;

: (POPUP.OPEN) { x y width height title -- window | 0 }
\ adjust X and Y so that the menu fits nicely on screen
	x
	x width +
	pop_screen_width -  ( ammount past edge )
	0 max - -> x \ move left
\
	y
	y height +
	pop_screen_height -  ( ammount past edge )
	0 max - -> y \ move up
\
	x pad s! nw_LeftEdge
	y pad s! nw_TopEdge
	width  pad s! nw_Width
	height pad s! nw_Height
	title pad s! nw_title
\
	CLOSEWINDOW MOUSEBUTTONS | MOUSEMOVE |   ( add MOUSEMOVE )
		pad s! nw_idcmpflags
	REPORTMOUSE SMART_REFRESH |
	BORDERLESS | ACTIVATE | NOCAREREFRESH |
		pad s! nw_flags
\
\ Create window from template and make it the current window.
	pad OpenWindow() dup
	IF
\ set window and rastport
		dup pop-window !
		dup s@ wd_rport pop-rastport !
\
\ Draw Background of Popup Window
		pop_back_color pop.color!
		pop-rastport @
		0 0 width 1-
		height 1-
		RectFill()
\
\ draw box outline
		pop_fore_color pop.color!
		0 0 width 1-
		height 1- pop.draw.box
	ELSE
		pop-window off
		pop-rastport off
	THEN
;

: POPUP.OPEN { x y width nitems title | height -- window | 0 }
	-1 pop-high !  \ none highlighted
	nitems pop-num-items !
	width -> pop_text_width
\
	pad NewWindow.Setup      ( Set defaults for window )
\
\ get screen width and height
	get.workbench.screen
	dup s@ sc_width -> pop_screen_width
	s@ sc_height -> pop_screen_height
\
\ Make sure PopUp window fits on screen
	width pop.calc.width  pop_screen_width min -> width
	nitems pop.calc.height  pop_screen_height min -> height
	x y width height title (popup.open)
;

: POPUP.CLOSE ( -- )
	pop-window @ ?dup
	IF
		CloseWindow()
		pop-window off
		pop-rastport off
	THEN
;

: POPUP.SET.COLORS ( forecolor backcolor -- )
	-> pop_back_color
	-> pop_fore_color
;

if.forgotten popup.close