Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tclapps/ChangeLog,v
retrieving revision 1.2
diff -u -r1.2 ChangeLog
--- ChangeLog	7 Nov 2001 22:30:33 -0000	1.2
+++ ChangeLog	24 Feb 2002 21:23:43 -0000
@@ -1,3 +1,8 @@
+2002-02-24  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* apps/frogger/frogger.tcl: Started to add some sound support for
+	those people lucky enough to have the Snack extension installed.
+
 2001-11-07  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* apps/biorythm/biorythm.tcl: written by Ken Corey
Index: apps/frogger/frogger.tcl
===================================================================
RCS file: /cvsroot/tcllib/tclapps/apps/frogger/frogger.tcl,v
retrieving revision 1.1
diff -u -r1.1 frogger.tcl
--- apps/frogger/frogger.tcl	7 Nov 2001 22:30:33 -0000	1.1
+++ apps/frogger/frogger.tcl	24 Feb 2002 21:23:48 -0000
@@ -12,9 +12,81 @@
 #
 # RCS: @(#) $Id: frogger.tcl,v 1.1 2001/11/07 22:30:33 hobbs Exp $
 
+# Place to pull external data (especially sound files) from.
+set resourcedir [file dirname [info script]]
+# Set to enable debugging messages
+set DEBUG 0
+
 proc rand {{range 100}} {expr {int(rand()*$range)}}
 
 # ----------------------------------------------------------------------
+# Load the sounds (if we can)
+
+# frog   = sound every time the frog moves.
+# *-beep = noise when new vehicle generated
+# splash = die by water
+# squish = die by vehicle
+# bite   = die by heron
+# hooray = played when you win
+
+# Note that this version of the game does not supply the sound files.
+array set soundfile {
+    frog       {}
+
+    lorry-beep {}
+    bus-beep   {}
+    car-beep   {}
+
+    splash     {}
+    squish     {}
+    bite       {}
+
+    hooray     {}
+}
+array set sounds {}
+if {[catch {
+    package require snack
+    foreach key [array names soundfile] {
+	if {[string length $soundfile($key)] && [catch {
+	    set sounds($key) [snack::sound \
+		    -load [file join $resourcedir $soundfile($key)]]
+	    set playing_sounds($key) 0
+	}] && $DEBUG} {
+	    puts $errorInfo
+	}
+    }
+    proc queuesound {key} {
+	global sounds playing_sounds
+	if {
+	    ![winfo ismapped .] ||
+	    ![info exist sounds($key)] ||
+	    $playing_sounds($key)
+	} {
+	    return
+	}
+	set playing_sounds($key) 1
+	$sounds($key) play -command [list donesound $key]
+    }
+    proc donesound {key args} {
+	global playing_sounds
+	set playing_sounds($key) 0
+    }
+} msg]} {
+    if {$DEBUG} {
+	puts "Sound init failed: $msg"
+	puts $errorInfo
+    }
+    proc queuesound {args} {}
+}
+if {![array size sounds]} {
+    if {$DEBUG} {
+	puts "No sounds loaded: last failure in $soundfile($key)"
+	puts $errorInfo
+    }
+    proc queuesound {args} {}
+}
+
+# ----------------------------------------------------------------------
 # Load the images
 
 array set imagedata {
@@ -789,6 +861,7 @@
 	if {![string match *$tag* [listspottags 0 $y]] && [rand $r]<1} {
 	    if {[catch {
 		.c create image -30 $y -image $tag -tags $tag
+		queuesound ${tag}-beep
 	    }]} {
 		.c create rectangle -62 [expr {$y-22}] 2 [expr {$y+22}] \
 			-outline red -fill yellow -tags $tag
@@ -800,6 +873,7 @@
 	if {![string match *$tag* [listspottags 250 $y]] && [rand $r]<1} {
 	    if {[catch {
 		.c create image 280 $y -image $tag -tags $tag
+		queuesound ${tag}-beep
 	    }]} {
 		.c create rectangle 312 [expr {$y-22}] 248 [expr {$y+22}] \
 			-outline red -fill yellow -tags $tag
@@ -893,6 +967,7 @@
 	}
 	*croc* - *log* {
 	    #ignore the water when on a log
+	    queuesound frog
 	}
 	*water* {
 	    die water "Drowned..."
@@ -903,6 +978,9 @@
 	*win* {
 	    die winner "You win! "
 	}
+	default {
+	    queuesound frog
+	}
     }
 }
 
@@ -941,6 +1019,20 @@
 	    eval .c create rectangle [.c bbox $id] -outline white -fill black
 	}
     }
+    switch $tag {
+	winner {
+	    queuesound hooray
+	}
+	car - bus - lorry {
+	    queuesound squish
+	}
+	heron {
+	    queuesound bite
+	}
+	left - right - water {
+	    queuesound splash
+	}
+    }
     .c raise $id
     after 5000 init restart
     return -code return "exit the caller!"
@@ -1021,9 +1113,9 @@
 	    }
 	    pack .i.t -fill x -expand 1 -side top
 
-	    .i.t tag conf head -font *Adobe*Helvetica*Bold*O*240* \
+	    .i.t tag conf head -font {Helvetica -24 {bold italic}} \
 		    -justify center -spacing1 2 -spacing3 2 -foreground red3
-	    .i.t tag conf body -font *Adobe*Times*Medium*R*140* \
+	    .i.t tag conf body -font {Times -14} \
 		    -justify left -spacing1 2 -spacing2 1 -spacing3 2 \
 		    -lmargin1 22 -lmargin2 3 -rmargin 3 -foreground black