From e6a05dbef707dc10e546ef8fef8fc2a8b7d805bf Mon Sep 17 00:00:00 2001 From: cvs2svn Date: Mon, 24 Jan 2005 15:46:33 +0000 Subject: This commit was manufactured by cvs2svn to create branch 'POSTSCRIPT'. --- demos/reliefs.tcl | 278 ------------------------------------------------------ 1 file changed, 278 deletions(-) delete mode 100644 demos/reliefs.tcl (limited to 'demos/reliefs.tcl') diff --git a/demos/reliefs.tcl b/demos/reliefs.tcl deleted file mode 100644 index 67dd3c4..0000000 --- a/demos/reliefs.tcl +++ /dev/null @@ -1,278 +0,0 @@ -# $Id$ -# this simple demo has been developped by P.Lecoanet - -if {![info exists zincDemo]} { - error "This script should be run from the zinc-widget demo." -} - -namespace eval reliefDemo { - variable w .reliefs - catch {destroy $w} - toplevel $w - wm title $w "Zinc Relief Testbed" - wm iconname $w reliefs - - variable allReliefs {flat raised sunken groove ridge \ - roundraised roundsunken roundgroove roundridge \ - sunkenrule raisedrule} - - variable defaultfont [font create -family Helvetica -size 14 -weight normal] - - 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 - ####################### - #################### - - grid [text $w.text -relief sunken -borderwidth 2 -height 8 -width 50] \ - -row 0 -column 0 -columnspan 2 -sticky ew - - $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} - - - ########################################### - # 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))] - } - - 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 - } - - 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 - } - - 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] - - 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 "::reliefDemo::press motion %x %y" - $w.zinc bind subject ::reliefDemo::release - $w.zinc bind subject "::reliefDemo::press zoom %x %y" - $w.zinc bind subject ::reliefDemo::release - $w.zinc bind subject "::reliefDemo::press mouseRotate %x %y" - $w.zinc bind subject ::reliefDemo::release - - $w.zinc bind polygon "::reliefDemo::incrPolySides 1" - $w.zinc bind polygon "::reliefDemo::incrPolySides -1" - - $w.zinc bind subject "::reliefDemo::cycleRelief 1" - $w.zinc bind subject "::reliefDemo::cycleRelief -1" - - $w.zinc bind subject "::reliefDemo::incrBW 1" - $w.zinc bind subject "::reliefDemo::incrBW -1" - - $w.zinc bind light "::reliefDemo::press lightMotion %x %y" - $w.zinc bind light ::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 "::reliefDemo::$action %x %y" - } - - 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] - } - $w.zinc treset light - eval "$w.zinc translate light [lightCenter [expr $zincSize/2] $angle]" - $w.zinc configure -lightangle [rad2Deg $angle] - } - - 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 - } - - proc mouseRotate {x y} { - variable w - variable curAngle - - set lAngle [expr atan2($y, $x)] - $w.zinc rotate current [expr $lAngle - $curAngle] - set curAngle $lAngle - } - - proc release {} { - variable w - - bind $w.zinc {} - } - - proc incrPolySides {incr} { - variable w - variable state - variable width - - set g [$w.zinc group current] - incr state($g,sides) $incr - if { $state($g,sides) < 3 } { - set state($g,sides) 3 - } - - set points [polyPoints 0 0 $width $state($g,sides)] - $w.zinc coords $g.polygon $points - } - - 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 - } - - 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) - } -} -- cgit v1.1