\ $VER: ReplaceImage.f 1.01 (19 Jan 1992 23:33)
\ Program to change the image of a number icons simultaneously,
\   using the Workbench and Intuition.
\ Written in JForth Professional 2.0
\
\ (c) Copyright 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
\	nmr@garnet.berkeley.edu
\
\
\ v. 1.00 1/12/92
\	  1/13/92  moved the resource management routines to IconTools.f
\	  1/14/92  whoops, forgot to release the first icon when done!
\ v. 1.01 1/19/92  moved window down so that requester will not obscure the
\			name of the image to be used if a large screen
\			font is used
\                  recompiled with new IconTools.f (cf)
\
\ Instructions:
\ 1 - Click on the icon for this program.
\ 2 - Shift click on the icon which will supply its image to the others.
\ 3 - shift click on the icons which are to get the image from the first icon.
\
\ (NOTE: The author assumes no responsibility for any damages
\ resulting from the use of this program.)


INCLUDE? TASK-ICONTOOLS ICONTOOLS.F


ANEW task-replaceimage

DECIMAL


\ *** variables ***

VARIABLE repl-icon
VARIABLE repl-gadget
VARIABLE repl-strings	\ need to save these even tho we don't use 'em


\ *** main window stuff ***

: open.ri-window	( -- window/null )
	getWBscreendata
	it-newwindow NEWWINDOW.SETUP
	45 18 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" ReplaceImage  1.01" >ABS it-newwindow ..! nw_Title
	CLOSEWINDOW it-newwindow ..! nw_IDCMPFlags
	WINDOWCLOSE WINDOWDRAG | WINDOWDEPTH | WINDOWSIZING | ACTIVATE |
		it-newwindow ..! nw_Flags
	it-newwindow GR.OPENCURW
;


\ *** support ***

: ri.greeting		( -- )
	" Replace the Image of Icons." con.write.itl con.cr
	" © Copyright by Richard Mazzarisi 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.ri-instr		( -- )
	" Instructions:"  con.write con.cr
	" 1 - Click on the icon for this program."  con.write con.cr
	" 2 - Shift click on the icon which will supply its"  con.write con.cr
	"     image to the others."  con.write con.cr
	" 3 - shift click on the icons which are to get the"  con.write con.cr
	"     image from the first icon."  con.write 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
;


: copy.gadget		( -- )
\ replaces the whole gadget structure
	PAD $it.get-icon
	repl-gadget @  theIcon @ .. do_Gadget  SizeOf() Gadget  CMOVE
[ clone-it @ ] .IF
	PAD $it.save-icon
.ELSE
\ don't really do it if we are testing things in the interpreter
	it.abort-icon
.THEN
;


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


: replace.images	( wb-arg #args -- )
	\ go thru icons to be changed
	" Replacing the Image for:" con.write con.cr
	\ 3rd and on are the icons to work on
	1+  2  DO
                DUP  SizeOf() WBArg  I *  +
                replace.one
		\ check for stop action
		?CLOSEBOX IF LEAVE THEN
	LOOP
	DROP
	con.cr " Done.  " con.write.itl
;


: verify.path		( -- t/f )
\ verify with user that the replacement is OK
	" Image to be used will be: " con.write con.cr
	"    " con.write
	PAD con.write con.cr con.cr
	" Is the replacement OK to use?"
	" OK, do it!" " No, Cancel" $it.auto.request IF
		" Click closebox to abort."  con.write
		con.cr con.cr
		TRUE
	ELSE
		" Cancelled!" con.write.itl con.cr
		FALSE
	THEN
;


: get.replacement-image	{ wb-arg -- t/f }
	wb-arg  SizeOf() WBArg  +
	get.full-path IF
		verify.path DUP IF
			PAD $it.get-icon
			theIcon @  DUP repl-icon !
			.. do_Gadget  repl-gadget !
			theStrings @  repl-strings !
			theIcon OFF
		THEN
	ELSE
		" ERROR getting path for the replacement image: " con.write.itl
		wreq @	wb-arg ..@ wa_Name >REL
		ConPutStr() con.cr
		FALSE
 	THEN
;


: release.repl-icon	( -- )
	repl-icon @ theIcon !
	repl-strings @ theStrings !
	it.abort-icon
;


\ *** main ***

: replaceimage		( -- )
	' prt.ri-instr IS prt.it-instr
	' open.ri-window IS open.it-window
	open.it-things
	cursor.off
	ri.greeting
	check.WB
	3 check.num.args IF                                      ( #args )
		\ get pointer to args
		WBMESSAGE @ >REL ..@ sm_ArgList >REL  SWAP       ( wbarg #args )
                \ first one is the replacement image
		OVER get.replacement-image  IF
			replace.images
			release.repl-icon
		ELSE
			2DROP
		THEN
	THEN
	close.it-things
;


: ri
	replaceimage
;


clone-it @ .IF

initclone
clone replaceimage
save-image replaceimage ReplaceImage -icon

.THEN

CR CR ." Type 'ri to run." CR CR