\ Select any window on the WorkBench using a PopUp Menu.
\
\ This programs scans the list of windows starting from
\ the WorkBench screen.  It then displays their names in
\ a Popup Menu.  When one is chosen it is brought to the
\ front and activated.
\
\ Author: Phil Burk
\ Copyright 1991 Phil Burk
\
\ 00001 PLB 2/7/92 Flush events from window after about.

getmodule includes
include? tolower ju:char-macros
include? forbid() ju:exec_support

include? POPUP.OPEN popup_menus.f

ANEW TASK-FIND_WINDOW

\ Global Data
200 value FW_INIT_X  \ default X,Y position
  0 value FW_INIT_Y
 90 value FW_WIDTH
 10 value FW_HEIGHT
  3 value FW_FORE_COLOR
  0 value FW_BACK_COLOR

fw_height value FW_CLOSE_X \ right edge of "close box"
fw_height 2* 3 + value FW_ABOUT_X \ right edge of "about box"

variable FW-QUIT

\ Define glue routines to call Intuition ----------
: ActivateWindow() ( window -- )
	callvoid>abs intuition_lib ActivateWindow
;

: WindowToFront() ( window -- )
	callvoid>abs intuition_lib WindowToFront
;

\ Decide whether a window should be included in menu.
: FW.FILTER.WINDOW ( window -- ok? )
	dup s@ wd_title 0count -trailing nip 0= \ blank title?
	IF
		drop false
	ELSE
		dup s@ wd_flags BACKDROP and
		IF
			drop false
		ELSE
			s@ wd_title ?dup
			IF
				c@ ascii % = not  \ % means it is our window!
			ELSE
				false
			THEN
		THEN
	THEN
;

: FW.GET.FIRST.WINDOW ( -- window | 0 )
\ scan for a valid window starting from workbench
	get.workbench.screen s@ sc_FirstWindow
	BEGIN
		dup 0=
		IF
			false \ pass 0 out
		ELSE
			dup fw.filter.window ( -- window ok? ) NOT
		THEN
	WHILE
		s@ wd_NextWindow
	REPEAT
;

: FW.NEXT.WINDOW ( window -- next-window | 0 , skip our own )
\ filter out windows, LOOP until zero OR one passes
	BEGIN
		s@ wd_NextWindow
		dup 0=
		IF
			true \ pass 0 out
		ELSE
			dup fw.filter.window ( -- window ok? )
		THEN
	UNTIL
;

: LIST.WINDOWS ( -- , for debugging )
	forbid()
	fw.get.first.window
	BEGIN
		dup 0= not
	WHILE
		dup s@ wd_title 0count type cr
		fw.Next.Window
	REPEAT
	drop
	permit()
;

: FW.NTH.WINDOW { N | win -- window | 0 }
	forbid()
	fw.get.first.window -> win
	N 0
	DO
		win 0=
		IF 0 -> win LEAVE
		THEN \ past end of list!
		win fw.Next.Window -> win
	LOOP
	win
	permit()
;

: FW.GET.MAXW.N { | maxw n -- maxw N , maximum width of any title }
	forbid()
	0 -> N
	0 -> maxw
	fw.get.first.window
	BEGIN
		dup 0= not
	WHILE
		dup s@ wd_title 0count gr.textlen
		maxw max -> maxw
		1 +-> n  \ increment counter
		fw.Next.Window
	REPEAT
	drop
	permit()
	maxw n
;

