#!/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
}

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"
}