2008-07-15 - [Stu]
<<br>>
A quick slide show program based on the idea in [Runnable Images].
<<br>>
<<br>>
How to use:
======
Usage:

$ ./qss.tcl									 
Quick Slide Show
usage: qss.tcl [-o outfile] image ...
no images given

$ ./qss.tcl -?
Quick Slide Show
usage: qss.tcl [-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!


Usage:

$ ./myslideshow -?
Quick Slide Show
usage: myslideshow [-o outfile] image ...


View some other images:

./myslideshow images/*.gif


Create and view another slide show:

./myslideshow -o anotherslideshow images/*.ppm
$ chmod u+x anotherslideshow
$ ./anotherslideshow

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

$ ./bobslideshow -?
Quick Slide Show
usage: bobslideshow [-o outfile] image ...


And so on ...
======
The code!
======
#! /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 {bin 1}} {
	set f [open $fn]
	if {$bin} {
		fconfigure $f -translation binary
	} else {
		fconfigure $f -eofchar \x1a
	}
	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 final [string map [list "set sizes {}" $licmd] [readFile $::argv0 0]]
	set f [open $outfile w]
	puts $f $final
	fconfigure $f -translation binary
	puts -nonewline $f \x1a
	foreach img $images {
		set fimg [open $img]
		fconfigure $fimg -translation binary
		fcopy $fimg $f
		close $fimg
	}
	close $f
}

proc ciao {msg {code 1}} {
	puts stderr "Quick Slide Show"
	puts stderr "usage: [file tail $::argv0] \[-o outfile\] image ..."
	if {$msg ne ""} {
		puts stderr $msg
	}
	exit $code
}

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

	if {[llength $sizes] == 0 && [llength $argv] == 0} {
		ciao "no images given"
	}
	if {[lindex $argv 0] eq "-?"} {
		ciao "" 0
	}
	if {[lindex $argv 0] eq "-o"} {
		if {[llength $argv] < 2} {
			ciao "outfile not given"
		}
		if {[llength $argv] < 3} {
			ciao "no images given"
		}
		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] |%
!!!!!!