Portage depuis perl

1 files changed, 155 insertions, 0 deletions

diff --git a/demos/tkZincLogo.tcl b/demos/tkZincLogo.tcl
new file mode 100644
index 0000000..9806212
--- /dev/null
+++ b/demos/tkZincLogo.tcl
@@ -0,0 +1,155 @@
+# this simple demo has been adapted by C. Mertz <mertz@cena.fr> from the original
+# work of JL. Vinot <vinot@cena.fr>
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+    error "This script should be run from the zinc-widget demo."
+}
+
+set w .tkZincLogo
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Logo Demonstration"
+wm iconname $w Logo
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-140-*-*-*-*-*-*"
+text $w.text -relief sunken -borderwidth 2 -height 7 
+pack $w.text -expand yes -fill both
+
+$w.text insert 0.0 {This tkZinc logo should used openGL for a correct rendering!
+    You can transform this logo with your mouse:
+    Drag-Button 1 for moving the logo 
+    Drag-Button 2 for zooming the logo 
+    Drag-Button 3 for rotating the logo 
+    Shift-Drag-Button 1 for modifying the logo transparency 
+    Shift-Drag-Button 2 for modifying the logo gradient.}
+
+
+zinc $w.zinc -width 350 -height 250 -render 1 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+set group [$w.zinc add group 1 ]
+
+
+set logo = $w.zinc LogoZinc -parent $group -position {40 70} -priority 800 -scale {.6 .6}
+
+
+
+$w.zinc Tk::bind <ButtonPress-1> "press $w.zinc motion"
+$w.zinc Tk::bind <ButtonRelease-1> "release $w.zinc"
+
+$w.zinc Tk::bind <ButtonPress-2> "press $w.zinc zoom"
+$w.zinc Tk::bind <ButtonRelease-2> "release $w.zinc"
+
+$w.zinc Tk::bind <ButtonPress-3> "press $w.zinc rotate"
+$w.zinc Tk::bind <ButtonRelease-3> "release $w.zinc"
+
+
+$w.zinc Tk::bind <Shift-ButtonPress-1> "press $w.zinc modifyAlpha"
+$w.zinc Tk::bind <Shift-ButtonRelease-1> "release $w.zinc"
+
+$w.zinc Tk::bind <Shift-ButtonPress-2> "press $w.zinc modifyGradient"
+$w.zinc Tk::bind <Shift-ButtonRelease-2> "release $w.zinc"
+
+
+#
+# Controls for the window transform.
+#
+my $cur_x $cur_y $cur_angle
+proc press {zinc action} {
+    my $w.zinc $action = @_
+    set ev = $w.zinc XEvent 
+    $cur_x = $ev x
+    $cur_y = $ev y
+    $cur_angle = atan2 $cur_y $cur_x
+    $w.zinc Tk::bind <Motion> $action
+}
+
+proc modifyAlpha {zinc} {
+    my $w.zinc = @_
+    set ev = $w.zinc XEvent 
+    set lx = $ev x
+    set xrate = $lx / $w.zinc cget -width
+    
+    $xrate = 0 if $xrate < 0
+    $xrate = 1 if $xrate > 1
+    
+    set alpha = $xrate * 100
+    print "Alpha=$alpha\n"
+    $w.zinc itemconfigure $group -alpha $alpha
+}
+
+proc modifyGradient {zinc} {
+    my $w.zinc = @_
+    set ev = $w.zinc XEvent 
+    set ly = $ev y
+    set yrate = $ly / $w.zinc cget -height
+    
+    $yrate = 0 if $yrate < 0
+    $yrate = 1 if $yrate > 1
+    set gradientpercent = sprintf "%d" $yrate * 100
+    
+    $w.zinc itemconfigure "letters" -fillcolor "#ffffff:100 0 28|#66848c:100 $gradientpercent|#7192aa:100 100/270" 
+}
+
+
+proc motion {zinc} {
+    my $w.zinc = @_
+    set ev = $w.zinc XEvent 
+    set lx = $ev x
+    set ly = $ev y
+    my @res
+    
+    @res = $w.zinc transform $group "$lx $ly $cur_x $cur_y"
+    $w.zinc translate $group $res[0] - $res[2] $res[1] - $res[3]
+    $cur_x = $lx
+    $cur_y = $ly
+}
+
+proc zoom {zinc} {
+    my $w.zinc $self = @_
+    set ev = $w.zinc XEvent 
+    set lx = $ev x
+    set ly = $ev y
+    set maxx
+    set maxy
+    set sx
+    set sy
+    
+    if $lx > $cur_x {
+	$maxx = $lx
+    } else {
+	$maxx = $cur_x
+    }
+    if $ly > $cur_y {
+	$maxy = $ly
+    } else {
+	$maxy = $cur_y
+    }
+    return if $maxx == 0 || $maxy == 0
+    $sx = 1.0 + $lx - $cur_x/$maxx
+    $sy = 1.0 + $ly - $cur_y/$maxy
+    $cur_x = $lx
+    $cur_y = $ly
+    $w.zinc scale $group $sx $sy
+}
+
+proc rotate {zinc x y} {
+    set ev = $zinc XEvent 
+    set lx = $ev x
+    set ly = $ev y
+    
+    $langle = atan2 $ly $lx
+    $w.zinc rotate $group - $langle - $cur_angle
+    $cur_angle = $langle
+}
+
+proc release {zinc} {
+    $zinc bind <Motion> "" 
+}