\ $VER: FloatIcon.f 1.05 (19 Jan 1992 23:07)(07 Jan 1992 21:19)
\ Program to release several icons simultaneously so that WorkBench will
\ handle their placement in a drawer window.
\ Written in JForth Professional 2.0
\
\ (c) Copyright 1989, 1990, 1992 by Richard Mazzarisi.
\  All rights reserved.
\
\ address:
\	891 Post St. #207
\	San Francisco, CA
\	94109
\
\ email:
\	rich@californium.cchem.berkeley.edu
\	rmazz@hydrogen.cchem.berkeley.edu
\
\
\ v. 1.00 10/9/89
\ v. 1.01 2/3/90   fixed the path name for drawers, WB gives you the name
\			with a '/' at the end which must be removed whereas
\			Jazzbench does not
\ v. 1.02 3/22/90  fixed bug in 'remove.final.slash' was 2DROP changed to DROP
\	  3/23/90  fixed problem similar to '/' with ':' on device icons
\ v. 1.03 5/20/90  fixed the ability to find the font size and use this info
\			in opening the window
\ v. 1.04 1/1/92   fixed once and for all the finding of the font size
\	  1/7/92   put all icontools common stuff into icontools.f
\	  1/9/92   fixed typo in comment and error message
\	  1/13/92  moved the resource management routines to IconTools.f
\ v. 1.05 1/19/92  recompiled with new IconTools.f (cf)
\
\ Instructions:
\ 1 - Click on the icon for this program.
\ 2 - Shift click on all icons to be floated.
\
\ (NOTE: The author assumes no responsibility for any damages
\ resulting from the use of this program.)


INCLUDE? TASK-ICONTOOLS ICONTOOLS.F


ANEW task-floaticon

DECIMAL


\ *** main window stuff ***

: open.ft-window      ( -- window/null )
	getWBscreendata
	it-newwindow NEWWINDOW.SETUP
	20 16 set.vert-params
	it-newwindow ..! nw_Height
	it-newwindow ..! nw_TopEdge
	20 52 set.horiz-params
	it-newwindow ..! nw_Width
	it-newwindow ..! nw_LeftEdge
	0" FloatIcon  1.05" >ABS it-newwindow ..! nw_Title
	CLOSEWINDOW it-newwindow ..! nw_IDCMPFlags
	WINDOWCLOSE WINDOWDRAG | WINDOWDEPTH | WINDOWSIZING | ACTIVATE |
		it-newwindow ..! nw_Flags
	it-newwindow GR.OPENCURW
;


\ *** support ***

: ft.greeting	( -- )
	" Release icons to be freely placed by Workbench." con.write.itl con.cr
	" © Copyright by Richard Mazzarisi 1989, 1990, 1992" con.write.c3 con.cr
	"          All rights reserved." con.write.c3 con.cr
	"      Written in JForth Professional 2.0." con.write.c3 con.cr con.cr
;


: prt.ft-instr	( -- )
	" Instructions:"  con.write con.cr
	" 1 - Click on the icon for this program."  con.write con.cr
	" 2 - Shift click on all the icons to be floated."  con.write con.cr
	con.cr
	" (NOTE: The author assumes no responsibility for any"
	con.write con.cr
	" damages resulting from the use of this program.)" con.write con.cr
;


: float.it	( -- )
	PAD $it.get-icon
[ clone-it @ ] .IF
	SET-NO-POSITION
	PAD $it.save-icon
.ELSE
\ don't really do it if we are testing things in the interpreter
	it.abort-icon
.THEN
;


: float.one	{ wbarg -- }
	\ get file's path name
	wbarg get.full-path IF
		"   " con.write
		PAD con.write con.cr
		float.it
	ELSE
		" ERROR: Could not get path for icon:" con.write.itl con.cr
		"   " con.write
		wreq @ wbarg ..@ wa_Name >REL ConPutStr() con.cr
	THEN
;


: do.floats	{ #args -- }
        " Click closebox to abort."  con.write con.cr con.cr
        " Floating..." con.write con.cr
        \ get pointer to args
	WBMESSAGE @ >REL ..@ sm_ArgList >REL
	\ 2nd and on are the icons to be floated
	#args 1+  1  DO
		DUP  SizeOf() WBArg  I *  +
		float.one
		\ check for stop action
		?CLOSEBOX IF LEAVE THEN
	LOOP
	DROP
	con.cr " Done.  " con.write.itl
;


\ *** main ***

: floaticon   ( -- )
	' prt.ft-instr IS prt.it-instr
	' open.ft-window IS open.it-window
	open.it-things
	cursor.off
	ft.greeting
	check.WB
	2 check.num.args IF
		do.floats
	THEN
	close.it-things
;


: ft
	floaticon
;


clone-it @ .IF

initclone
clone ft
save-image FloatIcon FloatIcon -icon

.THEN

CR CR ." Type 'ft' to run." CR CR