/*
*    Workbench Pattern Injector
*
*          September 1995
*
*    Public Domain by Chad Randall
*                     mbissaymssiK Software
*                     crandall@msen.com
*                     http://www.msen.com/~crandall
*
*    No warranty is given for the stability of this program.
*
*
*    Usage:
*
*      CLI:  wbpi source (dest=env:sys/wbpattern.prefs) w|wb|s
*
*       WB:  As a default tool (or shift-clicked tool) from a project icon:
*            WINDOWS|WORKBENCH|SCREEN tooltypes specify what to copy (located in PROJECT icon)
*              (requests (EZREQ) what to copy, if no tooltype is present!)
*
*            ACTIONSAVE  tooltype saves to envarc, to make changes PERMANENT.
*
*/

/* Best viewed with a TAB setting of 2 */

/* Requires E typed modules by Jason R. Hulance to compile */

MODULE 'exec/nodes','exec/ports','exec/types','exec/memory'
MODULE	'iffparse','libraries/iffparse'
MODULE	'exec/tasks'
MODULE	'asl'
MODULE	'wb','workbench/startup','workbench/workbench'
MODULE	'icon'
MODULE	'dos/dosextens','dos/dos'
MODULE	'prefs/prefhdr','prefs/wbpattern','prefs/font'
MODULE	'graphics/rastport'

MODULE	'mod/filenames'	-> my custom module, with some filename handling routines.

DEF data[4]:LIST			-> Pointer to wbpatternprefs structures
DEF datasize[4]:LIST	-> size of struct

