# $Id$ # this simple demo has been developped by C. Mertz # Ported to Tcl by P.Lecoanet if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } set w .iconTransform catch {destroy $w} toplevel $w wm title $w "Zinc icon scale/rotate Demonstration" wm iconname $w zincTransform set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*" 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 ########################################### # Text zone ####################### #################### text $w.text -relief sunken -borderwidth 2 -height 5 pack $w.text -expand yes -fill both $w.text insert end {This demo needs openGL for rescaling/rotating the icon You can transform this earth gif image with your mouse: Drag-Button 1 for zooming the earth, Drag-Button 2 for rotating the earth, Drag-Button 3 for moving the earth, Shift-Drag-Button 1 for modifying the earth transparency.} ########################################### # Zinc ########################################## zinc $w.zinc -width 350 -height 250 -render 1 -font 10x20 \ -borderwidth 3 -relief sunken pack $w.zinc set topGroup [$w.zinc add group 1] image create photo earth -file [file join $tk_library demos images earth.gif] set earth [$w.zinc add icon $topGroup -image earth \ -composescale 1 -composerotation 1] $w.zinc add text $topGroup -connecteditem $earth \ -text {try to zoom/resize the earth!} -color white \ -composescale 1 -composerotation 1 # # Controls for the window transform. # bind $w.zinc "press motion %x %y" bind $w.zinc release bind $w.zinc "press zoom %x %y" bind $w.zinc release # # Controls for alpha and gradient # bind $w.zinc "press modifyAlpha %x %y" bind $w.zinc release set curX 0 set curY 0 set curAngle 0 proc press {action x y} { global w curAngle curX curY set curX $x set curY $y set curAngle [expr atan2($y, $x)] bind $w.zinc "$action %x %y" } proc motion {x y} { global w topGroup curX curY 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 } 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 set curX $x set curY $y } proc mouseRotate {x y} { global w curAngle topGroup set lAngle [expr atan2($y, $x)] $w.zinc rotate $topGroup [expr -($lAngle - $curAngle)] set curAngle $lAngle } proc release {} { global w bind $w.zinc {} } proc modifyAlpha {x y} { global w 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 }