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 < prev    next >
Encoding:
FORTH Source  |  1992-02-08  |  7.4 KB  |  398 lines
  1. \ Select any window on the WorkBench using a PopUp Menu.
  2. \
  3. \ This programs scans the list of windows starting from
  4. \ the WorkBench screen.  It then displays their names in
  5. \ a Popup Menu.  When one is chosen it is brought to the
  6. \ front and activated.
  7. \
  8. \ Author: Phil Burk
  9. \ Copyright 1991 Phil Burk
  10. \
  11. \ 00001 PLB 2/7/92 Flush events from window after about.
  12.  
  13. getmodule includes
  14. include? tolower ju:char-macros
  15. include? forbid() ju:exec_support
  16.  
  17. include? POPUP.OPEN popup_menus.f
  18.  
  19. ANEW TASK-FIND_WINDOW
  20.  
  21. \ Global Data
  22. 200 value FW_INIT_X  \ default X,Y position
  23.   0 value FW_INIT_Y
  24.  90 value FW_WIDTH
  25.  10 value FW_HEIGHT
  26.   3 value FW_FORE_COLOR
  27.   0 value FW_BACK_COLOR
  28.  
  29. fw_height value FW_CLOSE_X \ right edge of "close box"
  30. fw_height 2* 3 + value FW_ABOUT_X \ right edge of "about box"
  31.  
  32. variable FW-QUIT
  33.  
  34. \ Define glue routines to call Intuition ----------
  35. : ActivateWindow() ( window -- )
  36.     callvoid>abs intuition_lib ActivateWindow
  37. ;
  38.  
  39. : WindowToFront() ( window -- )
  40.     callvoid>abs intuition_lib WindowToFront
  41. ;
  42.  
  43. \ Decide whether a window should be included in menu.
  44. : FW.FILTER.WINDOW ( window -- ok? )
  45.     dup s@ wd_title 0count -trailing nip 0= \ blank title?
  46.     IF
  47.         drop false
  48.     ELSE
  49.         dup s@ wd_flags BACKDROP and
  50.         IF
  51.             drop false
  52.         ELSE
  53.             s@ wd_title ?dup
  54.             IF
  55.                 c@ ascii % = not  \ % means it is our window!
  56.             ELSE
  57.                 false
  58.             THEN
  59.         THEN
  60.     THEN
  61. ;
  62.  
  63. : FW.GET.FIRST.WINDOW ( -- window | 0 )
  64. \ scan for a valid window starting from workbench
  65.     get.workbench.screen s@ sc_FirstWindow
  66.     BEGIN
  67.         dup 0=
  68.         IF
  69.             false \ pass 0 out
  70.         ELSE
  71.             dup fw.filter.window ( -- window ok? ) NOT
  72.         THEN
  73.     WHILE
  74.         s@ wd_NextWindow
  75.     REPEAT
  76. ;
  77.  
  78. : FW.NEXT.WINDOW ( window -- next-window | 0 , skip our own )
  79. \ filter out windows, LOOP until zero OR one passes
  80.     BEGIN
  81.         s@ wd_NextWindow
  82.         dup 0=
  83.         IF
  84.             true \ pass 0 out
  85.         ELSE
  86.             dup fw.filter.window ( -- window ok? )
  87.         THEN
  88.     UNTIL
  89. ;
  90.  
  91. : LIST.WINDOWS ( -- , for debugging )
  92.     forbid()
  93.     fw.get.first.window
  94.     BEGIN
  95.         dup 0= not
  96.     WHILE
  97.         dup s@ wd_title 0count type cr
  98.         fw.Next.Window
  99.     REPEAT
  100.     drop
  101.     permit()
  102. ;
  103.  
  104. : FW.NTH.WINDOW { N | win -- window | 0 }
  105.     forbid()
  106.     fw.get.first.window -> win
  107.     N 0
  108.     DO
  109.         win 0=
  110.         IF 0 -> win LEAVE
  111.         THEN \ past end of list!
  112.         win fw.Next.Window -> win
  113.     LOOP
  114.     win
  115.     permit()
  116. ;
  117.  
  118. : FW.GET.MAXW.N { | maxw n -- maxw N , maximum width of any title }
  119.     forbid()
  120.     0 -> N
  121.     0 -> maxw
  122.     fw.get.first.window
  123.     BEGIN
  124.         dup 0= not
  125.     WHILE
  126.         dup s@ wd_title 0count gr.textlen
  127.         maxw max -> maxw
  128.         1 +-> n  \ increment counter
  129.         fw.Next.Window
  130.     REPEAT
  131.     drop
  132.     permit()
  133.     maxw n
  134. ;
  135.  
  136. : FW.DRAW.NAMES  { | win win# -- }
  137.     forbid()
  138.     0 -> win#
  139.     fw.get.first.window -> win
  140.     BEGIN
  141.         win 0= not
  142.     WHILE
  143.         win s@ wd_title 0count
  144.         win# popup.draw.text      \ draw in popup menu
  145.         win fw.Next.Window -> win
  146.         1 +-> win#
  147.     REPEAT
  148.     permit()
  149. ;
  150.  
  151. \ Initialize and Open popup window.
  152. : FW.START.POPUP ( -- x y , calc starting X,Y )
  153.     fw_fore_color fw_back_color popup.set.colors
  154.     gr-curwindow @ 0= abort" No current window!" \ Impossible!
  155.     gr-curwindow @ s@ wd_leftedge fw_close_x +
  156.     gr-curwindow @ s@ wd_topedge fw_height + 1-
  157. ;
  158.  
  159. : FW.POP.OPEN ( -- ok? )
  160.     fw.start.popup
  161.     fw.get.maxw.n \ width nitems
  162.     0 popup.open
  163. ;
  164.  
  165. : FW.POP.CLOSE ( -- )
  166.     popup.close
  167. ;
  168.  
  169. : FW.DO.POP  ( -- , find lost window )
  170.     fw.pop.open
  171.     IF
  172.         fw.draw.names
  173.         popup.scan ( -- n true | false )
  174.         fw.pop.close
  175.         IF
  176.             fw.nth.window ?dup
  177.             IF
  178.                 dup WindowToFront()
  179.                 ActivateWindow()
  180.             THEN
  181.         THEN
  182.     THEN
  183. ;
  184.  
  185. : FW.ABOUT  { | pwind -- , pop up an About box }
  186. \
  187. \ open window
  188.     fw.start.popup
  189.     255 10 \ width nitems
  190.     0 popup.open -> pwind
  191.     pwind 0= IF exit THEN
  192. \
  193. \ Draw message
  194.     " FindWindow V1.1, ©1991 Phil Burk"    count 0 popup.draw.text
  195.     " Written using JForth Pro V3.0"    count 1 popup.draw.text
  196.     " Shareware! Please send $10 to:"    count 2 popup.draw.text
  197.     "     PO Box 151051"                count 3 popup.draw.text
  198.     "     San Rafael, CA"                count 4 popup.draw.text
  199.     "     94915-1051"                    count 5 popup.draw.text
  200.     " Usage: RUN FINDWINDOW {options}"    count 6 popup.draw.text
  201.     " Options: -X xpos -Y ypos"            count 7 popup.draw.text
  202.     "          -F fcolor  -B bcolor"    count 8 popup.draw.text
  203.     " Eg.  RUN FINDWINDOW -X 260 -F 3"    count 9 popup.draw.text
  204. \
  205. \ Wait for Mouse Button Up
  206.     BEGIN
  207.         pop-window @ ev.wait
  208.         pop-window @ ev.getclass MOUSEBUTTONS =
  209.         IF
  210.             ev-last-code @ selectup =
  211.         ELSE
  212.             false
  213.         THEN
  214.     UNTIL
  215. \
  216.     popup.close
  217. ;
  218.  
  219. : FW.PROCESS { class | result xp -- done? , process events from IDCMP }
  220.     false -> result
  221.     class
  222.     CASE
  223.         MOUSEBUTTONS OF   ( check for up or down )
  224. \ X determines response
  225.             ev.getxy drop -> xp
  226.             ev-last-code @
  227.             CASE
  228.             SELECTDOWN OF
  229.                 xp fw_close_x <
  230.                 IF
  231.                     true -> result   \ quit
  232.                 ELSE
  233.                     xp fw_about_x >
  234.                     IF
  235.                         fw.do.pop
  236.                     THEN
  237.                 THEN
  238.             ENDOF
  239.             SELECTUP OF
  240.                 xp fw_close_x fw_about_x within?
  241.                 IF
  242.                     fw.about
  243. \ Flush events from main window in case user hit it. 00001
  244.                     ev.flush
  245.                 THEN
  246.             ENDOF
  247.             ENDCASE
  248.         ENDOF
  249.  
  250.         warning" fw.PROCESS -- Unrecognized event!"
  251.     ENDCASE
  252.     result
  253. ;
  254.  
  255. : FW.SCAN  ( -- item true | 0 , loop until done )
  256.     BEGIN
  257.         gr-curwindow @ ev.wait
  258.         gr-curwindow @ ev.getclass dup
  259.         IF fw.process
  260.         THEN
  261.     UNTIL
  262. ;
  263.  
  264. : GR.BOX { x1 y1 x2 y2 -- , draw box }
  265.     x1 y1 gr.move
  266.     x2 y1 gr.draw
  267.     x2 y2 gr.draw
  268.     x1 y2 gr.draw
  269.     x1 y1 gr.draw
  270. ;
  271.  
  272. : FW.DRAW.WIN ( -- draw fake gadgets )
  273. \ set backdrop color
  274.     fw_back_color gr.color!
  275. \
  276. \ draw background of window
  277.     0 0 fw_width 1- fw_height 1- gr.rect
  278. \
  279. \ set foreground and background colors for text
  280.     fw_fore_color gr.color!
  281.     fw_back_color gr.bcolor!
  282. \
  283. \ draw box around window
  284.     0 0 fw_width 1- fw_height 1- gr.box
  285.  
  286. \ draw "close gadget"
  287.     fw_close_x 4 / 1+
  288.     fw_height 4 / 1+
  289.     fw_close_x 3 * 4 /
  290.     fw_height 3 * 4 / 1-   gr.box
  291. \
  292. \ draw line after close
  293.     fw_close_x 0 gr.move
  294.     fw_close_x fw_height 1- gr.draw
  295. \
  296. \ draw "?" About box.
  297.     fw_close_x 3 + fw_height 3 - gr.move
  298.     " ?" gr.text
  299.     fw_about_x 0 gr.move
  300.     fw_about_x fw_height 1- gr.draw
  301. \
  302.     fw_about_x 5 + fw_height 3 - gr.move
  303.     " Windows" gr.text
  304. ;
  305.  
  306. : FW.INIT ( -- window | 0 )
  307.     gr.init
  308.     pad NewWindow.Setup      ( Set defaults for window )
  309. \
  310. \ set values for FW window
  311.     get.workbench.screen s@ sc_width fw_width - \ largest allowable X
  312.         fw_init_x min pad s! nw_LeftEdge
  313.     get.workbench.screen s@ sc_height fw_height - \ largest allowable Y
  314.         fw_init_y min pad s! nw_TopEdge
  315. \
  316.     fw_width pad s! nw_Width
  317.     fw_height pad s! nw_Height
  318.     0 pad s! nw_title
  319.     MOUSEBUTTONS pad s! nw_idcmpflags
  320.     REPORTMOUSE SMART_REFRESH | BORDERLESS |
  321.         pad s! nw_flags
  322. \
  323. \ Create window from template and make it the current window.
  324.     pad gr.opencurw
  325. ;
  326.  
  327. : FW.TERM ( -- )
  328.     gr.closecurw
  329.     gr.term
  330. ;
  331.  
  332. : FW.MESSAGE ( -- , print message for user )
  333.     >newline
  334.     ." FindWindow V1.1, © 1991 Phil Burk, written in JForth" cr
  335. ;
  336.  
  337. : FindWindow  ( -- , find lost window )
  338.     fw.init
  339.     IF
  340.         fw.draw.win
  341.         fw.scan
  342.     THEN
  343.     fw.term
  344. ;
  345.  
  346. \ Read parameters from input. These may be handy in other programs.
  347. : GET.NAMED.PARAMETER ( <-?> <xxx> -- $addr char true | false )
  348.     bl word dup c@
  349.     IF
  350.         dup 1+ c@ ascii - =
  351.         IF
  352.             2+ c@
  353.             bl word swap true
  354.         ELSE
  355.             drop false
  356.         THEN
  357.     ELSE
  358.         drop false
  359.     THEN
  360. ;
  361.  
  362. : GET.NUM.PARAMETER ( <-?> <n> -- n char true | false )
  363.     false >r
  364.     get.named.parameter
  365.     IF
  366.         swap number?
  367.         IF
  368.             drop swap
  369.             rdrop true >r \ set flag
  370.         ELSE
  371.             drop
  372.         THEN
  373.     THEN
  374.     r>
  375. ;
  376.  
  377. : FindWindow.APPL ( <parameters> -- )
  378.     BEGIN
  379.         get.num.parameter
  380.     WHILE
  381.         tolower
  382.         CASE
  383.         ascii x OF dup -> fw_init_x ENDOF
  384.         ascii y OF dup -> fw_init_y ENDOF
  385.         ascii f OF dup -> fw_fore_color ENDOF
  386.         ascii b OF dup -> fw_back_color ENDOF
  387.         dup emit ." is unrecognized!" cr
  388.         ENDCASE
  389.         drop
  390.     REPEAT
  391.     fw.message
  392.     FindWindow
  393. ;
  394.  
  395. if.forgotten fw.term
  396.  
  397. cr ." CLONE FINDWINDOW.APPL" cr
  398.