PROC main() HANDLE
	DEF args[10]:LIST 					-> cli argument array
	DEF i												-> loop counter
	DEF rdarg=0							 		-> ptr to readargs struct

	DEF use_wb=FALSE,use_win=FALSE,use_scr=FALSE

	DEF fh=0
	DEF iff=0:PTR TO iffhandle

	DEF errorstring[1000]:STRING-> A dos error string buffer
	DEF namestr[500]:STRING			-> Our CLI task name.
	DEF str[1000]:STRING				-> A general string storage
	DEF task:PTR TO process			-> Our task/process structure, in case GetProgramName() fails.
	DEF source[1000]:STRING			-> Source file
	DEF dest[1000]:STRING				-> Destination file (defaults to "env:sys/wbpattern.prefs"

	DEF olddir
	DEF fh2=0
	DEF wb:PTR TO wbstartup
	DEF wbargs:PTR TO wbarg
	DEF projicon=0:PTR TO diskobject
	DEF dir[500]:STRING
	DEF file[500]:STRING
	DEF name[1000]:STRING
	DEF ezres
	DEF saveenvarc=FALSE

	DEF fontcolor=-1
	DEF fontbackground=-1
	DEF drawmode=-1

	IF (KickVersion(39)=0) THEN Raise("KICK")
	IF ((aslbase:=OpenLibrary('asl.library',36))=0) THEN Raise("LIB")
	IF ((iconbase:=OpenLibrary('icon.library',36))=0) THEN Raise("LIB")
	IF ((iffparsebase:=OpenLibrary('iffparse.library',36))=0) THEN Raise("LIB")

	StrCopy(dest,'env:sys/wbpattern.prefs')	->get dest (default)
	IF wbmessage
		wb:=wbmessage
		wbargs:=wb.arglist
		IF (wb.numargs<2) THEN Raise("wbar")		-> REQUIRES at least one project icon!
		collectchunks(dest,TRUE,TRUE,TRUE)
		FOR i:=2 TO wb.numargs
			wbargs:=wbargs+SIZEOF wbarg
			olddir:=CurrentDir(wbargs.lock)	-> Changes to our tool directory
			GetCurrentDirName(dir,490)
			CurrentDir(olddir)						-> Changes back to the original dir, for petes sake!
			eaddpart(dir,wbargs.name,490)
			IF ((fh2:=Lock(dir,ACCESS_READ))=0) THEN Raise("DOS")
			UnLock(fh2)
			IF (projicon:=GetDiskObject(dir))
				use_wb:=FALSE
				use_win:=FALSE
				use_scr:=FALSE
				IF (FindToolType(projicon.tooltypes,'WORKBENCH')) THEN use_wb:=TRUE
				IF (FindToolType(projicon.tooltypes,'WINDOWS')) THEN use_win:=TRUE
				IF (FindToolType(projicon.tooltypes,'SCREEN')) THEN use_scr:=TRUE
				IF (FindToolType(projicon.tooltypes,'ACTIONSAVE')) THEN saveenvarc:=TRUE

				fontcolor:=toolvalue(projicon.tooltypes,'FONT_COLOR',fontcolor)
				fontbackground:=toolvalue(projicon.tooltypes,'FONT_BACKGROUND',fontbackground)

				IF (FindToolType(projicon.tooltypes,'TEXTONLY')) THEN drawmode:=RP_JAM1
				IF (FindToolType(projicon.tooltypes,'TEXTBACK')) THEN drawmode:=RP_JAM2
				IF (FindToolType(projicon.tooltypes,'COMPLEMENT')) THEN drawmode:=RP_COMPLEMENT
				IF (FindToolType(projicon.tooltypes,'INVERSVID'))
					IF (drawmode>=0) THEN drawmode:=(drawmode OR RP_INVERSVID)
				ENDIF

				FreeDiskObject(projicon)
			ENDIF
			IF ((use_wb OR use_win OR use_scr)=FALSE)
				ezres:=EasyRequestArgs(0,[20,0,'WBPI','Use which field?','Workbench|Windows|Screen|Cancel'],0,0)
				SELECT ezres
				CASE 3;use_scr:=TRUE
				CASE 1;use_wb:=TRUE
				CASE 2;use_win:=TRUE
				CASE 0;Raise(0)
				ENDSELECT
			ENDIF
			collectchunks(dir,use_wb,use_win,use_scr)
		ENDFOR
	ELSE
		FOR i:=0 TO 9;args[i]:=0;ENDFOR
		task:=FindTask(0)
		GetProgramName(namestr,490)	-> Get our process name, from the CLI handle.
		IF StrLen(namestr)=0 THEN StrCopy(namestr,task.task.ln.name)	-> Task name, in case above failed
		rdarg:=ReadArgs('FROM/A,TO,WB=WORKBENCH/S,W=WINDOWS/S,S=SCREEN/S',args,0)
		IF rdarg=0 THEN Raise("DOS")
		StrCopy(source,args[0])									->get source
		IF (args[1]) THEN StrCopy(dest,args[1])	->get dest (user)
		IF (args[2]) THEN use_wb:=TRUE
		IF (args[3]) THEN use_win:=TRUE
		IF (args[4]) THEN use_scr:=TRUE
		IF ((args[2] OR args[3] OR args[4])=FALSE) THEN Raise(ERROR_BAD_TEMPLATE)
		IF ((args[2] AND args[3] AND args[4])=TRUE) THEN Raise(ERROR_BAD_TEMPLATE)
		collectchunks(source,use_wb,use_win,use_scr)
		collectchunks(dest,Not(use_wb),Not(use_win),Not(use_scr))
	ENDIF
	IF ((data[WBP_ROOT]=0) OR
		(data[WBP_DRAWER]=0) OR
		(data[WBP_SCREEN]=0)) THEN Raise("2few")
	IF ((fontcolor>=0) OR (fontbackground>=0) OR (drawmode>=0))
		injectfont('ENV:sys/font.prefs',fontcolor,fontbackground,drawmode)
		IF (saveenvarc)
			injectfont('ENVARC:sys/font.prefs',fontcolor,fontbackground,drawmode)
		ENDIF
	ENDIF
	FOR i:=0 TO IF saveenvarc THEN 1 ELSE 0
		IF ((fh:=Open(dest,NEWFILE))=0) THEN Raise("DOS")
		IF ((iff:=AllocIFF())=0) THEN Raise("IFF")
		iff.stream:=fh
		InitIFFasDOS(iff)
		IF (OpenIFF(iff,IFFF_WRITE)) THEN Raise("IFF")
		PushChunk(iff,"PREF","FORM",IFFSIZE_UNKNOWN)
			PushChunk(iff,"PREF","PRHD",6)
				WriteChunkBytes(iff,[0,0]:LONG,6)
			PopChunk(iff)
			FOR i:=0 TO 2
				PushChunk(iff,"PREF","PTRN",datasize[i])
					WriteChunkBytes(iff,data[i],datasize[i])					
				PopChunk(iff)
			ENDFOR
		PopChunk(iff)
		StrCopy(dest,'ENVARC:sys/wbpattern.prefs')
		IF iff THEN CloseIFF(iff)
		IF fh THEN Close(fh);fh:=0
		IF iff THEN FreeIFF(iff);iff:=0
	ENDFOR
			/* Let the cleanup routine close the iff! */
EXCEPT DO
	IF rdarg THEN FreeArgs(rdarg)

	IF iff THEN CloseIFF(iff)
	IF fh THEN Close(fh)
	IF iff THEN FreeIFF(iff)

	SELECT exception
	CASE 0;NOP
	CASE "2few";err('not enough data')
	CASE "wbar";err('WBPI cannot be run alone.\n\nPass icons by shift clicking first.')
	CASE "KICK";err('Sorry.  WBPI requires OS3.0 or greater.')
	CASE "LIB";err('library failed to open')
	CASE "MEM";err('out of memory')
	CASE "IFF";err('iffparse error')
	CASE "DOS"
		IF wbmessage THEN StrCopy(str,'Dos Error:\n')
		StrAdd(str,namestr)
		Fault(IoErr(),str,errorstring,998)
		err(errorstring)
	DEFAULT;
		IF wbmessage THEN StrCopy(str,'Dos Error:\n')
		StrAdd(str,namestr)
		Fault(exception,str,errorstring,998)
		err(errorstring)
	ENDSELECT
	IF aslbase THEN CloseLibrary(aslbase)
	IF iffparsebase THEN CloseLibrary(iffparsebase)
	IF iconbase THEN CloseLibrary(iconbase)
ENDPROC

PROC toolvalue(tooltypes,tooltypestring,default=0)
	DEF s
	IF (s:=FindToolType(tooltypes,tooltypestring)) THEN StrToLong(s,{default})
ENDPROC default

PROC collectchunks(name,usewb,usewin,usescr) HANDLE
	DEF iff=0:PTR TO iffhandle
	DEF ci=0:PTR TO collectionitem
	DEF fh=0
	DEF wbpp:PTR TO wbpatternprefs
	DEF which

	IF ((fh:=Open(name,OLDFILE))=0) THEN Raise("DOS")
	IF ((iff:=AllocIFF())=0) THEN Raise("IFF")
	iff.stream:=fh
	InitIFFasDOS(iff)
	IF (OpenIFF(iff,IFFF_READ)) THEN Raise("IFF")
	CollectionChunk(iff,"PREF","PTRN")
	StopOnExit(iff,"PREF","FORM")
	ParseIFF(iff,IFFPARSE_SCAN)
	IF ((ci:=FindCollection(iff,"PREF","PTRN"))=0) THEN Raise("IFF")
	REPEAT
		wbpp:=ci.data
		which:=wbpp.which
		IF (((which=WBP_ROOT) AND (usewb)) OR
				((which=WBP_DRAWER) AND (usewin)) OR
				((which=WBP_SCREEN) AND (usescr)))
			data[which]:=New(ci.size)				-> E will automatically free these for us, so no Dispose()...
			CopyMem(ci.data,data[which],ci.size)
			datasize[which]:=ci.size
		ENDIF
		ci:=ci.next
	UNTIL ci=0
EXCEPT DO
	IF iff THEN CloseIFF(iff)
	IF fh THEN Close(fh)
	IF iff THEN FreeIFF(iff)
	ReThrow()
ENDPROC

PROC err(msgptr)
	IF ((aslbase<>0) AND (wbmessage))
 		EasyRequestArgs(0,[20,0,'Error!',msgptr,'Okay'],0,0)
	ELSE
		WriteF('\s\n',msgptr)
	ENDIF
ENDPROC

PROC injectfont(name,c1,c2,d1) HANDLE
	DEF iff=0:PTR TO iffhandle
	DEF ci=0:PTR TO collectionitem
	DEF fh=0
	DEF which
	DEF font[4]:LIST
	DEF fontsize[4]:LIST
	DEF fontpref:PTR TO fontprefs
	DEF i

	IF ((fh:=Open('ENV:sys/font.prefs',OLDFILE))=0) THEN Raise("DOS")
	IF ((iff:=AllocIFF())=0) THEN Raise("IFF")
	iff.stream:=fh
	InitIFFasDOS(iff)
	IF (OpenIFF(iff,IFFF_READ)) THEN Raise("IFF")
	CollectionChunk(iff,"PREF","FONT")
	StopOnExit(iff,"PREF","FORM")
	ParseIFF(iff,IFFPARSE_SCAN)
	IF ((ci:=FindCollection(iff,ID_PREF,"FONT"))=0) THEN Raise("IFF")
	REPEAT
		fontpref:=ci.data
		which:=fontpref.type
		IF (((which=FP_WBFONT)) OR
				((which=FP_SYSFONT)) OR
				((which=FP_SCREENFONT)))
			font[which]:=New(ci.size)				-> E will automatically free these for us, so no Dispose()...
			CopyMem(ci.data,font[which],ci.size)
			fontsize[which]:=ci.size
		ENDIF
		ci:=ci.next
	UNTIL ci=0
	CloseIFF(iff)
	Close(fh)
	FreeIFF(iff)

	fontpref:=font[FP_WBFONT]
	IF (fontpref=0) THEN Raise("22")
	IF (c1>=0) THEN fontpref.frontpen:=c1
	IF (c2>=0) THEN fontpref.backpen:=c2
	IF (d1>=0) THEN fontpref.drawmode:=d1

	IF ((fh:=Open(name,NEWFILE))=0) THEN Raise("DOS")
	IF ((iff:=AllocIFF())=0) THEN Raise("IFF")
	iff.stream:=fh
	InitIFFasDOS(iff)
	IF (OpenIFF(iff,IFFF_WRITE)) THEN Raise("IFF")
	PushChunk(iff,"PREF","FORM",IFFSIZE_UNKNOWN)
		PushChunk(iff,"PREF","PRHD",6)
			WriteChunkBytes(iff,[0,0]:LONG,6)
		PopChunk(iff)
		FOR i:=0 TO 2
			PushChunk(iff,"PREF","FONT",fontsize[i])
				WriteChunkBytes(iff,font[i],fontsize[i])					
			PopChunk(iff)
		ENDFOR
	PopChunk(iff)
EXCEPT DO
	IF iff THEN CloseIFF(iff)
	IF fh THEN Close(fh)
	IF iff THEN FreeIFF(iff)
	ReThrow()
ENDPROC

ver:
CHAR	0,0,'$VER: wbpi 1.2 (29.9.95)',10,13,0,0