home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
607.lha
/
FindWindow_v1.1
/
Find_Window.f
next >
Wrap
Text File
|
1992-02-08
|
8KB
|
398 lines
\ 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