# This software is distributed under the Lesser General Public License
#
# inspector/shape_ctl.tcl
#
# Control for modifying node shapes
#
#------------------------------------------ CVS
#
# CVS Headers -- The following headers are generated by the CVS
# version control system. Note that especially the attribute
# Author is not necessarily the author of the code.
#
# $Source: /home/br/CVS/graphlet/lib/graphscript/inspector/shape_ctl.tcl,v $
# $Author: forster $
# $Revision: 1.11 $
# $Date: 1999/03/02 18:02:01 $
# $Locker:  $
# $State: Exp $
#
#------------------------------------------ CVS
#
# (C) University of Passau 1995-1999, Graphlet Project
#     Author: Michael Forster

package require Graphlet
package provide Graphscript [gt_version]

package require Numentry
package require Flatbutton

namespace eval ::GT::IS::shape_ctl {

    namespace export create
    namespace import ::GT::IS::define_attrs
    namespace import ::GT::IS::bind_attrs

    variable PI 3.14159265358979323846

    #================================================== Inspector interface
    
    proc create { IS ctl attrs } {

	define_attrs $IS $ctl $attrs \
	    { type start extent style line image }
	
	frame $ctl
	
	pack [create_type_selector $IS $ctl [lindex $attrs 0]] -fill x

	::GT::IS::create_sep $ctl.sep ""
	create_arc_control   $IS $ctl
	create_poly_control  $IS $ctl
	create_image_control $IS $ctl
	create_buttons       $IS $ctl
	
	return $ctl
    }
    
    proc create_type_selector { IS ctl attr } {
	bind_attrs $IS $ctl

	set typesel [frame $ctl.type]
	
	grid columnconfigure $typesel { 0 1 2 3 4 5 } -weight 1 

	set nr 0
	foreach val { rectangle oval arc polygon line image } {
	    
	    grid [Flatbutton::create $typesel.$val \
		      -image [GT::get_image inspector/type/$val] \
		      -command [namespace code "ev_type_changed $IS $ctl $val"] \
		     ]\
		-column $nr \
		-row 0

	    GT::tooltips $typesel.$val $val
	    
	    incr nr
	}

	$typesel.line configure -state disabled

	return $typesel
    }
    
    proc create_arc_control { IS ctl } {
	variable ::GT::IS::_Options

	# canvas

	set c [::GT::IS::create_node_canvas $ctl.arc oval]
	bind $c <Configure> [namespace code "update_arc $IS $ctl"]

	# arc
	
	$c create arc \
	    0 0 0 0 \
	    -fill $_Options(color,template,fill) \
	    -outline $_Options(color,template,outline) \
	    -tag arc

	$c bind arc <Button-1> \
	    [namespace code "ev_arc_start_drag $IS $ctl %x %y"]
	$c bind arc <B1-Motion> \
	    [namespace code "ev_arc_drag $IS $ctl %x %y"]

	# markers
	
	foreach m { m0 m1 m2 } {
	    
	    $c create rectangle \
		0 0 0 0 \
		-fill $_Options(color,marker,fill) \
		-outline $_Options(color,marker,outline) \
		-tag $m
	    
	    $c bind $m <B1-Motion> \
		[namespace code "ev_arc_drag_marker $IS $ctl $m %x %y"]
	}

	return $c
    }		

    proc create_poly_control { IS ctl } {
	variable ::GT::IS::_Options	
	
	# init variables

	variable _PolyMarkers
	set _PolyMarkers($ctl) {}
	
	# canvas
	
	set c [::GT::IS::create_node_canvas $ctl.poly]
	bind $c <Configure> [namespace code "update_poly $IS $ctl"]

	# polygon
	
	$c create polygon \
	    0 0 0 0 0 0 \
	    -fill $_Options(color,template,fill) \
	    -tag polygon

	return $c
    }

    proc create_image_control { IS ctl } {

	button $ctl.image \
	    -command [namespace code "ev_select_image $IS $ctl"] \
	    -width 1
    }

