Portage depuis perl

1 files changed, 191 insertions, 0 deletions

diff --git a/demos/contours.tcl b/demos/contours.tcl
new file mode 100644
index 0000000..07fa3c3
--- /dev/null
+++ b/demos/contours.tcl
@@ -0,0 +1,191 @@
+# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
+# tcl version by Jean-Paul Imbert imbert@cena.fr
+
+if {![info exists zincDemo]} {
+    error "This script should be run from the zinc-widget demo."
+}
+
+set w .contours
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Curve contours Demonstration"
+wm iconname $w Curve
+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
+
+# The explanation displayed when running this demo
+text  $w.text -relief sunken -borderwidth 2 -setgrid true -height 9
+pack $w.text -expand yes -fill both
+
+$w.text insert end "All visibles items are made by combining 2 items using contours:
+ - the firebrick curve1 has been holed using a addhole with a circle,
+ - the lightblue curve2 has been mickey-moused by adding two circles,
+ - the yellow curve3 is the union with a disjoint circle,
+ - the grey curve4 is combined with 7 circles, with positive -fillrule.
+The following operations are possible:
+ - Mouse Button 1 for dragging objects.
+ - Mouse Button 1 for dragging the black handle and
+    modifying the grey curve contour."
+
+# Creating the zinc widget
+zinc $w.zinc -width 600 -height 500 -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+
+# Creation of 2 items NOT visible, but used for creating visible
+# curves[1-5] with more than one contours.
+# The center of these 2 items is 200,100
+
+set curve0 [$w.zinc add curve 1 { {300 0}  {400 100 c}  {300 200}  {200 300 c}  {100 200}  {0 100 c} {100 0} } -closed 1 -visible 0 -filled 1]
+set cercle100  [$w.zinc add arc 1 {130 30 280 180} -visible 0]
+			  
+
+# cloning curve0 as curve1 and moving it
+set  curve1 [$w.zinc clone $curve0 -visible 1 -fillcolor firebrick1]
+# adding a  ifference' contour to the curve1
+$w.zinc contour $curve1 add +1 $cercle100
+
+
+# cloning curve0 as curve2 and moving it
+# creating a curve without contour to control contour clockwise/counterclockwise
+set curve2 [$w.zinc add curve 1 {} -closed 1 -filled 1 -visible 1 -fillcolor lightblue2 -fillrule positive]
+$w.zinc contour $curve2 add -1 $curve0 
+## why must the flag be -1 and not -1 !?
+
+# adding the left ear of mickey mouse!
+$w.zinc translate $curve2 100 90
+
+# adding the right ear of mickey mouse!
+$w.zinc contour $curve2 add +1 $cercle100
+$w.zinc translate $curve2 -200 0
+
+# adding an 'intersection' contour to the curve2
+$w.zinc contour $curve2 add +1 $cercle100
+# ... translate to make it more visible
+$w.zinc translate $curve2 320 20
+
+# cloning curve0 as curve3 and moving it
+set curve3  [$w.zinc clone $curve0 -visible 1 -fillcolor yellow3]
+$w.zinc translate $curve3 0 290
+
+# adding an  nion' contour to the curve3
+$w.zinc contour $curve3 add +1 $cercle100
+# ... translate to make it more visible
+$w.zinc translate $curve3 -130 0
+
+    
+
+
+# cloning curve0 as curve4 and moving it slightly
+set curve4 [$w.zinc clone $curve0 -visible 1 -fillcolor grey50 -tags grouped -fillrule positive]
+                          # the tag "grouped" is used for both curve4 and
+			  # a handle (see just below)
+			  # It is used for translating both easily
+
+
+set index  2; ## index of the vertex associated to the handle
+set coord  [$w.zinc coords $curve4 0 $index]
+set x [lindex $coord 0]
+set y [lindex $coord 1]
+set handle [$w.zinc add rectangle 1 "[expr $x-5] [expr $y-5] [expr $x+5] [expr $y+5]" -fillcolor black -filled 1 -tags {grouped}]
+			
+
+# adding a 'difference' contour to the curve4
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped 110 0
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped -220 0
+$w.zinc contour $curve4 add +1 $cercle100
+$w.zinc translate grouped 10 80
+$w.zinc contour $curve4 add -1 $cercle100
+$w.zinc translate grouped 0 -10
+$w.zinc contour $curve4 add +1 $cercle100
+
+$w.zinc translate grouped 200 80
+$w.zinc contour $curve4  add +1 $cercle100
+$w.zinc translate grouped -350 0
+$w.zinc contour $curve4 add +1 $cercle100
+
+$w.zinc translate grouped 350 250
+#$zinc->lower(grouped);
+
+# Deleting no more usefull items: curve0 and cercle10:
+$w.zinc remove $curve0 $cercle100
+
+$w.zinc raise $curve1
+
+# adding drag and drop callback to each visible curve!
+foreach item "$curve1 $curve2 $curve3 $curve4" {
+    # Some bindings for dragging the items
+    $w.zinc bind $item <1> "itemStartDrag $item %x %y" 
+    $w.zinc bind $item <B1-Motion> "itemDrag $item %x %y"
+    # <ButtonRelease-1> release
+}
+
+# adding drag and drop on curve4 which also moves handle
+$w.zinc bind $curve4  <ButtonPress-1> {press $curve4 motionWithHandle}
+$w.zinc bind $curve4, <ButtonRelease-1> release
+
+# adding drag and drop on handle which also modify curve4
+$w.zinc bind handle  <ButtonPress-1> {press $handle  moveHandle}
+$w.zinc bind handle  <ButtonRelease-1> release
+
+# callback for starting a drag
+set x_orig ""
+set y_orig ""
+
+proc itemStartDrag {item x y} {
+    global x_orig y_orig
+    set x_orig $x
+    set y_orig $y
+}
+
+# Callback for moving an item
+proc itemDrag {item x y} {
+    global x_orig y_orig
+    global w
+    $w.zinc translate $item  [expr $x-$x_orig] [expr $y-$y_orig];
+    set x_orig  $x;
+    set y_orig  $y;
+}
+
+# Callback for moving an item and its handle
+proc motionWithHandle {item} {
+    global x_orig
+    global y_orig
+    set ev   [$w.zinc XEvent]
+    set x_orig $ev->x;
+    set y_orig $ev->y;
+
+    set  tag [$w.zinc itemcget $item -tags]
+    $w.zinc translate $tag  [epxr $x-$x_orig] [expr $y-$y_orig]
+    set x_orig $x;
+    set y_orig $y;
+}
+
+# Callback for moving the handle and modifying curve4
+# this code is far from being generic. Only for demonstrating how we can
+# modify a contour with a unique handle!
+proc moveHandle {handle} {
+    global x_orig
+    global y_orig
+    set ev   [$w.zinc XEvent]
+    set x_orig $ev->x;
+    set y_orig $ev->y;
+
+    $w.zinc translate $handle  [expr $x-$x_orig] [expr $y-$y_orig];
+
+    set  ($vertxX,$vertxY) [$w.zinc coords $curve4 0 $index]
+    $w.zinc coords $curve4 0 $index  "[expr $vertxX+($x-$x_orig)] [expr $vertxY+($y-$y_orig)]"
+    set x_orig  $x
+    set y_orig  $y
+}
+
+
+proc release {} {
+    $w.zinc Tk::bind('<Motion>', '');
+}