Attaché au pointeur

 

DC 29/05/07

Un petit script qui attache au pointeur une petite animation simple. À adapter...

 #!/bin/sh
 # The next line restarts using tclsh \
 exec tclsh8.4 "$0" -- ${1+"$@"}

 #
 # auteur : AmI2Blame4 (david cobac [string map {# @} david.cobac#free.fr])
 # date   : 28-29/05/2007
 #

 package require Tk

 namespace eval mt {
    namespace export *
    variable dim 5
    variable d [expr {$dim+2}]
    variable dec 15
    variable coulP 0
    # j pour créer l'animation
    variable j 0
    # tour pour n'appliquer le changement qu'une fois sur trois
    # sinon c'est trop rapide
    variable tour 0
 }

 proc mt::coul {} {
    variable coulP
    set coulP [expr {($coulP+33)%132}]
    return grey$coulP
 }

 proc mt::chg {} {
    variable dim
    variable dec
    variable d
    variable j
    variable tour

    set tour [expr {($tour+1)%3}]

    if {$tour eq 0} {
	set j [expr {($j+1)%4}]
    }

    set x [winfo pointerx .]
    set y [winfo pointery .]
    for {set i 0} {$i<4} {incr i} {
	if {$tour eq 0} {
	    .f[expr {($i+$j)%4}] configure -bg [mt::coul]
	}
	wm geometry .f$i ${dim}x${dim}+[expr {[winfo pointerx .]+$dec+($i>0)*($i<3)*$d}]+[expr {[winfo pointery .]+$dec+($i<2)*$d}]
    }
    update
    # 50 permet de coller au pointeur
    after 50 mt::chg
 }

 proc mt::robert {} {
    variable dim
    variable dec
    wm withdraw .

    for {set i 0} {$i<4} {incr i} {
	toplevel .f$i
	wm overrideredirect .f$i 1
    }
    mt::chg
 }

 namespace import mt::*
 robert

Kroc - 30 Mai 2007 : Vraiment chouette !