[FF] 2008-05-11 - Perhaps you know this game (under the name of Pipe Mania, Pipe Dream, Mac Pipe, ...). Here's my version, actually very minimal, features a tiny set of tiles, just what you need to enjoy.

I added also highscore. I hope that works on windows also.

Note: it requires also [TkPipes-Data.tcl].

ENJOY!

Update: new artwork!

[http://www.freemove.it/main/fileadmin/tclpipes-new.png]
----
[hae] added help dialog and pause functionality [FF] nice! usability increased a lot! I added a pause message, just to not let the gamer cheat ;P

[FF] renamed it to TkPipes as all other games are named this way.
If you want to keep your high score, rename .tclpipes to .tkpipes in your $HOME directory
----
 set dir [file dirname [info script]]
 set opts(delay,flood) 200
 set opts(dateformat) {%Y-%m-%d %H:%M}
 set opts(pipesDataFile) [file join $dir TkPipes-Data.tcl]
 set opts(help) {
 TkPipes
 by Federico Ferri - 2008
 http://wiki.tcl.tk/FF

 Controls

 p     - Pause
 Space - Continue

 Left click on the timer bar to start flood immediately

 }

 proc image_rotate {img angle img_dest} {
    set w [image width  $img]
    set h [image height $img]
    image create photo $img_dest
    switch -- $angle {
	90 {
	    set buf {}
	    $img_dest copy $img
	    for {set i 0} {$i < $w} {incr i} {
		set rowbuf {}
		for {set j [expr {$h-1}]} {$j >= 0} {incr j -1} {
		    foreach {r g b} [$img_dest get $i $j] break
		    lappend rowbuf [format #%02x%02x%02x $r $g $b]
		}
		lappend buf $rowbuf
	    }
	    $img_dest config -width $h -height $w
	    $img_dest put $buf
	}
	180 {
	    $img_dest copy $img -subsample -1 -1
	}
	270 {
	    image_rotate $img 180 ${img_dest}_tmp
	    image_rotate ${img_dest}_tmp 90 $img_dest
	    image delete ${img_dest}_tmp
	}
	flipx {
	    $img_dest copy $img -subsample -1 1
	}
    }
 }

 proc load_tileset {diroff name q {destname {}} {flip 0}} {
    if {$destname == {}} {set destname $name}
    set dir {N E S W N E S W}
    for {set i 0} {$i < $q} {incr i} {
	if $flip {
	    image create photo ${destname}_[lindex $dir $diroff]_${i}_tmp \
	       -data [lindex $::data($name) $i]
	    image_rotate ${destname}_[lindex $dir $diroff]_${i}_tmp flipx \
	${destname}_[lindex $dir $diroff]_${i}
	    image delete ${destname}_[lindex $dir $diroff]_${i}_tmp
	} else {
	    image create photo ${destname}_[lindex $dir $diroff]_${i} \
		-data [lindex $::data($name) $i]
	}
	foreach {a n} {90 1 180 2 270 3} {
	    image_rotate ${destname}_[lindex $dir $diroff]_${i} $a \
		${destname}_[lindex $dir $diroff+$n]_${i}
	}
	puts -nonewline "."; flush stdout
    }
 }

 proc load_all {} {
     puts -nonewline "Loading"; flush stdout
     source $::opts(pipesDataFile)
     load_tileset 2 curve     5 curve_l
     load_tileset 2 curve     5 curve_r 1
     load_tileset 0 straight  5
     load_tileset 3 cross     9 cross_l 1
     foreach {im nlist} {sink {0} empty {0 1 2}} { foreach n $nlist {
     image create photo ${im}_$n -data [lindex $::data($im) $n]
     }}
     puts "OK"
 }

 proc check {blk src_dir} {
    if {[llength $blk] == 4} {
	# is a cross
	return [string map {N S S N E W W E} $src_dir]
    } elseif {[llength $blk] == 2} {
	# is either straight or curve
	set idx [lsearch -exact $blk $src_dir]
	if {$idx == -1} {return {}}
	return [lindex $blk [string map {0 1 1 0} $idx]]
    } else {
	puts "# [info level 0] WTF?"
    }
 }

 proc move {x y dir} {
    set delta [string map {N {0 -1} E {1 0} S {0 1} W {-1 0}} $dir]
    incr x [lindex $delta 0]
    incr y [lindex $delta 1]
    return [list $x $y]
 }

 proc board:create {w h} {
    set ::W $w
    set ::H $h
    set ::CS 64
    set pw [expr {$::CS*$::W}]
    set ph [expr {$::CS*$::H}]
    canvas .c -width $pw -height $ph
    for {set y 0} {$y < $h} {incr y} {
	for {set x 0} {$x < $w} {incr x} {
	    .c create image [expr {1+$x*$::CS}] [expr {1+$y*$::CS}] \
		-anchor nw -image empty_0 -tags [list b_${x}_${y}]
	    .c bind b_${x}_${y} <ButtonPress-1> "board:click $x $y"
	}
    }
    grid .c -row 0 -column 0 -rowspan 2
 }

 proc board:put {x y id {frame 0}} {
    .c create image [expr {1+$x*$::CS}] [expr {1+$y*$::CS}] \
	-image ${id}_${frame} -anchor nw -tags [list p_${x}_${y} pieces]
    if {$id != "empty"} {
	board:put $x $y empty 2
    }
 }

 proc board:showscore {x y s} {
     .c delete txt_${x}_${y}
     foreach {dx dy c} {0 -1 B 1 0 B 0 1 B -1 0 B 0 0 W} {
	 .c create text \
	     [expr {$dx+($x+0.5)*$::CS}] [expr {$dy+($y+0.5)*$::CS}] \
	     -tags txt_${x}_${y} -text $s \
	     -fill [string map {W white B black} $c]
     }
     for {set i 40} {$i < 500} {incr i 50} {
	 after $i ".c move txt_${x}_${y} 0 -1"
     }
     after 1000 ".c delete txt_${x}_${y}"
     game:setscore $s
 }

 proc board:click {x y} {
     if {!$::ACTIVE} {return}
     timer:continue
     board:put $x $y $::piece
     set ::B($x:$y) [piece:getblk $::piece_t $::piece_d]
     set ::PT($x:$y) $::piece_t
     set ::PD($x:$y) $::piece_d
     set ::F($x:$y) 0
     preview:generate
     game:setscore -50
 }

 proc board:initlevel {l} {
     array unset ::B *
     array unset ::PT *
     array unset ::PD *
     array unset ::F *
     set ::sinkx [expr {int(rand()*($::W-1))}]
     set ::sinky [expr {int(rand()*($::H-1))}]
     .c delete pieces
     board:put $::sinkx $::sinky sink
     set ::B($::sinkx:$::sinky) [piece:getblk straight E]
     set ::PT($::sinkx:$::sinky) straight_W
     set ::PD($::sinkx:$::sinky) E
     set ::F($::sinkx:$::sinky) 0
     set ::LEVEL $l
     set ::ACTIVE 1
     set ::TIME [timer:totaltime]
     set ::timer_id [after 1 timer:tick]
     timer:continue
     set nblocks [lindex {0 4 1 3 2 4 4 4 4 4 4 4 4 4 4 4} $::LEVEL]
     for {set i 0} {$i < $nblocks} {incr i} {
	 set blkx $::sinkx
	 set blky $::sinky
	 while {[expr {abs($blkx-$::sinkx)}] <= 1 &&
		[expr {abs($blky-$::sinky)}] <= 1} {
	     set blkx [expr {int(rand()*($::W))}]
	     set blky [expr {int(rand()*($::H))}]
	 }
	 board:put $blkx $blky empty 1
	 set ::B($blkx:$blky) {}
	 set ::F($blkx:$blky) -1
     }
 }

 proc board:pause {b} {
     if {$b && $::ACTIVE} {
	 foreach {w h} [list [.c cget -width] [.c cget -height]] {break}
	 .c create rectangle 1 1 $w $h -fill gray -tags gamepaused
	 .c create text [expr {$w/2}] [expr {$h/2}] \
	     -text "GAME PAUSED\n\nPress SPACE to continue" \
	     -justify center -tags gamepaused
     } else {
	 .c delete gamepaused
     }
 }

 proc piece:getblk {p d} {
     set m {}
     switch $p {
	 cross_l - cross_r {return {N E S W}}
	 curve_l {set m {N {N E} E {E S} S {S W} W {W N}}}
	 curve_r {set m {N {N W} E {E N} S {S E} W {W S}}}
	 straight {set m {N {N S} E {E W} S {N S} W {E W}}}
     }
     return [string map $m $d]
 }

 proc preview:create {} {
     set n 1
     canvas .p -width $::CS -height [expr {$::CS*$n}]
     grid .p -row 1 -column 1
     set ::ACTIVE 0
     set ::LEVEL 1
 }

 proc preview:generate {} {
     set pl {curve_l curve_l straight straight cross_l}
     set ::piece_t [lindex $pl [expr int(rand()*5)]]
     set ::piece_d [lindex {N E S W} [expr int(rand()*4)]]
     set ::piece ${::piece_t}_${::piece_d}
    .p delete p
    .p create image 1 1 -image ${::piece}_0 -anchor nw -tags p
 }

 proc flood {x y d} {
     foreach {x y} [move $x $y $d] {break}
     if {![info exists ::PT($x:$y)]} {set ::ACTIVE 0; return}
     if {$x < 0 || $y < 0 || $x >= $::W || $y >= $::H} {set ::ACTIVE 0; return}
     set src [string map {E W W E N S S N} $d]
     set out [check $::B($x:$y) $src]
     if {$out == {}} {set ::ACTIVE 0; return}
     set dir {N E S W N E S W}
     if {[regexp ^curve_l $::PT($x:$y)]} {
	 if {$out == [lindex $dir [lsearch -exact $dir $src]+3]} {
	     set ::PT($x:$y) {curve_r}
	     set ::PD($x:$y) $src
	 }
     } elseif {[regexp ^cross_l $::PT($x:$y)] && $::F($x:$y) > 0} {
	 if {$::PD($x:$y) == [lindex $dir [lsearch -exact $dir $src]+1]} {
	     set ::PD($x:$y) [lindex $dir [lsearch -exact $dir $::PD($x:$y)]+2]
	 }
     } else {
	 set ::PD($x:$y) $src
     }
     set limit 4
     if {[regexp {^cross_[lr]$} $::PT($x:$y)] && $::F($x:$y) > 0} {
	 set limit 8
     }
     while {$::F($x:$y) < $limit} {
	 incr ::F($x:$y)
	 board:put $x $y $::PT($x:$y)_$::PD($x:$y) $::F($x:$y)
	 update
	 after $::opts(delay,flood)
     }
     if {$limit > 4} {
	 game:setscore -300
	 board:showscore $x $y +900
     } else {
	 board:showscore $x $y +300
     }
     flood $x $y $out
 }

 proc timer:create {} {
     canvas .t -width 20 -height 287 -background black
     set y 6
     foreach col {G G G G G G G G Y Y Y Y R R} {
	 .t create rectangle 6 $y 16 [incr y 15] \
	     -fill [string map {G green Y yellow R red} $col] \
	     -outline {} -tags tmclick
	 incr y 5
     }
     .t create rectangle 0 0 20 287 -fill black -tags {time tmclick}
     bind .t <ButtonPress-1> {set ::TIME 0}
     grid .t -row 0 -column 1
 }

 proc timer:totaltime {} {
     return [expr {20+(9-$::LEVEL)*10}]
 }

 proc timer:tick {} {
     if {!$::PAUSED} {
	 incr ::TIME -1
	 if {$::TIME <= 0} {
	     flood $::sinkx $::sinky E
	     if {$::SCORE >= $::MINSCORE} {
		 game:nextleveldialog
	     } else {
		 game:gameoverdialog
	     }
	     return
	 }

	 set h [expr {287-$::TIME*286.5/[timer:totaltime]}]
	 .t coords time 0 0 20 $h
	 if {$h > 200} {after 750 {.t coords time 0 0 20 287}}
     }
     set ::timer_id [after 1000 timer:tick]
 }

 proc timer:pause { } {
     set ::PAUSED 1
     board:pause 1
 }

 proc timer:continue { } {
     set ::PAUSED 0
     board:pause 0
 }

 proc game:new {} {
     catch {after cancel $::timer_id}
     set ::LEVEL 0
     set ::SCORE 0
     game:nextlevel
 }

 proc game:nextlevel {} {
     incr ::LEVEL
     set ::MINSCORE [game:minscore]
     board:initlevel $::LEVEL
     preview:generate
     game:setscore
     .sb.2 configure -text "Level: $::LEVEL     "
     .sb.3 configure -text "Score required to access next level: $::MINSCORE      "
 }

 proc game:createdialog { w title type } {
     set w .dialog_window
     catch {destroy $w}
     toplevel $w

     wm title $w $title
     wm withdraw $w

     bind $w <Escape> [list game:closedialog $w $type cancel]
     bind $w <Return> [list game:closedialog $w $type ok]
     bind $w <KP_Enter> [list game:closedialog $w $type ok]
     wm protocol $w WM_DELETE_WINDOW [list game:closedialog $w $type cancel]

     return $w
 }

 proc game:closedialog { w type action } {
     grab release $w
     switch $type {
	 {levelfinished} {
	     game:nextlevel
	 }
     }
     destroy $w
 }

 proc game:showdialog { w } {
     tk::PlaceWindow $w widget .
     catch {tkwait visibility $w}
     catch {grab set $w} err
     if {$err ne ""} {
	 tk_messageBox -message $err -type error
     }
     wm deiconify $w
 }

 proc game:gameoverdialog {} {
     set w [game:createdialog .dialog_window "Game Over" gameover]

     if {![info exists ::playername]} {
	 catch {set ::playername $::env(USER)}
     }

     set i 1
     pack [label $w.l[incr i] -text "\nGame over!\n"]
     pack [button $w.b[incr i] -text "Ok" -default active -command "highscores:add \[$w.pn get]; destroy $w"] -side bottom
     pack [label $w.l[incr i] -text "Enter your name:"] \
      [entry $w.pn -text "" -textvariable ::playername] \
      -side left -padx 5 -pady 5

     game:showdialog $w
 }

 proc game:nextleveldialog {} {
     set w [game:createdialog .dialog_window "Level finished" levelfinished]

     set i 1
     pack [label $w.l[incr i] -text "Congratulations! Level completed\n"] -padx 5 -pady 5
     pack [button $w.b[incr i] -text "Next level" -default active -command "game:closedialog $w levelfinished ok"]

     game:showdialog $w
 }

 proc game:highscoresdialog {} {
     set w [game:createdialog .dialog_window "High scores" showhighscores]

     set i 1
     grid [label $w.l[incr i] -text "Hall of fame"] -columnspan 4
     grid [label $w.l[incr i] -text ""] -columnspan 4
     set row 3
     if [llength $::HIGHSCORES] {
	 set HS [lreverse [lsort -integer -index 0 $::HIGHSCORES]]
	 grid [label $w.h1 -text "  Score:  "] -row $row -column 0 -padx 5 -pady 5
	 grid [label $w.h2 -text "  Level:  "] -row $row -column 1 -padx 5
	 grid [label $w.h3 -text "  Name:   "] -row $row -column 2 -padx 5
	 grid [label $w.h4 -text "  Date:   "] -row $row -column 3 -padx 5
	 incr row
	 for {set i 0} {$i < [llength $HS]} {incr i} {
	     for {set j 0} {$j < 3} {incr j} {
		 grid [label $w.hs_${i}_${j} \
		    -text "  [lindex [lindex $HS $i] $j]  "] \
		    -row $row -column $j -padx 5
	     }
	     grid [label $w.hs_${i}_3 \
		 -text [concat "  " \
		     [clock format [lindex [lindex $HS $i] 3] \
			 -format $::opts(dateformat)] \
		     "  "]] \
		 -row $row -column 3
	     incr row
	 }
     } else {
	 grid [label $w.l[incr i] -text "Empty"] -columnspan 4
     }
     game:showdialog $w
 }

 proc game:aboutdialog {} {
     set w [game:createdialog .dialog_window "About" about]
     wm resizable $w 0 0
     set f [frame $w.f]

     set i 1
     set e [string map {R ri O co Q de Z fe I it W ma L il} ZQRO.ZrR.I@gWL.Om]
     pack [label $f.l[incr i] -text "TkPipes\n"]
     pack [label $f.l[incr i] -text "by Federico Ferri <$e> - 2008"]
     pack [label $f.l[incr i] -text "http://wiki.tcl.tk/FF\n"]
     pack [button $f.b[incr i] -text "Cheers!" -default active -command "game:closedialog $w about ok"]

     pack $f -padx 5 -pady 5
     game:showdialog $w
 }

 proc game:helpdialog {} {
     set w [game:createdialog .dialog_window "Help" help]
     wm resizable $w 0 0
     set f [frame $w.f -relief sunken -borderwidth 1]

     scrollbar $f.hs -orient horizontal -command [list $f.t xview]
     scrollbar $f.vs -orient vertical   -command [list $f.t yview]
     text $f.t -height 14 -width 60  -relief flat \
	   -background white \
	   -xscrollcommand [list $f.hs set] \
	   -yscrollcommand [list $f.vs set]

     grid $f.t  -row 0 -column 0
     grid $f.vs -row 0 -column 1 -sticky ns
     grid $f.hs -row 1 -column 0 -sticky ew

     $f.t insert end $::opts(help)

     pack $f -padx 5 -pady 5
     pack [button $w.b0 -text "  Ok  " -default active \
	 -command "game:closedialog $w help ok"] \
	 -side bottom -pady 5

     game:showdialog $w

 }

 proc game:setscore {{score {}}} {
     if {$score != {}} {
     if [regexp {^(\+|-)(.*)$} $score -> pm n] {
	 set ::SCORE [expr $::SCORE$pm$n]} {set ::SCORE $score}
     }
     .sb.1 configure -text "Score: $::SCORE       "
 }

 proc game:minscore {} {
     set delta {5000 5000 7500 7500 9000 9000 17500 17500 26000
     35000 45000 50000 350 350 350 350 350}
     set r 0
     for {set i 0} {$i < $::LEVEL} {incr i} {incr r [lindex $delta $i]}
     return $r
 }

 proc highscores:load {} {
     set ::HIGHSCORES {}
     set f [file join $::env(HOME) .tkpipes]
     if [file exists $f] {source $f}
 }

 proc highscores:save {} {
     set HS [lreverse [lsort -integer -index 0 $::HIGHSCORES]]
     set fh [open [file join $::env(HOME) .tkpipes] w]
     set count 0
     puts $fh "set ::HIGHSCORES {"
     foreach line $HS {
	 puts $fh " {[concat $line]}"
	 incr count
	 if {$count > 10} break
     }
     puts $fh "}"
     close $fh
 }

 proc highscores:add {name} {
     if {$name == {}} return
     lappend ::HIGHSCORES [list $::SCORE $::LEVEL $name [clock seconds]]
     highscores:save
 }

 wm title . "TkPipes"
 menu .mb
 . configure -menu .mb
 menu .mb.game -tearoff 0
 menu .mb.help -tearoff 0
 .mb.game add command -label "New game" -command game:new
 .mb.game add separator
 .mb.game add command -label "High scores..." -command game:highscoresdialog
 .mb.game add separator
 .mb.game add command -label "Exit" -command exit
 .mb add cascade -label "Game" -menu .mb.game

 .mb.help add command -label "Help" -command game:helpdialog
 .mb.help add separator
 .mb.help add command -label "About..." -command game:aboutdialog
 .mb add cascade -label "Help" -menu .mb.help

 bind . <Key-p> [list timer:pause]
 bind . <Key-space> [list timer:continue]

 grid [frame .sb -relief sunken] -sticky nesw -row 99 -columnspan 99
 grid [label .sb.1 -relief sunken] -in .sb -row 0 -column 0 -sticky ew
 grid [label .sb.2 -relief sunken] -in .sb -row 0 -column 1 -sticky ew
 grid [label .sb.3 -relief sunken] -in .sb -row 0 -column 2 -sticky ew
 package require Tk
 load_all
 highscores:load
 board:create 10 8
 timer:create
 preview:create
----
!!!!!!
%| [Category Games] | [Category Application] | [Category Graphics] |%
!!!!!!