2008-07-15 - [Stu]
<<br>>
A quick slide show program based on the ideas in [Runnable Images].
<<br>>
How to use:
======
usage:
$ ./qss.tcl                                                                         
no images given
usage: qss [-o outfile] image ...

view images:
$ ./qss.tcl *.gif

create and view a slide show:
$ ./qss.tcl -o myslideshow *.gif
$ chmod u+x myslideshow
$ ./myslideshow

output is program!

view some other images
./myslideshow images/*.gif

create and view another slide show:
./myslideshow -o anotherlideshow images/*.gif
$ chmod u+x anotherlideshow
$ ./anotherlideshow

$ ./anotherslideshow -o bobslideshow bob/images/*.gif
$ chmod u+x bobslideshow
$ ./boblideshow

And so on ...
======

======
#! /bin/sh
# \
exec tclsh8.5 "$0" ${1+"$@"}

# Quick Slide Show
# Stuart Cassoff
# July 2008


namespace eval qss {
	variable cfg
	set cfg(currImage) -1
	set cfg(maxImage) -1
}

proc qss::adjustGUI {} {
	variable cfg
	$cfg(bp) configure -state [expr {$cfg(currImage) > 0 ? "active" : "disabled"}]
	$cfg(bn) configure -state [expr {$cfg(currImage) < $cfg(maxImage) ? "active" : "disabled"}]
	$cfg(txtLabel) configure -text "[expr {$cfg(currImage) + 1}] of [expr {$cfg(maxImage) + 1}]"
}

proc qss::prev {} {
	variable cfg
	$cfg(imgLabel) configure -image im[incr cfg(currImage) -1]
	adjustGUI
}

proc qss::next {} {
	variable cfg
	$cfg(imgLabel) configure -image im[incr cfg(currImage)]
	adjustGUI
}

proc qss::setupGUI {} {
	variable cfg
	grid [set cfg(bp) [button .bp -text < -command [namespace current]::prev]] -sticky w
	grid ^ [set cfg(bn) [button .bn -text > -command [namespace current]::next]] -sticky w
	grid ^ ^ [set cfg(txtLabel) [label .lt]] -sticky w
	grid [set cfg(imgLabel) [label .li]] -columnspan 3
	grid columnconfigure . 2 -weight 1
	bind . <Escape> exit
	bind . <Control-q> exit
}

proc qss::addImage {data} {
	variable cfg
	image create photo im[incr cfg(maxImage)] -data $data
}

proc qss::go {} {
	variable cfg
	setupGUI
	if {$cfg(maxImage) > -1} {
		set cfg(currImage) 0
		$cfg(imgLabel) configure -image im$cfg(currImage)
	}
	adjustGUI
}


proc readFile {fn} {
	set f [open $fn]
	fconfigure $f -translation binary
	return [read $f][close $f]
}

proc loadImagesFromFiles {toload} {
	variable cfg
	foreach fn $toload {
		::qss::addImage [readFile $fn]
	}
}

proc loadImagesFromMe {sizes} {
	set f [open $::argv0]
	fconfigure $f -eofchar \x1a
	read $f
	seek $f 1 current
	fconfigure $f -translation binary
	foreach size $sizes {
		set d [read $f $size]
		::qss::addImage $d
	}
	close $f
}

proc makeQss {outfile images} {
	set licmd "set sizes { "
	foreach img $images {
		append licmd [file size $img] " "
	}
	append licmd "}"

	set embed [readFile $::argv0]
	set final [string map [list "set sizes {}" $licmd] $embed]

	set f [open $outfile w]
	fconfigure $f -translation binary
	puts $f $final
	puts -nonewline $f \x1a
	foreach img $images {
		set fimg [open $img r]
		fconfigure $fimg -translation binary
		fcopy $fimg $f
		close $fimg
	}
	close $f
}

proc go {} {
	set argv $::argv
	set sizes {}

	if {[llength $sizes] == 0 && [llength $argv] == 0} {
		puts stderr "no images given"
		puts stderr {usage: qss [-o outfile] image ...}
		exit 1
	}

	if {[lindex $argv 0] eq "-o"} {
		if {[llength $argv] < 2} {
			puts stderr "outfile not given"
			exit 1
		}
		if {[llength $argv] < 3} {
			puts stderr "no images given"
			exit 1
		}
		makeQss [lindex $argv 1] [lrange $argv 2 end]
		exit 0
	}

	package require Tk

	if {[llength $argv] > 0} {
		loadImagesFromFiles $argv
	} else {
		loadImagesFromMe $sizes
	}

	::qss::go
}

go


# EOF
======

----
!!!!!!
%| Images Tk Embedding | [Category Scripted Document] |%
!!!!!!