    proc create_buttons { IS ctl } {
	
	frame $ctl.buttons
	grid columnconfigure $ctl.buttons { 0 1 2 3 } -weight 1

	# numentries

	set xvar [namespace current]::_Selection($ctl,x)
	set yvar [namespace current]::_Selection($ctl,y)

	trace var $xvar w [namespace code "ev_current_changed $IS $ctl ;# "]
	trace var $yvar w [namespace code "ev_current_changed $IS $ctl ;# "]

	grid [Numentry::create $ctl.buttons.x \
		  -textvariable $xvar \
		  -width 3 \
		 ] \
	    -sticky nwse \
	    -row 0 -column 0 -columnspan 2
	
	grid [Numentry::create $ctl.buttons.y \
		  -textvariable $yvar \
		  -width 3 \
		 ] \
	    -sticky nwse \
	    -row 0 -column 2 -columnspan 2

	# buttons
	
	set buttons [list \
			 0 rotate_left		"ev_rotate $IS $ctl 5" \
			 1 rotate_right		"ev_rotate $IS $ctl -5" \
			 2 flip_vertical	"ev_flip $IS $ctl 1 -1" \
			 3 flip_horizontal	"ev_flip $IS $ctl -1 1" \
			]
	
	foreach { column name command } $buttons {
	    
	    grid [button $ctl.buttons.$name \
		      -image [GT::get_image inspector/button/$name] \
		      -command [namespace code $command] \
		      -bd 1 \
		     ] \
		-sticky nwse \
		-row 1 -column $column
	}
	
# 	grid [button $ctl.buttons.predef \
# 		  -text "Predefined" \
# 		  -command [namespace code "get_predefined $IS $ctl"] \
# 		  -state disabled \
# 		  -bd 1 \
# 		 ] \
# 	    -sticky nwse \
# 	    -row 2 -column 0 -columnspan 4

	global tcl_platform
	if { $tcl_platform(platform) == "windows" } {
	    eval grid [grid slaves $ctl.buttons] \
		-padx 1 -pady 1
	}
	
	return $ctl.buttons
    }

    proc update { IS ctl } {
	bind_attrs $IS $ctl
	variable ::GT::IS::_HaveNodes

	if { $_HaveNodes($IS) } {
	    foreach t { rectangle oval arc polygon line image } {
		$ctl.type.$t configure -state normal
		if { $type == $t } {
		    $ctl.type.$t select
		} else {
		    $ctl.type.$t deselect
		}
	    }
	} {
	    foreach t { rectangle oval arc polygon line image } {
		$ctl.type.$t configure -state disabled
		$ctl.type.$t deselect
	    }
	}

	switch -regexp -- $type {
	    arc {
		$ctl.sep.text configure -text "Shape"
		pack $ctl.sep -fill x -padx 2
		pack $ctl.arc -fill x
		pack $ctl.buttons -fill x -side bottom

		pack forget $ctl.poly
		pack forget $ctl.image
		
		update_arc $IS $ctl
	    }
	    line|polygon {
		$ctl.sep.text configure -text "Shape"
		pack $ctl.sep -fill x -padx 2
		pack $ctl.poly -fill x
		pack $ctl.buttons -fill x -side bottom

		pack forget $ctl.image
		pack forget $ctl.arc
		
		update_poly $IS $ctl
	    }
	    image {
		$ctl.sep.text configure -text "Image"
		pack $ctl.sep -fill x -padx 2
		pack $ctl.image -fill x -anchor c

		pack forget $ctl.arc
		pack forget $ctl.poly
		pack forget $ctl.buttons

		update_image $IS $ctl
	    }
	    default {
		pack forget $ctl.sep
		pack forget $ctl.arc
		pack forget $ctl.poly
		pack forget $ctl.image
		pack forget $ctl.buttons
	    }
	}
    }
    
    proc update_poly { IS ctl } {
	bind_attrs $IS $ctl

	# numentries
	
	$ctl.buttons.x configure -min -1 -max 1 -step 0.01 -acceleration 5
	$ctl.buttons.y configure -min -1 -max 1 -step 0.01 -acceleration 5

	# markers
	
	GT::pset { bx by iw ih } [::GT::IS::get_canvas_coords $ctl.poly]

	set_marker_coords_rel $IS $ctl $line $bx $by $iw $ih
    }

