diff options
Diffstat (limited to 'demos/reliefs.tcl')
-rw-r--r-- | demos/reliefs.tcl | 451 |
1 files changed, 235 insertions, 216 deletions
diff --git a/demos/reliefs.tcl b/demos/reliefs.tcl index c593ee3..67dd3c4 100644 --- a/demos/reliefs.tcl +++ b/demos/reliefs.tcl @@ -5,255 +5,274 @@ if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } -set w .reliefs -catch {destroy $w} -toplevel $w -wm title $w "Zinc Relief Testbed" -wm iconname $w reliefs +namespace eval reliefDemo { + variable w .reliefs + catch {destroy $w} + toplevel $w + wm title $w "Zinc Relief Testbed" + wm iconname $w reliefs -set allReliefs {flat raised sunken groove ridge \ - roundraised roundsunken roundgroove roundridge \ - sunkenrule raisedrule} + variable allReliefs {flat raised sunken groove ridge \ + roundraised roundsunken roundgroove roundridge \ + sunkenrule raisedrule} -set defaultfont [font create -family Helvetica -size 10 -weight bold] + variable defaultfont [font create -family Helvetica -size 14 -weight normal] -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 + grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 2 -column 0 -pady 10 + grid [button $w.code -text "See Code" -command "showCode $w"] -row 2 -column 1 -pady 10 + ########################################### + # Text zone + ####################### + #################### -########################################### -# Text zone -####################### -#################### + grid [text $w.text -relief sunken -borderwidth 2 -height 8 -width 50] \ + -row 0 -column 0 -columnspan 2 -sticky ew -text $w.text -relief sunken -borderwidth 2 -height 8 -width 50 -pack $w.text -expand yes -fill both + $w.text insert end { This demo lets you play with the various relief parameters + on rectangles polygons and arcs. Some reliefs and The smooth relief + capability is only available with openGL. + You can modify the items with your mouse: -$w.text insert end { This demo lets you play with the various relief parameters -on rectangles polygons and arcs. Some reliefs and The smooth relief -capability is only available with openGL. - You can modify the items with your mouse: + Drag-Button 1 for moving Ctrl/Shft-Button 1 for Incr/Decr sides + Drag-Button 2 for zooming Ctrl/Shft-Button 2 for cycling reliefs + Drag-Button 3 for rotating Ctrl/Shft-Button 3 for Incr/Decr border} - Drag-Button 1 for moving Ctrl/Shft-Button 1 for Incr/Decr sides - Drag-Button 2 for zooming Ctrl/Shft-Button 2 for cycling reliefs - Drag-Button 3 for rotating Ctrl/Shft-Button 3 for Incr/Decr border} - -########################################### -# Zinc -########################################## -proc deg2Rad {deg} { - return [expr 3.14159 * $deg / 180.0] -} - -proc rad2Deg {rad} { - return [expr int(fmod(($rad * 180.0 / 3.14159)+360.0, 360.0))] -} - -set bw 4 -set width 60 -set lightAngle 120 -set lightAngleRad [deg2Rad $lightAngle] -set zincSize 500 - -zinc $w.zinc -width $zincSize -height $zincSize -render 1 -font 10x20 \ - -highlightthickness 0 -borderwidth 0 -relief sunken -backcolor lightgray \ - -lightangle $lightAngle -pack $w.zinc -expand t -fill both - -set topGroup [$w.zinc add group 1] - -proc polyPoints { ox oy rad n } { - set step [expr 2 * 3.14159 / $n] - for {set i 0} {$i < $n} {incr i} { - set x [expr $ox + ($rad * cos($i * $step))]; - set y [expr $oy + ($rad * sin($i * $step))]; - lappend coords $x $y; + ########################################### + # Zinc + ########################################## + proc deg2Rad {deg} { + return [expr 3.14159 * $deg / 180.0] } - lappend coords [lindex $coords 0] [lindex $coords 1] - return $coords -} - -proc makePoly {x y bw sides color group} { - global w state allReliefs width - - set relief 2 - - set g [$w.zinc add group $group] - $w.zinc translate $g $x $y - $w.zinc add curve $g [polyPoints 0 0 $width $sides] \ - -relief [lindex $allReliefs $relief] -linewidth $bw \ - -smoothrelief 1 -fillcolor $color -linecolor $color \ - -filled t -tags {subject polygon} - $w.zinc add text $g -anchor center \ - -text [lindex $allReliefs $relief] -tags {subject relief} - $w.zinc add text $g -anchor center -position {0 16} \ - -text $bw -tags {subject bw} - set state($g,sides) $sides - set state($g,relief) $relief - set state($g,bw) $bw - return $g -} - -set poly [makePoly 100 100 $bw 8 lightblue $topGroup] -set poly [makePoly [expr 100 + 2*($width + 10)] 100 $bw 8 tan $topGroup] -set poly [makePoly [expr 100 + 4*($width + 10) ] 100 $bw 8 slateblue $topGroup] - -proc lightCenter {radius angle} { - return [list [expr $radius * (1 + 0.95*cos($angle))] \ - [expr $radius * (1 - 0.95*sin($angle))]] -} - -# -# Place the light at lightAngle on the circle -$w.zinc add arc 1 {-5 -5 5 5} -filled 1 -fillcolor yellow \ - -tags light -priority 10 -eval "$w.zinc translate light [lightCenter [expr $zincSize/2] $lightAngleRad]" - -# -# Controls. -# -$w.zinc bind subject <ButtonPress-1> "press motion %x %y" -$w.zinc bind subject <ButtonRelease-1> release -$w.zinc bind subject <ButtonPress-2> "press zoom %x %y" -$w.zinc bind subject <ButtonRelease-2> release -$w.zinc bind subject <ButtonPress-3> "press mouseRotate %x %y" -$w.zinc bind subject <ButtonRelease-3> release - -$w.zinc bind polygon <Shift-ButtonPress-1> "incrPolySides 1" -$w.zinc bind polygon <Control-ButtonPress-1> "incrPolySides -1" - -$w.zinc bind subject <Shift-ButtonPress-2> "cycleRelief 1" -$w.zinc bind subject <Control-ButtonPress-2> "cycleRelief -1" -$w.zinc bind subject <Shift-ButtonPress-3> "incrBW 1" -$w.zinc bind subject <Control-ButtonPress-3> "incrBW -1" - -$w.zinc bind light <ButtonPress-1> "press lightMotion %x %y" -$w.zinc bind light <ButtonRelease-1> release - -set curX 0 -set curY 0 -set curAngle 0 - -proc press {action x y} { - global w curAngle curX curY + proc rad2Deg {rad} { + return [expr int(fmod(($rad * 180.0 / 3.14159)+360.0, 360.0))] + } - $w.zinc raise [$w.zinc group current] + variable bw 4 + variable width 60 + variable lightAngle 120 + variable lightAngleRad [deg2Rad $lightAngle] + variable zincSize 500 + + grid [zinc $w.zinc -width $zincSize -height $zincSize -render 1 -font 10x20 \ + -highlightthickness 0 -borderwidth 0 -relief sunken -backcolor lightgray \ + -lightangle $lightAngle] -row 1 -column 0 -columnspan 2 -sticky news + grid columnconfigure $w 0 -weight 1 + grid columnconfigure $w 1 -weight 1 + grid rowconfigure $w 1 -weight 2 + + variable topGroup [$w.zinc add group 1] + + proc polyPoints { ox oy rad n } { + set step [expr 2 * 3.14159 / $n] + for {set i 0} {$i < $n} {incr i} { + set x [expr $ox + ($rad * cos($i * $step))]; + set y [expr $oy + ($rad * sin($i * $step))]; + lappend coords $x $y; + } + lappend coords [lindex $coords 0] [lindex $coords 1] + return $coords + } - set curX $x - set curY $y - set curAngle [expr atan2($y, $x)] - bind $w.zinc <Motion> "$action %x %y" -} + proc makePoly {x y bw sides color group} { + variable w + variable state + variable allReliefs + variable width + + set relief 2 + + set g [$w.zinc add group $group] + $w.zinc translate $g $x $y + $w.zinc add curve $g [polyPoints 0 0 $width $sides] \ + -relief [lindex $allReliefs $relief] -linewidth $bw \ + -smoothrelief 1 -fillcolor $color -linecolor $color \ + -filled t -tags {subject polygon} + $w.zinc add text $g -anchor center \ + -text [lindex $allReliefs $relief] -tags {subject relief} + $w.zinc add text $g -anchor center -position {0 16} \ + -text $bw -tags {subject bw} + set state($g,sides) $sides + set state($g,relief) $relief + set state($g,bw) $bw + return $g + } -proc motion {x y} { - global w curX curY topGroup + variable poly [makePoly 100 100 $bw 8 lightblue $topGroup] + variable poly [makePoly [expr 100 + 2*($width + 10)] 100 $bw 8 tan $topGroup] + variable poly [makePoly [expr 100 + 4*($width + 10) ] 100 $bw 8 slateblue $topGroup] - foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \ - [list $x $y $curX $curY]] break - $w.zinc translate [$w.zinc group current] [expr $x1 - $x2] [expr $y1 - $y2] - set curX $x - set curY $y -} + proc lightCenter {radius angle} { + return [list [expr $radius * (1 + 0.95*cos($angle))] \ + [expr $radius * (1 - 0.95*sin($angle))]] + } -proc lightMotion {x y} { - global w zincSize topGroup + # + # Place the light at lightAngle on the circle + $w.zinc add arc 1 {-5 -5 5 5} -filled 1 -fillcolor yellow \ + -tags light -priority 10 + eval "$w.zinc translate light [lightCenter [expr $zincSize/2] $lightAngleRad]" + + # + # Controls. + # + $w.zinc bind subject <ButtonPress-1> "::reliefDemo::press motion %x %y" + $w.zinc bind subject <ButtonRelease-1> ::reliefDemo::release + $w.zinc bind subject <ButtonPress-2> "::reliefDemo::press zoom %x %y" + $w.zinc bind subject <ButtonRelease-2> ::reliefDemo::release + $w.zinc bind subject <ButtonPress-3> "::reliefDemo::press mouseRotate %x %y" + $w.zinc bind subject <ButtonRelease-3> ::reliefDemo::release + + $w.zinc bind polygon <Shift-ButtonPress-1> "::reliefDemo::incrPolySides 1" + $w.zinc bind polygon <Control-ButtonPress-1> "::reliefDemo::incrPolySides -1" + + $w.zinc bind subject <Shift-ButtonPress-2> "::reliefDemo::cycleRelief 1" + $w.zinc bind subject <Control-ButtonPress-2> "::reliefDemo::cycleRelief -1" + + $w.zinc bind subject <Shift-ButtonPress-3> "::reliefDemo::incrBW 1" + $w.zinc bind subject <Control-ButtonPress-3> "::reliefDemo::incrBW -1" + + $w.zinc bind light <ButtonPress-1> "::reliefDemo::press lightMotion %x %y" + $w.zinc bind light <ButtonRelease-1> ::reliefDemo::release + + variable curX 0 + variable curY 0 + variable curAngle 0 + + proc press {action x y} { + variable w + variable curAngle + variable curX + variable curY + + $w.zinc raise [$w.zinc group current] + + set curX $x + set curY $y + set curAngle [expr atan2($y, $x)] + bind $w.zinc <Motion> "::reliefDemo::$action %x %y" + } - set radius [expr $zincSize/2] - if { $x < 0 } { - set x 0 - } elseif { $x > $zincSize } { - set x $zincSize + proc motion {x y} { + variable w + variable curX + variable curY + variable topGroup + + foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \ + [list $x $y $curX $curY]] break + $w.zinc translate [$w.zinc group current] [expr $x1 - $x2] [expr $y1 - $y2] + set curX $x + set curY $y } + + proc lightMotion {x y} { + variable w + variable zincSize + variable topGroup + + set radius [expr $zincSize/2] + if { $x < 0 } { + set x 0 + } elseif { $x > $zincSize } { + set x $zincSize + } - set angle [expr acos(double($x-$radius)/$radius)] - if { $y > $radius } { - set angle [expr - $angle] + set angle [expr acos(double($x-$radius)/$radius)] + if { $y > $radius } { + set angle [expr - $angle] + } + $w.zinc treset light + eval "$w.zinc translate light [lightCenter [expr $zincSize/2] $angle]" + $w.zinc configure -lightangle [rad2Deg $angle] } - $w.zinc treset light - eval "$w.zinc translate light [lightCenter [expr $zincSize/2] $angle]" - $w.zinc configure -lightangle [rad2Deg $angle] -} - -proc zoom {x y} { - global w 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; + proc zoom {x y} { + variable w + variable curX + variable 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 current $sx $sx + + set curX $x + set curY $y } - set sx [expr 1.0 + (double($x - $curX) / $maxX)] - set sy [expr 1.0 + (double($y - $curY) / $maxY)] - $w.zinc scale current $sx $sx - set curX $x - set curY $y -} - -proc mouseRotate {x y} { - global w curAngle - - set lAngle [expr atan2($y, $x)] - $w.zinc rotate current [expr $lAngle - $curAngle] - set curAngle $lAngle -} - -proc release {} { - global w + proc mouseRotate {x y} { + variable w + variable curAngle - bind $w.zinc <Motion> {} -} + set lAngle [expr atan2($y, $x)] + $w.zinc rotate current [expr $lAngle - $curAngle] + set curAngle $lAngle + } -proc incrPolySides {incr} { - global w state width + proc release {} { + variable w - set g [$w.zinc group current] - incr state($g,sides) $incr - if { $state($g,sides) < 3 } { - set state($g,sides) 3 + bind $w.zinc <Motion> {} } - set points [polyPoints 0 0 $width $state($g,sides)] - $w.zinc coords $g.polygon $points -} + proc incrPolySides {incr} { + variable w + variable state + variable width -proc cycleRelief {incr} { - global w state allReliefs + set g [$w.zinc group current] + incr state($g,sides) $incr + if { $state($g,sides) < 3 } { + set state($g,sides) 3 + } - set g [$w.zinc group current] - incr state($g,relief) $incr - if { $state($g,relief) < 0 } { - set state($g,relief) [expr [llength $allReliefs] - 1] - } elseif { $state($g,relief) >= [llength $allReliefs] } { - set state($g,relief) 0 + set points [polyPoints 0 0 $width $state($g,sides)] + $w.zinc coords $g.polygon $points } - set rlf [lindex $allReliefs $state($g,relief)] - $w.zinc itemconfigure $g.polygon -relief $rlf - $w.zinc itemconfigure $g.relief -text $rlf -} -proc incrBW {incr} { - global w state + proc cycleRelief {incr} { + variable w + variable state + variable allReliefs + + set g [$w.zinc group current] + incr state($g,relief) $incr + if { $state($g,relief) < 0 } { + set state($g,relief) [expr [llength $allReliefs] - 1] + } elseif { $state($g,relief) >= [llength $allReliefs] } { + set state($g,relief) 0 + } + set rlf [lindex $allReliefs $state($g,relief)] + $w.zinc itemconfigure $g.polygon -relief $rlf + $w.zinc itemconfigure $g.relief -text $rlf + } - set g [$w.zinc group current] - incr state($g,bw) $incr - if { $state($g,bw) < 0 } { - set state($g,bw) 0 + proc incrBW {incr} { + variable w + variable state + + set g [$w.zinc group current] + incr state($g,bw) $incr + if { $state($g,bw) < 0 } { + set state($g,bw) 0 + } + $w.zinc itemconfigure $g.polygon -linewidth $state($g,bw) + $w.zinc itemconfigure $g.bw -text $state($g,bw) } - $w.zinc itemconfigure $g.polygon -linewidth $state($g,bw) - $w.zinc itemconfigure $g.bw -text $state($g,bw) } |