Surprise belt game

Summary edit

RJM 2018-3 This game is based on the final part of a famous television game that originated from a Dutch showmaster ("een van de acht", Mies Bouwman). The show concept had been sold to Germany (R. Carrell) as "Am Laufenden Band", and this television game/show was also presented in other countries, e.g. in the UK as "The Generation Game". By end of february 2018, Bouwman died. The code below was created as a honour to her.

Run the code below after you have put a collection of up to 40 images (jpg or png) in the same directory. See the code comment near the bottom for some handling hints. Artwork images should preferably offer transparency around its own shape and hence be saved as png-files.

I have the impression that the program runs a bit slowly on Windows, but it runs quite flawlessly under Linux. Probably, a modified technical animation concept can improve the behaviour under Windows.

A visual impression with extended code (updated below):

KPV -- I was trying to figure out what the game show was, and the best explanation I could find is for the derivative British gameshow The Generation Game

. According to wikipedia, at the end of the show, one member (or in later series both members) of the victorious team watches prizes pass on a conveyor belt, and wins as many as could be recalled in 45 seconds

Code edit

#!/usr/bin/tclsh
package require Tk
package require img::jpeg
package require img::png
source params.tcl

if {[winfo exist .c]} {
    destroy .c
}

proc init {} {
    global p
    frame .f
    set bottomheight [expr $p(beamer_h) - $p(area_h) - $p(decoration_top)]
    set sidewidth [expr ($p(beamer_w) - $p(area_w))/2]
    # create the curtains on the sides
    canvas .cleft -width $sidewidth -height $p(beamer_h) -bg gray15 -highlightthickness 0
    image create photo img_l -file curtain-l.png
    .cleft create rectangle [expr $sidewidth-10] $p(decoration_top) $sidewidth $p(area_h) -fill gray90 -tag bg
    .cleft create image 0 0 -image img_l -anchor nw
    canvas .cright -width $sidewidth -height $p(beamer_h) -bg gray15 -highlightthickness 0
    image create photo img_r -file curtain-r.png
    .cright create rectangle -1 $p(decoration_top) $p(decoration_top) $p(area_h) -fill gray90 -tag bg
    .cright create image 0 0 -image img_r -anchor nw
    # create the center areas
    canvas .ctop -width $p(area_w) -height $p(decoration_top) -bg gray15 -highlightthickness 0
    canvas .c -width $p(area_w) -height $p(area_h) -xscrollincrement 5 -yscrollincrement 5 -highlightthickness 0 -bg gray90
    canvas .cbottom -width $p(area_w) -height $bottomheight -bg gray15 -highlightthickness 0
    pack .ctop .c .cbottom -in .f
    pack .cleft .f .cright -side left
    
    # read and position all images into the invisible part of the canvas
    set files [lsort [glob -nocomplain *.jpeg *.jpg *.JPG *.png *.PNG]]
    if {$files != ""} {
        set x0 1000
        set y0 -3
        foreach file $files {
            if {[regexp curtain $file]} continue
            image create photo $file -file $file
            .c create image $x0 $y0 -image $file -anchor sw
            incr x0 $p(distance)
        }
    }

    # create a virtual transport belt with some imperfectances
    .c create line 0 0 0 0  -width 8 -smooth 1 -tag band
    set y 0
    incr x0 $p(distance)
    for {set x 0} {$x < $x0} {incr x 20} {
        set y [expr {int(rand()*4)}]
        .c insert band end "$x $y"
    }
    
    .cbottom create text 20 [expr $bottomheight -15] -text $p(candidate) -font "Verdana 18" -fill orange -anchor sw
    .c config -scrollregion [.c bbox all]
    update
    #.c yview scroll -700 units   ;# adjust vertically if necessary
    wm attribute . -fullscreen 1
}

set pos 0.1
proc animate {interval} {
    global pos
    if { [catch {.c xview scroll 1 units}] } return
    after $interval animate $interval
    #set pos [expr {$pos + 0.0001}]
    #.c xview moveto $pos
}

proc darken {interval} {
    regsub {.*?(..)$} [.c cget -bg] {\1} bg
    #set bg [expr {100*$bg/256}]
    incr bg -1
    if {$bg < 30} return
    .c config -bg gray$bg
    .cleft itemconfig bg -fill gray$bg
    .cright itemconfig bg -fill gray$bg
    after $interval darken $interval
}

# The first space key expands the application window to full screen, which must be done
# after the application has been dragged onto the beamer screen.
# The second space key starts the belt.
bind . <space> {
    if {![winfo exist .c]} {
        init
    } else {
        # the text here is the classic Dutch phrase associated with the belt game
        .c create text 300 -330 -text $p(welcome) -font "Helvetica 80" -justify center
        after 1000 darken 40
        after 3000 animate 40
    }
}
bind . <Escape> {
    after cancel animate
}

And here a small parameter file that should be saved as parameters.tcl.

array set p {
    beamer_w 1024
    beamer_h 768
    area_w 624
    area_h 608
    distance 850
    decoration_top 16
    welcome "licht uit,\nspot aan!"
    candidate "Michael Sample"
}

The curtain images curtain-l.png and curtain-r.png: