# TslcLibs.tcl --
#
#	Creates compressed files with hashed file names for resourcing
#	into binary executable. Generates complimentary rc file for
#	processing by a resource compiler. The res file can then be linked
#	into exe or dll eliminating the need for script files to be located
#	in file system.
#
# Copyright (c) 1996 - 1998, William Byrne
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

if {[string compare $tcl_platform(platform) windows] != 0} {
	error "TslcLibs.tcl written for Windows only!"
}

if ![info exists tslc_library] {
	puts stderr "TslcLibs.tcl intended to be run within the scope of Tslc distribution.\n\t could not find *tslc_library*"
}

package require TslcCompress 1.0
package require TslcUtility 1.0

if ![info exists tslc_pad] {
	proc Status { args } {}
}

proc CompressScripts { srcBase dstBase srcPath dstPath params} {
	# make "p" reference the array "params" located up one stack frame, the calling procedure
	upvar $params p

	# determine if there's a filter for unwanted directories
	if [info exists p(dirFilter)] {
		set dirFilter $p(dirFilter)
	} else {
		set dirFilter {}
	}

	# determine if there's a file type filter
	if [info exists p(fileTypeFilter)] {
		set fileTypeFilter $p(fileTypeFilter)
	} else {
		set fileTypeFilter {}
	}

	# determine if there's a maximum allowable file size
	if [info exists p(maxSize)] {
		set maxSize $p(maxSize)
	} else {
		set maxSize 0
	}

	# determine if subdirectories should be processed
	if [info exists p(subDir)] {
		set subDir $p(subDir)
	} else {
		set subDir 0
	}

	# determine if only directories should be scanned
	if [info exists p(dirOnly)] {
		set dirOnly $p(dirOnly)
	} else {
		set dirOnly 0
	}

	# determine if info should be *put*
	if [info exists p(verbose)] {
		set verbose $p(verbose)
	} else {
		set verbose 1
	}

	# determine if a prefix has been set for resource identifiers
	if [info exists p(prefix)] {
		set prefix $p(prefix)
	} else {
		set prefix {}
	}

	# determine resource script file handle
	if [info exists p(rcFile)] {
		set rcFile $p(rcFile)
	} else {
		set rcFile -1
	}

	# determine if testing
	if [info exists p(test)] {
		set test $p(test)
	} else {
		set test 0
	}

	# determine if a file list is needed
	if [info exists p(fileList)] {
		set fileList $p(fileList)
	} else {
		set fileList -1
	}

	# start processing...

	if $test {
		puts "************ TESTING ***************"
	}

	if $verbose { 
		puts "Reading $srcBase/$srcPath"
	} elseif $test {
		puts "**** Testing without verbosity ****"
	}

	# get list of files in srcPath
	set lst [glob -nocomplain [file join $srcBase $srcPath *]]
	set cnt [llength $lst]

	if $verbose {
	 	puts "\tFound [llength $lst] file(s) in directory \"[file join $srcBase $srcPath]\""
	}

	# make target directory if it doesn't exists
	if ![file exists $dstBase] {
		if $verbose {
			puts "******* Making Directory $dstBase *********"
		}
		if !$test {
			file mkdir $dstBase
		}
	}


	# Hash base directory into file list
	set dir [string toupper [file join $srcPath .]]
	set h [TslcUtility::Hash $dir]

	if $verbose {
		puts "\tHash Value: $h --> $dir"
	}
				

	# output to file list if valid handle
	if { $fileList != -1 } {
		puts $fileList [string toupper "/$dir=$prefix$h"]
	}

	# iterate through file list *lst*
	set iter 0
	foreach f $lst {
		incr iter

		# progress indicator found in ScriptPad Application
		Status $f -p[expr ($iter * 100) / $cnt]

		# get last file element in path
		set t [string tolower [file tail $f]]

		# scan for unwanted directories
		if [file isdirectory $f] {
			set ok $subDir
			foreach d $dirFilter  {
				if [string match $t [string tolower $d]] {
					set ok 0
					break
				}
			}
			if !$ok continue


			if $verbose {
				puts "\tRecursing subdirectory [file join $srcPath $t]"
			}

			# Process subdirectory using recursion
			CompressScripts $srcBase $dstBase [file join $srcPath $t] [file join $dstPath $t] p

		# not a directory, process file
		} elseif !$dirOnly {	
	
			# get file type determined by extension
			set ext [file extension $t]

			# determine if this file type can be processed
			set ok 1
			foreach e $fileTypeFilter {
				if [string match $e $ext] {
					set ok 0
					break;
				}
			}
			if !$ok continue


			if { $maxSize > 0 && [file size $f] > $maxSize} {
				if $verbose {
					puts "Skipping $f - File Size: [file size $f] exceeds max: $maxSize"
				}
			} else {
				if $verbose {
					puts "Copying $f to $dstBase"
				}

				# progress indicator found in ScriptPad Application
				Status "$f (copying)"

				# set up filename for target
				set dest [file join $dstPath [file tail $f]]

				# get hash value of filename in native os form.
				# toupper since case doesn't matter in windows and references to the same file
				# in client scripts may or may not consider the formal case of the desired file.
				set h [TslcUtility::Hash [string toupper [file nativename $dest]]]

				if $verbose {
					puts "\tHash Value: $h --> $dest"
				}
				

				# set targets hash filename that will be used as resource name
				set destHash [file join $dstBase $h]

				# output to file list if valid handle
				if { $fileList != -1 } {
					puts $fileList [string toupper "/$dest=$prefix$h"]
				}

				# Compress the file using ZLib with high compression ratio.
				# Pass filename arguments in native os format
				if !$test {
					TslcCompress::Deflate -c9 [file nativename $f] [file nativename $destHash]
				}

				# write info to resource script file to be later processed by a resource
				# compiler such as BRCC32
				if { !$test && $rcFile != -1} {
					puts $rcFile "$prefix$h \tRCDATA \t$destHash"
				}
			}
		}
	}
}


