diff options
Diffstat (limited to 'demos/tkZincLogo.tcl')
-rw-r--r-- | demos/tkZincLogo.tcl | 219 |
1 files changed, 110 insertions, 109 deletions
diff --git a/demos/tkZincLogo.tcl b/demos/tkZincLogo.tcl index 9806212..6db4031 100644 --- a/demos/tkZincLogo.tcl +++ b/demos/tkZincLogo.tcl @@ -1,16 +1,25 @@ +# +# $Id$ # 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 +# Ported to Tcl by P.Lecoanet if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } -set w .tkZincLogo +# +# We need the zincLogo support +package require zincLogo + + +set w .zincLogo catch {destroy $w} toplevel $w -wm title $w "Zinc Logo Demonstration" -wm iconname $w Logo +wm title $w "Zinc logo Demonstration" +wm iconname $w zincLogo + +set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*" frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m @@ -18,138 +27,130 @@ 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 + + +########################################### +# Text zone +####################### +#################### + +text $w.text -relief sunken -borderwidth 2 -height 5 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.} +$w.text insert end {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 +########################################### +# Zinc +########################################## +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 group [$w.zinc add group 1] +set logo [zincLogo::create $w.zinc $group 800 40 70 0.6 0.6] -set logo = $w.zinc LogoZinc -parent $group -position {40 70} -priority 800 -scale {.6 .6} +# +# Controls for the window transform. +# +bind $w.zinc <ButtonPress-1> "press motion %x %y" +bind $w.zinc <ButtonRelease-1> release +bind $w.zinc <ButtonPress-2> "press zoom %x %y" +bind $w.zinc <ButtonRelease-2> release +# +# Controls for alpha and gradient +# +bind $w.zinc <Shift-ButtonPress-1> "press modifyAlpha %x %y" +bind $w.zinc <Shift-ButtonRelease-1> release +bind $w.zinc <Shift-ButtonPress-2> "press modifyGradient %x %y" +bind $w.zinc <Shift-ButtonRelease-2> release -$w.zinc Tk::bind <ButtonPress-1> "press $w.zinc motion" -$w.zinc Tk::bind <ButtonRelease-1> "release $w.zinc" +set curX 0 +set curY 0 +set curAngle 0 -$w.zinc Tk::bind <ButtonPress-2> "press $w.zinc zoom" -$w.zinc Tk::bind <ButtonRelease-2> "release $w.zinc" +proc press {action x y} { + global w curAngle curX curY -$w.zinc Tk::bind <ButtonPress-3> "press $w.zinc rotate" -$w.zinc Tk::bind <ButtonRelease-3> "release $w.zinc" + set curX $x + set curY $y + set curAngle [expr atan2($y, $x)] + bind $w.zinc <Motion> "$action %x %y" +} +proc motion {x y} { + global w topGroup curX curY -$w.zinc Tk::bind <Shift-ButtonPress-1> "press $w.zinc modifyAlpha" -$w.zinc Tk::bind <Shift-ButtonRelease-1> "release $w.zinc" + foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \ + [list $x $y $curX $curY]] break + $w.zinc translate $topGroup [expr $x1 - $x2] [expr $y1 - $y2] + set curX $x + set curY $y +} -$w.zinc Tk::bind <Shift-ButtonPress-2> "press $w.zinc modifyGradient" -$w.zinc Tk::bind <Shift-ButtonRelease-2> "release $w.zinc" +proc zoom {x y} { + global w topGroup curX curY + if {$x > $curX} { + set maxX $x + } else { + set maxX $curX + } + if {$y > $curY} { + set maxY $y + } else { + set maxY $curY + } + if {($maxX == 0) || ($maxY == 0)} { + return; + } + set sx [expr 1.0 + (double($x - $curX) / $maxX)] + set sy [expr 1.0 + (double($y - $curY) / $maxY)] + $w.zinc scale $topGroup $sx $sx -# -# 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 + set curX $x + set curY $y } -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 mouseRotate {x y} { + global w curAngle topGroup -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" + set lAngle [expr atan2($y, $x)] + $w.zinc rotate $topGroup [expr -($lAngle - $curAngle)] + set curAngle $lAngle } +proc release {} { + global w -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 + bind $w.zinc <Motion> {} } -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 modifyAlpha {x y} { + global w -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 + set xRate [expr double($x) / [$w.zinc cget -width]] + set xRate [expr ($xRate < 0) ? 0 : ($xRate > 1) ? 1 : $xRate] + set alpha [expr $xRate * 100] + + $w.zinc itemconfigure $group -alpha $alpha } -proc release {zinc} { - $zinc bind <Motion> "" +proc modifyGradient {x y} { + global w + + set yRate [expr double($ly) / [$w.zinc cget -height]] + set yRate [expr ($yRate < 0) ? 0 : ($yRate > 1) ? 1 : $yRate] + set gradientPercent [expr int($yRate * 100)] + + $w.zinc itemconfigure letters -fillcolor => "=axial 270|#ffffff;100 0 28|#66848c;100 $gradientpercent|#7192aa;100 100" } |