    proc update_arc { IS ctl } {
	bind_attrs $IS $ctl
	variable ::GT::IS::_Options

	set end [expr $start + $extent]

	# calculate canvas dimensions

	GT::pset { bx by iw ih } [::GT::IS::get_canvas_coords $ctl.arc]
	GT::pset { mw mh } $_Options(marker_size)
	
	# set markers

	set m1x [expr $bx + $iw/2*(1 + cos([to_rad $start]))]
	set m1y [expr $by + $ih/2*(1 - sin([to_rad $start]))]
	
	set m2x [expr $bx + $iw/2*(1 + cos([to_rad $end]))]
	set m2y [expr $by + $ih/2*(1 - sin([to_rad $end]))]

        switch $style {
	    arc {
		set alpha [expr $start + $extent/2.0]
		set m0x [expr $bx + $iw/2*(1 + cos([to_rad $alpha]))]
		set m0y [expr $by + $ih/2*(1 - sin([to_rad $alpha]))]
	    }
	    chord {
		set m0x [expr ($m1x + $m2x) / 2]
		set m0y [expr ($m1y + $m2y) / 2]
	    }
	    pieslice {
		set m0x [expr $bx + $iw/2.0]
		set m0y [expr $by + $ih/2.0]
	    }
	}

	$ctl.arc coords arc \
	    $bx $by \
	    [expr $iw + $bx] [expr $ih + $by]
	
	$ctl.arc itemconfigure arc \
	    -start $start \
	    -extent $extent \
	    -style $style

	foreach m { m0 m1 m2 } {
	    $ctl.arc coords $m \
		[expr [set ${m}x] - $mw/2] [expr [set ${m}y] - $mh/2] \
		[expr [set ${m}x] + $mw/2] [expr [set ${m}y] + $mh/2]
	}

	# numentries
	
	variable _Selection
	set _Selection($ctl,notrace) 1
	set _Selection($ctl,x) [normalize $start]
	set _Selection($ctl,y) [normalize [expr $extent+$start]]
	unset _Selection($ctl,notrace)

	$ctl.buttons.x configure -min -1 -max 360 -step 1
	$ctl.buttons.y configure -min -1 -max 360 -step 1
    }

    proc update_image { IS ctl } {
	bind_attrs $IS $ctl

	if { $image != {} } {

	    set width [image width $image]
	    set space [winfo width $ctl.image]

	    if { $space < $width } {
		
		set img $ctl/img
		set factor [expr ($width+$space-1)/$space]
		
		catch { image delete $img }
		image create photo $img

		$img copy $image -subsample $factor $factor
		
	    } else {
		set img $image
	    }
	    
	    
	    $ctl.image configure \
		-image $img \
		-bd 2 -relief groove
	    
	} else {
	    $ctl.image configure \
		-image {} \
		-text "Browse..." \
		-bd 1 -relief raised
	}
    }
    
    #================================================== Event handling