proc CompressFilelist { src dst params } {

	# make "p" reference the array "params" located up one stack frame, the calling procedure
	upvar $params p


	# determine resource script file handle
	if [info exists p(rcFile)] {
		set rcFile $p(rcFile)
	} else {
		set rcFile -1
	}

	# determine if testing
	if [info exists p(test)] {
		set test $p(test)
	} else {
		set test 0
	}

	# determine if a prefix has been set for resource identifiers
	if [info exists p(prefix)] {
		set prefix $p(prefix)
	} else {
		set prefix {}
	}


	# Compress the file using ZLib with high compression ratio.
	# Pass filename arguments in native os format
	
	if { !$test && $rcFile != -1 } {

		TslcCompress::Deflate -c9 $src $dst
	
		# write info to resource script file to be later processed by a resource
		# compiler such as BRCC32
		set h FILELIST
		puts $rcFile "$prefix$h \tRCDATA \t$dst"
	}

}


#
# Setup the parameters to be passed to CompressScripts
#

# Determine the *ext* directory created by Tslc1.0 distribution installation.
# Specifies the location of the resource script file; can be any writable directory

set pathlist [file split $tslc_library]
set ext {}
for {set x 0} {$x < [llength $pathlist] - 2} {incr x} {
	set ext [file join $ext [lindex $pathlist $x]]
}


# get the root directory for the Tcl/Tk libraries. If a Tcl distribution was not
# installed, there's a good chance this directory won't exist.

set pathlist [file split $tcl_library]
set root {}
for {set x 0} {$x < [llength $pathlist] - 2} {incr x} {
	set root [file join $root [lindex $pathlist $x]]
}


# set the location of the Tix libraries. Tix distribution must be installed
set tixpath /_code
set rsrcpath /_tslc.res


# open a file handle for the resource script file
set f [open $ext/TslcLibs.rc w]
puts "Resource File: $ext/TslcLibs.rc"

# open a file handle for the file list
set filelist "$ext/FILELIST" 
set l [open $filelist w]
puts "Filelist File: $filelist"

# set up parameter array that will be parsed by CompressScripts
set CompParams(dirFilter) demos
set CompParams(fileTypeFilter) {}
set CompParams(maxSize) 0
set CompParams(subDir) 1
set CompParams(dirOnly) 0
set CompParams(verbose) 1
set CompParams(prefix) TSLC_
set CompParams(rcFile) $f
set CompParams(test) 0
set CompParams(fileList) $l


set root "d:/program files/tcl"
# perform script compression in an exception block
if [catch {
if 1 {
	CompressScripts $root/lib $rsrcpath  tcl8.0 tcl8.0 CompParams
	CompressScripts $root/lib $rsrcpath  tk8.0 tk8.0 CompParams
	if [info exists tixpath] {
		CompressScripts $tixpath  $rsrcpath  tix4.1.0/library tix4.1 CompParams
	}
}
	# close the file list 
	close $l

	CompressFilelist $filelist "$rsrcpath/FILELIST" CompParams


} msg] {
	catch { puts "$msg $errorInfo" }
}
close $f