: FW.DRAW.NAMES  { | win win# -- }
	forbid()
	0 -> win#
	fw.get.first.window -> win
	BEGIN
		win 0= not
	WHILE
		win s@ wd_title 0count
		win# popup.draw.text      \ draw in popup menu
		win fw.Next.Window -> win
		1 +-> win#
	REPEAT
	permit()
;

\ Initialize and Open popup window.
: FW.START.POPUP ( -- x y , calc starting X,Y )
	fw_fore_color fw_back_color popup.set.colors
	gr-curwindow @ 0= abort" No current window!" \ Impossible!
	gr-curwindow @ s@ wd_leftedge fw_close_x +
	gr-curwindow @ s@ wd_topedge fw_height + 1-
;

: FW.POP.OPEN ( -- ok? )
	fw.start.popup
	fw.get.maxw.n \ width nitems
	0 popup.open
;

: FW.POP.CLOSE ( -- )
	popup.close
;

: FW.DO.POP  ( -- , find lost window )
	fw.pop.open
	IF
		fw.draw.names
		popup.scan ( -- n true | false )
		fw.pop.close
		IF
			fw.nth.window ?dup
			IF
				dup WindowToFront()
				ActivateWindow()
			THEN
		THEN
	THEN
;

: FW.ABOUT  { | pwind -- , pop up an About box }
\
\ open window
	fw.start.popup
	255 10 \ width nitems
	0 popup.open -> pwind
	pwind 0= IF exit THEN
\
\ Draw message
	" FindWindow V1.1, ©1991 Phil Burk"	count 0 popup.draw.text
	" Written using JForth Pro V3.0"	count 1 popup.draw.text
	" Shareware! Please send $10 to:"	count 2 popup.draw.text
	"     PO Box 151051"				count 3 popup.draw.text
	"     San Rafael, CA"				count 4 popup.draw.text
	"     94915-1051"					count 5 popup.draw.text
	" Usage: RUN FINDWINDOW {options}"	count 6 popup.draw.text
	" Options: -X xpos -Y ypos"			count 7 popup.draw.text
	"          -F fcolor  -B bcolor"	count 8 popup.draw.text
	" Eg.  RUN FINDWINDOW -X 260 -F 3"	count 9 popup.draw.text
\
\ Wait for Mouse Button Up
	BEGIN
		pop-window @ ev.wait
		pop-window @ ev.getclass MOUSEBUTTONS =
		IF
			ev-last-code @ selectup =
		ELSE
			false
		THEN
	UNTIL
\
	popup.close
;

: FW.PROCESS { class | result xp -- done? , process events from IDCMP }
	false -> result
	class
	CASE
		MOUSEBUTTONS OF   ( check for up or down )
\ X determines response
			ev.getxy drop -> xp
			ev-last-code @
			CASE
			SELECTDOWN OF
				xp fw_close_x <
				IF
					true -> result   \ quit
				ELSE
					xp fw_about_x >
					IF
						fw.do.pop
					THEN
				THEN
			ENDOF
			SELECTUP OF
				xp fw_close_x fw_about_x within?
				IF
					fw.about
\ Flush events from main window in case user hit it. 00001
					ev.flush
				THEN
			ENDOF
			ENDCASE
		ENDOF

		warning" fw.PROCESS -- Unrecognized event!"
	ENDCASE
	result
;

: FW.SCAN  ( -- item true | 0 , loop until done )
	BEGIN
		gr-curwindow @ ev.wait
		gr-curwindow @ ev.getclass dup
		IF fw.process
		THEN
	UNTIL
;

: GR.BOX { x1 y1 x2 y2 -- , draw box }
	x1 y1 gr.move
	x2 y1 gr.draw
	x2 y2 gr.draw
	x1 y2 gr.draw
	x1 y1 gr.draw
;

: FW.DRAW.WIN ( -- draw fake gadgets )
\ set backdrop color
	fw_back_color gr.color!
\
\ draw background of window
	0 0 fw_width 1- fw_height 1- gr.rect
\
\ set foreground and background colors for text
	fw_fore_color gr.color!
	fw_back_color gr.bcolor!
\
\ draw box around window
	0 0 fw_width 1- fw_height 1- gr.box

\ draw "close gadget"
	fw_close_x 4 / 1+
	fw_height 4 / 1+
	fw_close_x 3 * 4 /
	fw_height 3 * 4 / 1-   gr.box
\
\ draw line after close
	fw_close_x 0 gr.move
	fw_close_x fw_height 1- gr.draw
\
\ draw "?" About box.
	fw_close_x 3 + fw_height 3 - gr.move
	" ?" gr.text
	fw_about_x 0 gr.move
	fw_about_x fw_height 1- gr.draw
\
	fw_about_x 5 + fw_height 3 - gr.move
	" Windows" gr.text
;

: FW.INIT ( -- window | 0 )
	gr.init
	pad NewWindow.Setup      ( Set defaults for window )
\
\ set values for FW window
	get.workbench.screen s@ sc_width fw_width - \ largest allowable X
		fw_init_x min pad s! nw_LeftEdge
	get.workbench.screen s@ sc_height fw_height - \ largest allowable Y
		fw_init_y min pad s! nw_TopEdge
\
	fw_width pad s! nw_Width
	fw_height pad s! nw_Height
	0 pad s! nw_title
	MOUSEBUTTONS pad s! nw_idcmpflags
	REPORTMOUSE SMART_REFRESH | BORDERLESS |
		pad s! nw_flags
\
\ Create window from template and make it the current window.
	pad gr.opencurw
;

: FW.TERM ( -- )
	gr.closecurw
	gr.term
;

: FW.MESSAGE ( -- , print message for user )
	>newline
	." FindWindow V1.1, © 1991 Phil Burk, written in JForth" cr
;

: FindWindow  ( -- , find lost window )
	fw.init
	IF
		fw.draw.win
		fw.scan
	THEN
	fw.term
;

\ Read parameters from input. These may be handy in other programs.
: GET.NAMED.PARAMETER ( <-?> <xxx> -- $addr char true | false )
	bl word dup c@
	IF
		dup 1+ c@ ascii - =
		IF
			2+ c@
			bl word swap true
		ELSE
			drop false
		THEN
	ELSE
		drop false
	THEN
;

: GET.NUM.PARAMETER ( <-?> <n> -- n char true | false )
	false >r
	get.named.parameter
	IF
		swap number?
		IF
			drop swap
			rdrop true >r \ set flag
		ELSE
			drop
		THEN
	THEN
	r>
;

: FindWindow.APPL ( <parameters> -- )
	BEGIN
		get.num.parameter
	WHILE
		tolower
		CASE
		ascii x OF dup -> fw_init_x ENDOF
		ascii y OF dup -> fw_init_y ENDOF
		ascii f OF dup -> fw_fore_color ENDOF
		ascii b OF dup -> fw_back_color ENDOF
		dup emit ." is unrecognized!" cr
		ENDCASE
		drop
	REPEAT
	fw.message
	FindWindow
;

if.forgotten fw.term

cr ." CLONE FINDWINDOW.APPL" cr