    proc ev_current_changed { IS ctl } {
	variable _Selection
	variable _PolyMarkers
	bind_attrs $IS $ctl

	if { [info exists _Selection($ctl,notrace)] } {
	    return
	}
	
	switch -regexp -- $type {
	    polygon|line {
	    
		set m $_Selection($ctl)

		set sel_coords [list $_Selection($ctl,x) $_Selection($ctl,y)]
		
		GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]
		GT::pset { mx my } [rel_to_abs $sel_coords $x $y $w $h ]
		
		set _PolyMarkers($ctl,$m,x) $mx
		set _PolyMarkers($ctl,$m,y) $my
		
		update_poly_markers $IS $ctl
		update_poly_line $IS $ctl
	    }

	    arc {
		set st $_Selection($ctl,x)
		set ext [expr $_Selection($ctl,y)-$st]
	    
		set start [normalize $st]
		set extent [normalize $ext]
	    }
	}
    }	
    
    proc ev_type_changed { IS ctl val } {
	bind_attrs $IS $ctl

	set type $val
    }
    
    proc ev_poly_insert_marker { IS ctl m mx my } {
	set new_m [create_marker $IS $ctl $m]
	set_marker_pos $IS $ctl $new_m $mx $my
    }
    
    proc ev_poly_delete_marker { IS ctl m } {
	bind_attrs $IS $ctl
	variable _PolyMarkers
	
	if { ($type == "polygon" && [llength $_PolyMarkers($ctl)] <= 3) ||
	     ($type == "line" && [llength $_PolyMarkers($ctl)] <= 2) } {
	     return
	}	

	destroy_marker $IS $ctl $m
	
	update_poly_markers $IS $ctl
	update_poly_line $IS $ctl
    }

    proc ev_poly_move_marker { IS ctl m mx my } {

	GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]

	if { $mx < $x		} { set mx $x		}
	if { $mx > $x+$w	} { set mx [expr $x+$w]	}
	if { $my < $y		} { set my $y		}
	if { $my > $y+$h	} { set my [expr $y+$h]	}

	set_marker_pos $IS $ctl $m $mx $my
    }
    
    proc ev_poly_marker_menu { IS ctl m X Y } {
	variable _LastM $m

	set menu $ctl.marker_menu

	if { ![winfo exists $menu] } {
	    set menu [menu $menu -tearoff false]

	    $menu add command \
		-label "Delete Point" \
		-command [namespace code "ev_poly_delete_marker $IS $ctl \$_LastM"]
	}

	tk_popup $menu $X $Y
    }

    proc ev_poly_line_menu { IS ctl m X Y x y } {
	variable _LastX $x
	variable _LastY $y
	variable _LastM $m

	set menu $ctl.line_menu

	if { ![winfo exists $menu] } {
	    set menu [menu $menu -tearoff false]

	    $menu add command \
		-label "Insert Point" \
		-command [namespace code "ev_poly_insert_marker $IS $ctl \$_LastM \$_LastX \$_LastY"]
	}

	tk_popup $menu $X $Y
    }

    proc ev_poly_select_marker { IS ctl m } {
	set_selection $IS $ctl $m
    }

    proc ev_arc_start_drag { IS ctl x y } {
	
	GT::pset { bx by iw ih } [::GT::IS::get_canvas_coords $ctl.arc]

	set dx [expr $x - $iw/2.0 - $bx]
	set dy [expr $ih/2.0 + $by - $y]
	
	variable _LastAngle [xy_to_angle $dx $dy]
    }
    
    proc ev_arc_drag { IS ctl x y } {
	variable _LastAngle
	bind_attrs $IS $ctl
	
	GT::pset { bx by iw ih } [::GT::IS::get_canvas_coords $ctl.arc]

	set dx [expr $x - $iw/2.0 - $bx]
	set dy [expr $ih/2.0 + $by - $y]

	set angle [xy_to_angle $dx $dy]

	set start [expr $start + $angle - $_LastAngle]

	set _LastAngle $angle
    }

    proc ev_arc_drag_marker { IS ctl m x y } {
	bind_attrs $IS $ctl
	
	GT::pset { bx by iw ih } [::GT::IS::get_canvas_coords $ctl.arc]

	set dx [expr $x - $iw/2.0 - $bx]
	set dy [expr $ih/2.0 + $by - $y]
	
	if { $m != "m0" } {

	    set alpha [xy_to_angle $dx $dy]

	    if { $m == "m1" } {
		set extent [normalize [expr $start + $extent - $alpha]]
		set start [normalize $alpha]
	    } else {
		set extent [normalize [expr $alpha - $start]]
	    }

	} else {

	    set alpha [to_rad [expr ($start + $extent/2.0)]]
	    set l [expr cos([to_rad $extent]/2)*$iw/2]
	    
	    set chord_point [to_cartesian $alpha $l]
	    set arc_point [to_cartesian $alpha $iw/2]
	    set pieslice_point { 0 0 }

	    set pieslice_dist [dist $pieslice_point [list $dx $dy]]
	    set arc_dist [dist $arc_point [list $dx $dy]]
	    set chord_dist [dist $chord_point [list $dx $dy]]

	    if { $pieslice_dist <= $arc_dist &&
		 $pieslice_dist <= $chord_dist } {
		set newstyle pieslice
	    } elseif { $arc_dist <= $chord_dist } {
		set newstyle arc
	    } else {
		set newstyle chord
	    }

	    if { $newstyle != $style } {
		set style $newstyle
	    }
	}

	update $IS $ctl
    }

    proc ev_flip { IS ctl fx fy } {
	bind_attrs $IS $ctl
	flip_$type $IS $ctl $fx $fy
    }
    
    proc ev_rotate { IS ctl angle } {
	bind_attrs $IS $ctl
	rotate_$type $IS $ctl $angle
    }

    proc ev_select_image { IS ctl } {
	bind_attrs $IS $ctl

	set file [tk_getOpenFile \
		      -filetypes {
			  {"Compuserve Images"	".gif"}
			  {"Windows Bitmaps"	".bmp"}
			  {"X11 Bitmaps"	".xbm"}
			  {"All Files"		"*"}
		      } \
		      -parent $IS \
		      -title "Open Image" \
		     ]

	
	if {$file != ""} {
	    
	    if {[catch {GT::get_image $file} err]} {
		tk_dialog \
		    $IS.error \
		    "File Error" \
		    "Could not load image \"$file\": $err" \
		    error \
		    0 "Ok"
	    } else {
		set image $file
	    }
	}
    }

    #================================================== Polygon Markers

    proc create_marker { IS ctl { before {} } } {
	variable _PolyMarkers
	variable ::GT::IS::_Options
	variable _Selection

	# create canvas items
	
	set m [$ctl.poly create rectangle \
		   0 0 0 0 \
		   -fill $_Options(color,marker,fill) \
		   -outline $_Options(color,marker,outline) \
		   -tag [list markers markers_and_lines ] \
		  ]

	set l [$ctl.poly create line \
		   0 0 0 0 \
		   -fill $_Options(color,marker,outline) \
		   -tag [list lines markers_and_lines line-$m ] \
		  ]

	# ensure that all markers are visible
	
	$ctl.poly raise markers

	# update _PolyMarkers($ctl)
	
	if { $before == {} } {
	    lappend _PolyMarkers($ctl) $m
	} else {
	    set pos [lsearch $_PolyMarkers($ctl) $before]
	    set _PolyMarkers($ctl) [linsert $_PolyMarkers($ctl) $pos $m]
	}
	set _PolyMarkers($ctl,$m,x) 0
	set _PolyMarkers($ctl,$m,y) 0
	
	# bindings
	
	$ctl.poly bind $m <Button-1>		[namespace code "ev_poly_select_marker $IS $ctl $m            "]
	$ctl.poly bind $m <Double-Button-1>	[namespace code "ev_poly_delete_marker $IS $ctl $m            "]
	$ctl.poly bind $m <B1-Motion>		[namespace code "ev_poly_move_marker   $IS $ctl $m %x %y      "]
	$ctl.poly bind $m <Button-2>		[namespace code "ev_poly_delete_marker $IS $ctl $m            "]
	$ctl.poly bind $m <Button-3>		[namespace code "ev_poly_marker_menu   $IS $ctl $m %X %Y      "]

	$ctl.poly bind $l <Double-Button-1>	[namespace code "ev_poly_insert_marker $IS $ctl $m %x %y      "]
	$ctl.poly bind $l <Button-2>		[namespace code "ev_poly_insert_marker $IS $ctl $m %x %y      "]
	$ctl.poly bind $l <Button-3>		[namespace code "ev_poly_line_menu     $IS $ctl $m %X %Y %x %y"]

	return $m
    }

    proc destroy_marker { IS ctl m } {
	variable _PolyMarkers
	variable _Selection

	# delete canvas items
	
	$ctl.poly delete $m
	$ctl.poly delete line-$m

	# update _PolyMarkers($ctl)
	
	GT::ldelete _PolyMarkers($ctl) $m
	foreach entry [array names _PolyMarkers $ctl,$m,*] {
	    unset _PolyMarkers($entry)
	}
	if { $_Selection($ctl) == $m } {
	    set_selection $IS $ctl [lindex $_PolyMarkers($ctl) 0]
	}
    }

    proc update_poly_markers { IS ctl } {
	variable _PolyMarkers
	variable _Valid
	variable _Selection
	variable ::GT::IS::_Options
	bind_attrs $IS $ctl

	if {($type == "polygon" && [llength $_PolyMarkers($ctl)] < 3) ||
	    ($type == "line" && [llength $_PolyMarkers($ctl)] < 2) ||
	    !$_Valid($ctl) } {
	    return
	}
	
	set l {}
	set count 0
	foreach m $_PolyMarkers($ctl) {

	    set mx $_PolyMarkers($ctl,$m,x)
	    set my $_PolyMarkers($ctl,$m,y)

	    GT::pset { mw mh } $_Options(marker_size)

	    $ctl.poly coords $m \
		[expr $mx - $mw/2] [expr $my - $mh/2] \
		[expr $mx + $mw/2] [expr $my + $mh/2]

	    if { $count == 0 } {
		if { $type == "polygon" } {

		    set last [lindex $_PolyMarkers($ctl) end]
		    
		    $ctl.poly coords line-$m \
			$_PolyMarkers($ctl,$last,x) \
			$_PolyMarkers($ctl,$last,y) \
			$mx $my
		} else {
		     $ctl.poly coords line-$m 0 0 0 0
		}
	    } else {
		$ctl.poly coords line-$m $lmx $lmy $mx $my
	    }

	    if { $_Selection($ctl) == $m } {
		$ctl.poly itemconfigure $m \
		    -fill $_Options(color,marker,fill,selected) \
		    -outline $_Options(color,marker,outline,selected)

		set _Selection($ctl,notrace) 1
		GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]
		GT::pset { _Selection($ctl,x) _Selection($ctl,y) } [abs_to_rel [list $mx $my] $x $y $w $h]
		unset _Selection($ctl,notrace)
		
	    } else {
		$ctl.poly itemconfigure $m \
		    -fill $_Options(color,marker,fill) \
		    -outline $_Options(color,marker,outline)
	    }
	    
	    
	    set lmx $mx
	    set lmy $my
	    
	    lappend l $mx $my
	    incr count
	}
	
	if ![GT::lempty $l] {
	    if { $type == "polygon" } {
		eval $ctl.poly coords polygon $l
	    } else {
		$ctl.poly coords polygon 0 0 0 0 0 0
	    }
	}
    }

    proc update_poly_line { IS ctl } {
	bind_attrs $IS $ctl

	GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]

	set line [scale_to_fit [get_marker_coords_rel $IS $ctl $x $y $w $h]]
    }

    proc set_selection { IS ctl m } {
	variable _Selection
	variable _PolyMarkers

	GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]
	GT::pset { mx my } [abs_to_rel [list $_PolyMarkers($ctl,$m,x) $_PolyMarkers($ctl,$m,y)] $x $y $w $h]

	set _Selection($ctl,notrace) 1
	set _Selection($ctl) $m
	set _Selection($ctl,x) $mx
	set _Selection($ctl,y) $my
	unset _Selection($ctl,notrace)
	
	update_poly_markers $IS $ctl
    }

    proc set_marker_pos { IS ctl m mx my } {
	variable _PolyMarkers

	set _PolyMarkers($ctl,$m,x) $mx
	set _PolyMarkers($ctl,$m,y) $my

	set_selection $IS $ctl $m

	GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]
	set_marker_coords_rel $IS $ctl [scale_to_fit [get_marker_coords_rel $IS $ctl $x $y $w $h]] $x $y $w $h
	
	update_poly_markers $IS $ctl
	update_poly_line $IS $ctl
    }

    proc get_marker_coords_abs { IS ctl } {
	variable _PolyMarkers

	set marker_coords {}
	foreach m $_PolyMarkers($ctl) {
	    set mx $_PolyMarkers($ctl,$m,x)
	    set my $_PolyMarkers($ctl,$m,y)

	    lappend marker_coords $mx $my
	}
	return $marker_coords
    }

    proc set_marker_coords_abs { IS ctl marker_coords } {
	bind_attrs $IS $ctl
	variable _Selection
	variable _PolyMarkers
	variable _Valid

	set point_count [expr [llength $marker_coords]/2]
	set marker_count [llength $_PolyMarkers($ctl)]

	if { $type == "polygon" } {
	    set_valid $IS $ctl [expr $point_count >= 3]
	} else {
	    set_valid $IS $ctl [expr $point_count >= 2]
	}
	
	if { ! $_Valid($ctl) } {
	    return
	}

	if { $point_count > $marker_count } {
	    for { set i 0 } { $i < $point_count - $marker_count } { incr i } {
		create_marker $IS $ctl
	    }
	}

	if { $marker_count > $point_count } {
	    for { set i 0 } { $i < $marker_count - $point_count } { incr i } {
		destroy_marker $IS $ctl [lindex $_PolyMarkers($ctl) end]
	    }
	}

	foreach { mx my } $marker_coords m $_PolyMarkers($ctl) {

	    set _PolyMarkers($ctl,$m,x) $mx
	    set _PolyMarkers($ctl,$m,y) $my
	}

	# selection

	if { ![info exists _Selection($ctl)] } {
	   set_selection $IS $ctl $m
	}

	update_poly_markers $IS $ctl
    }

    proc get_marker_coords_rel { IS ctl x y w h } {
	return [abs_to_rel [get_marker_coords_abs $IS $ctl] $x $y $w $h]
    }

    proc set_marker_coords_rel { IS ctl marker_coords x y w h } {
	set_marker_coords_abs $IS $ctl [rel_to_abs $marker_coords $x $y $w $h]
    }

    #================================================== Polygon Utilities
    
    proc set_valid { IS ctl valid } {
	variable _Valid

	set _Valid($ctl) $valid
	if { ! $valid } {

	    foreach item [$ctl.poly find withtag markers_and_lines] {
		$ctl.poly coords $item -10 -10 -10 -10
	    }

	    $ctl.poly coords polygon 0 0 0 0 0 0
	}
    }

    # convert relative absolute coordinates
    proc rel_to_abs { rel x y w h } {

	set abs {}
	foreach { rx ry } $rel {
	    
	    set ax [expr $x + $w * (1.0+$rx)/2.0]
	    set ay [expr $y + $h * (1.0+$ry)/2.0]

	    lappend abs $ax $ay
	}
	return $abs
    }

    # convert absolute to relative coordinates
    proc abs_to_rel { abs x y w h } {

	set rel {}
	foreach { ax ay } $abs {
	    
	    set rx [expr 2.0 * ($ax - $x) / $w - 1]
	    set ry [expr 2.0 * ($ay - $y) / $h - 1]

	    set rx [expr round($rx*100)*0.01]
	    set ry [expr round($ry*100)*0.01]
	    
	    lappend rel $rx $ry
	}
	return $rel
    }

    # scale coords to fit into the range (-1, 1)
    proc scale_to_fit { coords } {

	GT::pset { minx miny maxx maxy } { 1000 1000 -1000 -1000 }

	foreach { x y } $coords {
	    if { $x < $minx } { set minx $x }
	    if { $y < $miny } { set miny $y }
	    if { $x > $maxx } { set maxx $x }
	    if { $y > $maxy } { set maxy $y }
	}

	set result {}
	foreach { x y } $coords {
	    lappend result \
		[expr ($x-$minx)/($maxx-$minx)*2.0-1] \
		[expr ($y-$miny)/($maxy-$miny)*2.0-1]
	}

	return $result
    }
    
    proc flip_line { IS ctl fx fy } {
	flip_polygon $IS $ctl $fx $fy
    }

    proc rotate_line { IS ctl angle } {
	rotate_polygon $IS $ctl $angle
    }
    
    proc flip_polygon { IS ctl fx fy } {
	GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]
	
	set old [get_marker_coords_rel $IS $ctl $x $y $w $h]
	    
	set new {}
	foreach { mx my } $old {
	    lappend new [expr $mx*$fx] [expr $my*$fy]
	}
	
	set_marker_coords_rel $IS $ctl $new $x $y $w $h

	update_poly_markers $IS $ctl
	update_poly_line $IS $ctl
    }

    proc rotate_polygon { IS ctl angle } {
	variable PI

	set angle [to_rad $angle]
	
	GT::pset { x y w h } [::GT::IS::get_canvas_coords $ctl.poly]
	
	set old [get_marker_coords_rel $IS $ctl $x $y $w $h]
	
	set new {}
	foreach { mx my } $old {
	    
	    set length [expr sqrt($mx*$mx + $my*$my)]
	    
	    if { $my == 0 } {
		set new_angle [expr $angle + (($mx > 0) ? $PI/2 : -$PI/2)]
	    } else {
		set new_angle [expr $angle + atan($mx/$my)]
		if { $my < 0 } {
		    set new_angle [expr $new_angle + $PI];
		}
	    }
	    
	    lappend new \
		[expr sin($new_angle) * $length] \
		[expr cos($new_angle) * $length]
	    }	
	
	set new [scale_to_fit $new]
	
	set_marker_coords_rel $IS $ctl $new $x $y $w $h

	update_poly_markers $IS $ctl
	update_poly_line $IS $ctl
    }

    #================================================== Arc Utilities

    # return 0 <= alpha < 360, rounded to one decimal
    proc normalize { alpha } {

	set alpha [expr round($alpha*10)/10.0]
	
	while { $alpha < 0 } {
	    set alpha [expr $alpha + 360]
	}
	while { $alpha >= 360 } {
	    set alpha [expr $alpha - 360]
	}
	
	return $alpha
    }

    # convert degree to radiant
    proc to_rad { alpha } {
	variable PI 

	return [expr $alpha * $PI/180]
    }

    # convert radiant to degree
    proc to_deg { alpha } {
	variable PI 
	
	return [expr $alpha * 180/$PI]
    }

    # convert polar coordinates to cartesian coordinates
    proc to_cartesian { alpha l } {
	return [list \
		    [expr cos($alpha) * $l] \
		    [expr sin($alpha) * $l] \
		   ]
    }

    # calculate the distance between points p1 an p2
    proc dist { p1 p2 } {
	return [expr sqrt( \
			       pow([lindex $p1 0]-[lindex $p2 0],2) +\
			       pow([lindex $p1 1]-[lindex $p2 1],2) \
			       )]
    }

    # calculate angle from cartesian coordinates
    proc xy_to_angle { dx dy }  {

	if { $dx == 0 } {
	    if { $dy > 0 } {
		return 90
	    } else {
		return 270
	    }
	} else {
	    set alpha [to_deg [expr atan($dy/$dx)]]
	    if { $dx < 0 } {
		set alpha [expr $alpha + 180]
	    }
	    return $alpha
	}
    }

    proc flip_arc { IS ctl fx fy } {
	bind_attrs $IS $ctl
	
	if { $fy == -1 } {
	    set start [normalize [expr -($start+$extent)]]
	}
	if { $fx == -1 } {
	    set start [normalize [expr 180-($start+$extent)]]
	}
    }

    proc rotate_arc { IS ctl angle } {
	bind_attrs $IS $ctl

	set start [normalize [expr $start+$angle]]
    }
    
    #================================================== Generic utilitities

    proc get_predefined { IS ctl } {
	bind_attrs $IS $ctl
	
	set top [toplevel $ctl.get_predef]

	if { $type == "polygon" } {
	
	    set i 1
	    foreach line {
		{ -1 -1 1 -1 1 1 -1 1 }
		{ 0 -1 1 0 0 1 -1 0 }
		{ -0.3333 -1 0.3333 -1 0.3333 -0.3333 1 -0.3333 1 0.3333 0.3333 0.3333 0.3333 1 -0.3333 1 -0.3333 0.3333 -1 0.3333 -1 -0.3333 -0.3333 -0.3333 }
		{ -0.5 -1 0 -0.5 0.5 -1 1 -0.5 0.5 0 1 0.5 0.5 1 0 0.5 -0.5 1 -1 0.5 -0.5 0 -1 -0.5 }
		{ 0 -1 0.1 -0.1 1 0 0.1 0.1 0 1 -0.1 0.1 -1 0 -0.1 -0.1 }
		{ -1 1 -0.7 -1 1 -1 0.7 1 }
		{ -1 -0.5 0 -0.5 0 -1 1 0 0 1 0 0.5 -1 0.5 }
		{ 1 -0.5 0 -0.5 0 -1 -1 0 0 1 0 0.5 1 0.5 }
		{ -0.5 1 -0.5 0 -1 0 0 -1 1 0 0.5 0 0.5 1 }
		{ -0.5 -1 -0.5 0 -1 0 0 1 1 0 0.5 0 0.5 -1 }
	    } {
		set c [canvas $top.c$i -width 50 -height 50]

		eval $c create polygon \
		    [rel_to_abs $line 5 5 40 40] \
		    -outline black -fill white
		
		pack $c
		
		incr i
	    }
	} elseif { $type == "arc" } {

	    set i 1
	    foreach { Style } { pieslice chord arc } {
		foreach { Start } { 0 90 180 270 } {
		    foreach { Extent } { 90 180 270 } {

			set c [canvas $top.c$i -width 50 -height 50]

			eval $c create arc \
			    5 5 40 40 \
			    -style $Style \
			    -start $Start \
			    -extent $Extent \
			    -outline black -fill white
			
			pack $c
		
			incr i
		    }
		}
	    }
	}
    }
}

#---------------------------------------------------------------------------
#   Set emacs variables
#---------------------------------------------------------------------------
# ;;; Local Variables: ***
# ;;; mode: tcl ***
# ;;; tcl-indent-level: 4 ***
# ;;; End: ***
#---------------------------------------------------------------------------
#   end of file
#---------------------------------------------------------------------------
