From f6018b2e4b184a2ec9eca7bbd3e2532cc4ed17ed Mon Sep 17 00:00:00 2001 From: lecoanet Date: Tue, 7 Mar 2000 13:16:09 +0000 Subject: *** empty log message *** --- sandbox/testicon.tcl | 39 +++++++++++++++++++++++++++++++++++++-- sandbox/testpoly.tcl | 32 ++++++++++++++++---------------- sandbox/testrelief.tcl | 45 +++++++++++++++++++++++++++++++++++++++++++++ sandbox/testzinc.pl | 2 +- sandbox/zinc.tcl | 28 +++++++++++++++++++++++++--- 5 files changed, 124 insertions(+), 22 deletions(-) create mode 100644 sandbox/testrelief.tcl diff --git a/sandbox/testicon.tcl b/sandbox/testicon.tcl index 5c790e4..d9789ec 100644 --- a/sandbox/testicon.tcl +++ b/sandbox/testicon.tcl @@ -5,8 +5,10 @@ package require Img set top 1 -image create photo penguin -file /usr/X11R6/include/X11/pixmaps/xpenguin_color.xpm -set mask "/usr/X11R6/include/X11/bitmaps/fvwm.xbm" +image create photo penguin -file xpenguin.png +image create photo bouton -file bouton.xpm +image create photo boutond -file bouton-down.xpm +set mask "fvwm.xbm" set r [zinc .r -backcolor gray -relief sunken] pack .r -expand t -fill both @@ -52,6 +54,9 @@ set x2 500.0 set y2 -300.0 imageicon $x2 $y2 $view penguin center +.r add icon $view -image bouton -position "$x2 $y2" -anchor center +.r add icon $view -image boutond -position [list [expr $x2 + 50] $y2] -anchor center + # # Clip # @@ -62,4 +67,34 @@ set clip [.r add rectangle $view "50 -300 600 -10" -filled t \ .r lower $clip .r itemconfigure $view -clip $clip +.r addtag test withtype icon +.r bind test "" "testpress %x %y" +.r bind test "" testrelease + +proc testpress {lx ly} { + global testx testy + set testx $lx + set testy $ly + .r bind test "" "testmotion %x %y" +} + +proc testmotion {lx ly} { + global testx testy + set it [.r find withtag test] + if {$it != ""} { + set it [.r group [lindex $it 0]] + } + set res [.r transform $it "$lx $ly $testx $testy"] + set nx [lindex $res 0] + set ny [lindex $res 1] + set ox [lindex $res 2] + set oy [lindex $res 3] + .r translate current [expr $nx - $ox] [expr $ny - $oy] + set testx $lx + set testy $ly +} +proc testrelease {} { + .r bind test "" "" +} + source controls.tcl diff --git a/sandbox/testpoly.tcl b/sandbox/testpoly.tcl index 1d64a5e..7cb367d 100644 --- a/sandbox/testpoly.tcl +++ b/sandbox/testpoly.tcl @@ -13,22 +13,22 @@ set arrow "8 10 6" # Cap Join Filled Border Relief Title # set show {\ - {round round f t flat JoinRound}\ - {round bevel f t flat JoinBevel}\ - {round miter f t flat JoinMiter}\ - {butt round f t flat CapButt}\ - {projecting round f t flat CapProjecting}\ - {round round f t sunken Sunken}\ - {round round f t raised Raised}\ - {round round f t groove Groove}\ - {round round f t ridge Ridge}\ - {round round t t sunken FilledSunken}\ - {round round t t raised FilledRaised}\ - {round round t t groove FilledGroove}\ - {round round t t ridge FilledRidge}\ - {round round f f flat Marker}\ - {round round t f flat Fill}\ - {round round t t flat FillBorder}} + {round round f 1 flat JoinRound}\ + {round bevel f 1 flat JoinBevel}\ + {round miter f 1 flat JoinMiter}\ + {butt round f 1 flat CapButt}\ + {projecting round f 1 flat CapProjecting}\ + {round round f 1 sunken Sunken}\ + {round round f 1 raised Raised}\ + {round round f 1 groove Groove}\ + {round round f 1 ridge Ridge}\ + {round round t 1 sunken FilledSunken}\ + {round round t 1 raised FilledRaised}\ + {round round t 1 groove FilledGroove}\ + {round round t 1 ridge FilledRidge}\ + {round round f 0 flat Marker}\ + {round round t 0 flat Fill}\ + {round round t 1 flat FillBorder}} image create photo logo -file /usr/share/toccata/images/logo.gif #image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm diff --git a/sandbox/testrelief.tcl b/sandbox/testrelief.tcl new file mode 100644 index 0000000..be28d8f --- /dev/null +++ b/sandbox/testrelief.tcl @@ -0,0 +1,45 @@ +#!/usr/bin/wish -f + +load tkzinc3.1.so + +set top 1 +set lw 8 + +set r [zinc .r -backcolor gray -relief sunken -lightangle 155] +pack .r -expand t -fill both +.r configure -width 1024 -height 800 +.r scale $top 1 -1 + +set view [.r add group $top -tags controls] + +proc polypoints { ox oy rad n startangle } { + set step [expr 2 * 3.14159 / $n] + set startangle [expr $startangle*3.14159/180] + set coords "" + for {set i 0} {$i < $n} {incr i} { + set x [expr $ox + ($rad * cos($i * $step + $startangle))]; + set y [expr $oy + ($rad * sin($i * $step + $startangle))]; + lappend coords $x $y; + } + lappend coords [lindex $coords 0] [lindex $coords 1] + return $coords +} + +set poly [ .r add curve $view [polypoints 200 -200 100 40 0] \ + -relief raised -linewidth $lw \ + -fillcolor lightblue -filled t] + +set poly [ .r add curve $view [polypoints 450 -200 100 40 0] \ + -relief raised -linewidth $lw \ + -fillcolor tan -filled t] + +set poly [ .r add curve $view [polypoints 700 -200 100 40 0] \ + -relief sunken -linewidth $lw \ + -fillcolor tan -filled t] + +set poly [ .r add curve $view [polypoints 200 -450 100 4 -45] \ + -relief sunken -linewidth $lw \ + -fillcolor tan -filled t] + + +source "controls.tcl" diff --git a/sandbox/testzinc.pl b/sandbox/testzinc.pl index 28efa43..8770fff 100644 --- a/sandbox/testzinc.pl +++ b/sandbox/testzinc.pl @@ -3,7 +3,7 @@ use Tk; $mw = MainWindow->new; -$logo = $mw->Photo(-file => "/home/etienne/images/logo.gif"); +$logo = $mw->Photo(-file => "logo.gif"); # $canvas = $mw->Canvas; # $canvas->pack(-expand => t, -fill => 'both'); # $text = $canvas->create('text', 30, 20, -width => 45, -text => "hello"); diff --git a/sandbox/zinc.tcl b/sandbox/zinc.tcl index 0151046..9e8bc78 100644 --- a/sandbox/zinc.tcl +++ b/sandbox/zinc.tcl @@ -1,14 +1,19 @@ #!/usr/bin/wish -f load tkzinc3.1.so -package require Img +#package require Img set top 1 +#memory info +#memory trace on +#memory validate on + image create photo logo -file /usr/share/toccata/images/logo.gif image create photo logosmall -file /usr/share/toccata/images/logo-small.gif -#image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm +#image create photo bois -file texture-bois1.xpm +#set r [zinc .r -backcolor gray -relief sunken -tile bois] set r [zinc .r -backcolor gray -relief sunken] pack .r -expand t -fill both set scale 1.0 @@ -16,7 +21,7 @@ set centerX 0.0 set centerY 0.0 set zincWidth 800 set zincHeight 500 -.r configure -width $zincWidth -height $zincHeight +#.r configure -width $zincWidth -height $zincHeight #.r configure -drawbboxes t set view [.r add group $top -tags "controls"] @@ -36,6 +41,7 @@ button .rc.shrink -text "Shrink" \ button .rc.reset -text "Reset" \ -command {set scale 1.0; set centerX 0.0; set centerY 0.0; \ updateTransform .r} +button .rc.quit -text "Quit" -command "exit" grid .rc.up -row 0 -column 2 -sticky ew grid .rc.down -row 2 -column 2 -sticky ew grid .rc.left -row 1 -column 1 @@ -43,6 +49,7 @@ grid .rc.right -row 1 -column 3 grid .rc.expand -row 1 -column 4 grid .rc.shrink -row 1 -column 0 grid .rc.reset -row 1 -column 2 -sticky ew +grid .rc.quit -row 3 -column 2 pack .rc bind .r "ZincStyleConfig %W %w %h" @@ -254,5 +261,20 @@ bind .r "finditems %x %y" .r bind all <1> { if {! [catch {.r find withtag current} item] } { \ puts "<1> in $item" } else { puts "None" } } +# +#for {set j 0} {$j < 20} {incr j} { +# memory info +# for {set i 0} {$i < 10} {incr i} { +# set a($i) [.r add icon 1 -image logo] +# set b($i) [.r add rectangle 1 "10 10 1000 1000" -filled t -tile logosmall] +# set c($i) [.r add curve 1 "10 10 10 100 100 100" -filled t -tile logosmall] +# } +# for {set i 0} {$i < 10} {incr i} { +# .r remove $a($i) +# .r remove $b($i) +# .r remove $c($i) +# } +#} + source "controls.tcl" -- cgit v1.1