This code implements a quick and dirty image server for tclhttpd. It is was intented to allow hassle free deployment of your digital photos. It runs in 2 modes. Mode 1 shows a table of thumb nails of which you can click on an download the full image. Mode 2 performs a slide show using a JavaScript(cough cough) template. Other features include traversal through catalogs, auto thumbnail generation, and a not completed album file which will include presentation info for the current catalog being viewed. This code is only tested on an Windows XP machine. Place this code in your Document Root/Custom directory. Some modifications will be needed. I'll fix it up later. Oops you need to find a folder image or remove it from the code. Good luck !
# $Id: 4371,v 1.3 2002-10-23 08:01:02 jcw Exp $#
# This is my Tcl http image server.
if { ! [info exists IserverInit] } {
Url_PrefixInstall /images [list ImageServerDomain /images]
set IserverInit 1
}
package require Img
proc ImageServerDomain {prefix sock suffix} {
upvar #0 Httpd$sock data
# fix this kludge
regsub -all {%20} $prefix { } prefix
regsub -all {%20} $suffix { } suffix
global Config
#make prefix relative
regsub {^/} $suffix {} suffix
set fullRelativePath [file join $prefix $suffix] ; # (eg. /image/dirA/dirB/DirC )
regsub {^/} $fullRelativePath {} pfx
set realdir [file join $Config(docRoot) $pfx]
if { ! [file isdirectory $realdir] } {
# it appears that all the images needed to populate a html page all call this
# routine enter this spot here to return image data
Httpd_ReturnFile $sock image/JPEG $realdir
return
}
set title [file tail $realdir]
set usePresentation 0
set srcImages,names {}
set {srcImages,thumbs} {}
set srcImages,titles {}
set sub,dirs {}
# Generate page header
set html "<html><title>Album $title </title>\n"
#--- This is a control file in a album directory
# it has things like a list of files not to display , titles for image, to be defined later...
global album
array set album {skipImages {}}
set albumFile [file join $realdir album]
if { [file exists $albumFile] } {
set f [open $albumFile r]
set Data [read $f]
close $f
foreach line [split $Data \n] {
array set album $line
}
}
set thumbdir [file join $realdir thumbs]
if { ! [file exists $thumbdir] } { file mkdir $thumbdir }
## -- This populates: srcImages,names ; srcImages,titles ; lappend sub,dirs
## -- and created thumbnails if they do not exist
foreach x [glob $realdir/*] {
if { [lsearch $album(skipImages) [file tail $x]] >= 0 } { continue }
if { [string compare [string tolower [file extension $x]] .jpg] == 0 } {
lappend srcImages,names $x
lappend srcImages,titles [file tail $x]
set thumbfile [file join $thumbdir [file tail $x] ]
lappend srcImages,thumbs $thumbfile
if { ! [file exists $thumbfile ] || ( [file mtime $x] > [file mtime $thumbfile] ) } {
set src [image create photo -file $x -format jpeg]
set wi [image width $src]
set he [image height $src]
set dest [image create photo -width 128 -height 128]
$dest copy $src -subsample [expr $wi/128] [expr $he/128]
image del $src
$dest write $thumbfile -format jpeg
image del $dest
}
} elseif { [file isdirectory $x] && [string compare [file tail $x] "thumbs"] != 0 } {
lappend sub,dirs $x
}
}
append html "<dl>"
if { [string compare [file dirname $fullRelativePath] "/"] != 0 } {
append html "<dt><A href=\"[file dirname $fullRelativePath]\"> Back to Last Catalog</A></li>"
}
if { [llength ${srcImages,titles}] >=2 } {
append html "<dt><A href=\"/slide/go?url=$fullRelativePath&files=${srcImages,titles}\" target = 1> Slide show</A></li>"
}
foreach x ${sub,dirs} {
append html "<dt><dd><img src=\"/folder.gif\"> <A href=\"[file join $fullRelativePath [file tail $x]]\"> [file tail $x]</A>"
}
append html "</dl>"
if { [llength ${srcImages,thumbs} ] > 0 } {
append html "<Table border=\"0\" align=\"center\" width=\"100%\"><tbody><tr>"
}
set row 0
set col 1
foreach thumbFile ${srcImages,thumbs} localSrcFileName ${srcImages,names} {
set hrefImg [file join $fullRelativePath [file tail $localSrcFileName] ]
set srcImg [file join $fullRelativePath thumbs [file tail $thumbFile] ]
if { [expr int( fmod( $col,4)) ] == 0 } { append html "</tr><tr>" }
append html "<td><A href=\"$hrefImg\"> <img src=\"$srcImg\"></A></td>"
incr col
}
if { [llength ${srcImages,thumbs} ] > 0 } {
append html "</tr></tbody></Table>"
}
Httpd_ReturnData $sock text/html $html
proc isJpeg afile {
if { [string compare [string tolower [file extension $afile]] ".jpg"] == 0 } {
if { [file exists $afile] } {
return 1
}
}
return 0
}
# $Id: 4371,v 1.3 2002-10-23 08:01:02 jcw Exp $#
if { ! [info exists SlideInit] } {
Direct_Url /slide ::slide::
set SlideInit 1
}
namespace eval ::slide {
variable x [clock format [clock seconds]]
}
# ::hello::/ --
#
# This implements /hello/
proc ::slide::/ {args} {
return "Hello, World!"
}
# ::hello::/ --
#
# This implements /hello/
# Need to pass in the directory name and not the files
# or do a %s encoding of spaces in names when passing in mike vonplinksis files
# put mini pictures in the catalog
# title each picture as it is drawn
# when slide show hits end. the back button needs to be pressed twice
# table for control buttons separate from table from other controls
# somehow put in a toolbarless window
# raise the window if exists already
# verify the javascript
# consider how to obfuscate the code
# fix aspect ratio change of the image
proc ::slide::/go {args} {
variable x
set url [lindex $args 1]
set files [lindex $args 3]
set files [join $files ,]
# regsub -all {,} $files "\",\"http://68.6.44.242:8085$url/" files
# set files \"http://68.6.44.242:8085$url/$files\"
regsub -all {,} $files "\",\"$url/" files
set files \"$url/$files\"
set tmp $::data
regsub -all {theLen} $tmp $files tmp
return $tmp
}
set data {<html>
<head>
<script language="JavaScript">
//# XXX$Id: 4371,v 1.3 2002-10-23 08:01:02 jcw Exp $#
// replace ----
// theLen=
// url=
// baja
//var url="http://68.6.44.242:8085/images/Trips/Baja/";
// PUT THE URL'S OF YOUR IMAGES INTO THIS ARRAY...
//var x=25;
var t1=100;
var t2=4000;
var cur=0;
var drawCnt=0;
var start =1;
var CamDim = new Array('1152', '864');
var CamAspectRatio = CamDim[0]/CamDim[1];
var dispX=450;
var dispY=dispX/CamAspectRatio;
var ImAspectRatio = 1.0;
Slides=new Array(theLen);
//for (var i = 0; i < Slides.length ; i++)
//{
// Slides[i]=url+'baja.'+i+'.jpg';
//}
function SetAspect( im ) {
var x,y,ix,iy;
x = dispX;
y = dispY;
ix=im.width
iy=im.height
ImAspectRatio=ix/iy;
var res = ""
if( CamAspectRatio > ImAspectRatio ) {
x=y*ImAspectRatio
res = "cam>im"
} else if ( CamAspectRatio < ImAspectRatio ) {
y = x/ImAspectRatio;
//res="cam<im"
}
document.images['Screen'].width=x;
document.images['Screen'].height=y;
//window.status="res="+res+x+'/'+y + CamAspectRatio + ImAspectRatio;
}
// Only called by buttons when auto play is not going
function Step( val ) {
var on=0
var off=1
var startB=on
var stopB=on
var endB=on
var nextB=on
var prevB=on
var BeginB=on
drawCnt=drawCnt+val;
if( drawCnt < 0 ) {
drawCnt=0;
startB=on
stopB=off
endB=on
nextB=on
prevB=off
BeginB=off
} else {
if(drawCnt >= Slides.length) {
drawCnt=Slides.length-1;
startB=off
stopB=off
endB=off
nextB=off
prevB=on
BeginB=on
} else {
startB=on
stopB=off
endB=on
nextB=on
prevB=on
BeginB=on
}
}
if ( (typeof Slides[drawCnt] != 'string') ) {
SetAspect(Slides[drawCnt]);
document.images['Screen'].src = Slides[drawCnt].src;
document.SlideShow.text1.value=(1+drawCnt) + '/' + Slides.length ;
}
// Handle Button states
document.SlideShow.stop.disabled=stopB;
document.SlideShow.start.disabled=startB;
document.SlideShow.Next.disabled=nextB;
document.SlideShow.Previous.disabled=prevB;
document.SlideShow.End.disabled=endB;
document.SlideShow.Beginning.disabled=BeginB;
}
function go ( val ) {
if ( val == 1 ) {
if ( start == 1 ) { return true; }
start = 1; drawit() ;
document.SlideShow.stop.disabled=!val;
document.SlideShow.start.disabled=val;
document.SlideShow.Next.disabled=!val;
document.SlideShow.Previous.disabled=!val;
document.SlideShow.End.disabled=!val;
document.SlideShow.Beginning.disabled=!val;
} else {
start = 0
document.SlideShow.stop.disabled=!val;
document.SlideShow.start.disabled=val;
document.SlideShow.Next.disabled=val;
document.SlideShow.End.disabled=val;
document.SlideShow.Previous.disabled=val;
document.SlideShow.Beginning.disabled=val;
}
return true;
}
// Keep scheduling a cache of image indexed by cur variable
// schedule a Draw only if cur == 0
function dl() {
var ImageObject = new Image();
ImageObject.src = Slides[cur];
Slides[cur]=ImageObject;
if(cur == 0 ) {
window.resizeTo(700,650)
window.forward=1
window.toolbar=0
SetAspect(Slides[cur]);
document.images['Screen'].src = Slides[cur].src;
setTimeout("drawit()", t1);
}
cur++;
if( cur < Slides.length ) {
setTimeout("dl()", 100);
}
return true;
}
function drawit() {
if ( (typeof Slides[drawCnt] != 'string') ) {
SetAspect(Slides[drawCnt]);
document.images['Screen'].src = Slides[drawCnt].src;
document.SlideShow.text1.value=(1+drawCnt) + '/' + Slides.length ;
t2 = 1000*document.SlideShow.t2.value;
drawCnt++;
if( drawCnt < Slides.length ) {
if (start )
setTimeout("drawit()", t2);
} else {
go(0)
document.SlideShow.Next.disabled=1;
document.SlideShow.End.disabled=1;
document.SlideShow.start.disabled=1;
}
} else {
if (start)
setTimeout("drawit()", t1);
}
return true;
}
</script>
</head>
<body onLoad="dl()";>
<body>
<form name="SlideShow">
<img name="Screen" >
<table align=left>
<tr>
<td><input type="button" disabled= 1 name="Beginning" value="<<" onClick="Step(-100)"></td>
<td><input type="button" disabled= 1 name="Previous" value="<" onClick="Step(-1)"></td>
<td> <input type="button" disabled= 1 name="start" value="Start" onClick="go(1)"></td>
<td> <input type="button" name="stop" value="Stop" onClick="go(0)"></td>
<td> <input type="button" disabled= 1 name="Next" value=">" onClick="Step(1)"></td>
<td> <input type="button" disabled= 1 name="End" value=">>" onClick="Step(100000)"></td>
</tr>
<tr><td><input type=text name="text1" size="7" disabled=1></td>
<td>Show Time (seconds)<select size=1 name=t2><Option value=1>1<option selected value=2>2<option value=3>3<option value=4>4<option value=5>5<option value=6>6 </select></td></tr>
</table>
</form>
</body>
</html>
}