[Keith Vetter] 2024-02-05 - An animation of the bouncing DVD Video logo.


======
package require Tk

set S(src) ::img::dvd_logo
set S(x) [expr {int(rand() * 300)}]
set S(y) [expr {int(rand() * 300)}]
set S(dx) 1
set S(dy) 1
set S(delay) 10
set S(state) animate
set S(aid) ""

proc DoDisplay {} {
    # Don't like aqua theme's background around a button
    ::ttk::style theme use default

    wm title . "DVD Logo Screensaver"
    wm minsize . [expr {2 * $::S(image,width)}] [expr {2 * $::S(image,height)}]

    canvas .c -bd 0 -highlightthickness 0 -width 500 -height 500 -bg black
    pack .c -side top -fill both -expand 1

    ::ttk::button .stop -text Stop -command StopStart
    place .stop -in .c -relx .5 -rely 1 -y -.2i -anchor s

    .c create image $::S(x) $::S(y) -tag logo -anchor nw -image ::img::logo
    bind .c <Configure> {Resize %h %w}
}
proc Resize {h w} {
    # Called when window gets resized--check if logo is outside the window
    set wwidth [winfo width .]
    set wheight [winfo height .]

    if {$::S(x) + $::S(image,width) < $wwidth
        && $::S(y) + $::S(image,height) < $wheight} {
        return
    }
    set ::S(x) 10
    set ::S(y) 10
    .c coords logo $::S(x) $::S(y)
}
proc MoveLogo {} {
    set wwidth [winfo width .]
    set wheight [winfo height .]
    if {$::S(x) == 0 || $::S(x) + $::S(image,width) == $wwidth} {
        set ::S(dx) [expr {-$::S(dx)}]
        PickNewColor
    }
    if {$::S(y) == 0 || $::S(y) + $::S(image,height) == $wheight} {
        set ::S(dy) [expr {-$::S(dy)}]
        PickNewColor
    }
    incr ::S(x) $::S(dx)
    incr ::S(y) $::S(dy)
    .c move logo $::S(dx) $::S(dy)
}

proc StopStart {} {
    if {$::S(state) eq "animate"} {
        set ::S(state) "stop"
        .stop config -text Start
    } else {
        set ::S(state) "animate"
        .stop config -text Stop
        after cancel $::S(aid)
        Animate
    }
}
proc Animate {} {
    if {$::S(state) ne "animate"} return

    MoveLogo
    set ::S(aid) [after $::S(delay) Animate]
}

image create photo ::img::dvd_logo -data {
    iVBORw0KGgoAAAANSUhEUgAAALkAAABRCAYAAAH5vTclAAAGT0lEQVR4nO2d23LrIAxFcaf//8s5L8cp
    wQIkoSthzXTaJjaIjSwwF/sqf7wKjgtx/H1M+UEm2jIz5nUf08vg6nw+oz3vdWcws6g+8dX5HKRXAkx9
    XMBx7f/XLyIRyufY77tgPY2VE0n79kCK5g9PGaU9uw7axCgGgQnUUPTuptPz79Xjr/pgqqWo46HEORmC
    561evUOgK/dxeSMzBMPC0GeFv+vyjuVYsLn0pBpyaw5ZBF2lL+B3j+tncsAL+Lv93U8dkSgGMB3oQ3Ic
    J2QslfZHeJFO/JGRRtqkdkbYiJFDo+ySMoraQIvkuZoQ9ZoRzY/dO5vACqpUZl3WVbTEmSauEXmoDAuP
    7lVNzqv/h5rJAny/Ahjn60w0oRYA1cJqtq4r6T+M175YpXj0/y0Nl6rN4aCHNOLXTq04piW0CpfTlhej
    +NX5GwP5HggL1VVE+92I77r5efYcl/LDDhhiDJE+dpjGalRxMbr+Q2Sca5DWSguKvqleBWP4MhYNkGof
    XRq1+H0jqQZlKmMZqVEpLaYD3pwx6d7dz0393eh/Ch9zbtQE0PNtwDlX9T3HdaZj6TO4E1Vcg6cZWHZb
    lxohTjdVA3ItcJrvKGSwndxdiWD0jOhNUYv5IIUVUQUv5b9tVoPnWqzcPK+WnV1G1flLZlpUOEPZ3HN6
    kNKC+lySIknNm0nlcRWZ+QZu/qUUmZguOddxVb8lhVkNJaJl9JocgtC6YfC6EWl5DM3dWBuk2deO0p2c
    3tVZTYFSyNSoz/LHHRAArFAZylJKyWOo6YirNpmMNZkNOTxRnxCxQNpT0gtSoXYVebf0u4GqKKsFN5gJ
    L8xn2POoeWvzURmciToOUB6cfLFrl9vPoF0NbljfHI28bOTFNZg117M0ejZIMp1Lp+LuLY4sN7AZ5hl7
    YArvPs5COSCy2KXkcJaHjVbroK2JIHYpwE3croJHY3lJVGSieHfLcOY/qtEt3hMuZHb08NCctS18WGXU
    XtfieQc7O8+ljNprWiIivXSDxA4xXHLzkPR5DyQE95wGsxBbFE0P5y6RCyEMEpclcstGGCC1zXU5jUg3
    DtKiQOlKp03litJotqJIhZVI4Ulkf7MEWqKEE7sUf8GtxfYIJx+2YB+voWrE4JiIDTAWsIzWm7MsLnPv
    UDLM30LwFQGWd+QaQMrT2xswbLWs2bvRlCKF2KXkMZS6+ios2T08ldil5Bc8HZk8BLO2MDxZPTyl2KXE
    NHz17jJimd6crSh9VCqOkuhOYkrAqpBIo2o7QFqurP1gL+penvrzmtkxnDQ0AMW/9/toGtCK2n6OOR+7
    laQnNjYNSUBdPbqFmltdIi7Sd1kfHuKJDxH4KbaGau6ZjLplHJxi89g8igUb+3v7M6HFRWG3DkasAA4W
    DkXaCk5hl0rgshSCNeN3tooxactWMskmaBQkKvZbtRcdTpnxrSJL4LK9aGOWdtyPOEKvcfqIejy0PWL7
    QNX9aE4nzFrxw5zj4DzeA5snovjxLeOI7pxIHpPj4IKkmBxs2MUBPBYKRapvs3qMtgQumj3aWCzQqvOK
    Voc3qnZhuysRxYkUlVbRjt5WWoWsk8x9co/nymmgucTWsqXgom4XxskjRvFwz7Fmor2GPDom9ZjtdcC7
    OLcWnrteot5PXTMn9xQnynPR6s+iNvmRL0b3ejwTEk+yaZLNXgu6TyRr+TZxIkdDiGz2WgBqMhLqW5w8
    3LjuhKh9X0+GmkTsD1uQceNCtotRG7Qe3+Lk2YYAW46DL9Qh1CfPLs5OfdWdykJBtNzZxslLiVXxWsOK
    kcooiUu5dhXTGs13jBwWyRjJd+U4txJHWDm40fzUgTJHYFms3357QHC6Kz4c5zbkiC3PNu932YUjug5b
    vHFkF3YSP/sklgc71X8Xr0Ieh9ybUBdPxoVKhz1RuzB2WXBPfUR/7zjKY/qltMNU7iytXepxhMgCrcxC
    3O+SGOH5nglKXhov9Y78DhEskO2o8v92Ts7ObOGUdJlnFaCxkIvTekXep8oB9YKzzM9dacF2LawqeWWa
    v/7xsmMbdpvxrLstkIOYPgqBeZ52xN+RYRl/gQOyX/mY/rk0Hjd+bTklbmAzga5jKJJ7R0At3N+VioSi
    f+/lvxJ2RGE5YElHvMxiHmwxa20j9dfOBZKTSD4E8g8eymMS0ZW0DwAAAABJRU5ErkJggg==}

proc RandomColor {} {
    set color [format "#%06x" [expr {int(rand() * 0xFFFFFF)}]]
    return $color
}

proc MakeColoredLogos {colors} {
    # Makes a bunch of copies of ::img::dvd_logo in various colors
    set ::S(logos) {}
    for {set i 0} {$i < [llength $colors]} {incr i} {
        set img ::img::logo_$i
        lappend ::S(logos) [image create photo $img -width $::S(image,width) -height $::S(image,height)]
    }
    for {set row 0} {$row < $::S(image,height)} {incr row} {
        set state "TRANSPARENT"
        for {set col 0} {$col <= $::S(image,width)} {incr col} {
            set transparent 1  ;# Sentinel
            if {$col < $::S(image,width)} {
                set transparent [$::S(src) transparency get $col $row]
            }

            if {$state eq "COLORING" && ! $transparent} continue
            if {$state eq "TRANSPARENT" && $transparent} continue

            if {$state eq "COLORING" && $transparent} {
                set state "TRANSPARENT"
                foreach img $::S(logos) color $colors {
                    $img put $color -to $first $row $col [expr {$row + 1}]
                }
            }
            if {$state eq "TRANSPARENT" && ! $transparent} {
                set state "COLORING"
                set first $col
            }
        }
    }
}
proc PickNewColor {} {
    set n [expr {int(rand() * [llength $::S(logos)])}]
    ::img::logo blank
    ::img::logo copy [lindex $::S(logos) $n]
}
proc Main {} {
    set ::S(image,width) [image width ::img::dvd_logo]
    set ::S(image,height) [image height ::img::dvd_logo]

    set preset_colors {white purple red orange magenta yellow green blue cyan}
    for {set i 0} {$i < 20} {incr i} {
        lappend preset_colors [RandomColor]
    }

    MakeColoredLogos $preset_colors
    image create photo ::img::logo
    ::img::logo copy [lindex $::S(logos) 0]
    DoDisplay
}

Main
Animate

======