# This software is distributed under the Lesser General Public License
#
# inspector/bends_ctl.tcl
#
# Control for editing edge bends
#
#------------------------------------------ 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/bends_ctl.tcl,v $
# $Author: forster $
# $Revision: 1.6 $
# $Date: 1999/02/25 16:26:15 $
# $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 Flatbutton

namespace eval ::GT::IS::bends_ctl {

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

    #================================================== Creation
    
    proc create { IS ctl attrs } {
	define_attrs $IS $ctl $attrs { line joinstyle }

	frame $ctl

	create_widgets  $IS $ctl
	create_layout   $IS $ctl
	create_bindings $IS $ctl
	
	return $ctl
    }

    proc create_widgets { IS ctl } {
	create_widgets_bends     $IS $ctl [frame $ctl.bends]
	create_widgets_buttons   $IS $ctl [frame $ctl.buttons]
	create_widgets_joinstyle $IS $ctl [frame $ctl.joinstyle]
    }

    proc create_widgets_joinstyle { IS ctl frame } {

	foreach joinstyle { miter round bevel } {

	    set but $frame.$joinstyle
	    
 	    Flatbutton::create $but \
 		-image [GT::get_image inspector/joinstyle/$joinstyle] \
		-command [namespace code \
			      "ev_joinstyle_changed $IS $ctl $joinstyle"]

	    GT::tooltips $but "Joinstyle: $joinstyle"
	}
    }

    proc create_widgets_bends { IS ctl frame } {

	listbox $frame.lb \
	    -yscrollcommand "$frame.sb set" \
	    -height 4 -width 0
	
	scrollbar $frame.sb \
	    -command "$frame.lb yview" \
	    -takefocus 0

	# improve Windows look
	
	global tcl_platform
	if { $tcl_platform(platform) == "windows" } {
	    
	    $frame configure \
		-relief sunken \
		-bd 2 \
		-highlightthickness 1
	    
	    $frame.lb configure \
		-bg white \
		-bd 0 \
		-highlightthickness 0
	}
    }

    proc create_widgets_buttons { IS ctl frame } {
	
	# numentries
	
	Numentry::create $frame.x \
	    -textvariable [namespace current]::_Selection($ctl,x)
	
	Numentry::create $frame.y \
	    -textvariable [namespace current]::_Selection($ctl,y)

	# buttons
	
	foreach { name tooltip } {
	    add		"Add bend"
	    delete	"Delete bend"
	    up		"Move bend up"
	    down	"Move bend down"
	} {
	    set but $frame.$name
	    
	    button $but \
		-bd 1 \
		-image [GT::get_image inspector/button/$name] \
		-command [namespace code "ev_$name $IS $ctl"] \

	    GT::tooltips $but $tooltip
	}
    }

    proc create_layout { IS ctl } {

	set j $ctl.joinstyle
	set be $ctl.bends
	set b $ctl.buttons

	# overall layout

	pack $be $b $j -side top -fill x

	# $ctl.bends
	
	grid columnconfigure $be 0 -weight 1

	grid $be.lb $be.sb \
	    -sticky nwse

	# $ctl.buttons
	
	grid columnconfigure $b { 0 1 2 3 } -weight 1
	
	grid  $b.x    -          $b.y   -        -sticky nwse
	grid  $b.add  $b.delete  $b.up  $b.down  -sticky nwse

	# $ctl.joinstyle

	grid columnconfigure $j { 0 1 2 } -weight 1

	grid $j.miter $j.round $j.bevel \
	    -sticky nwse

	global tcl_platform
	if { $tcl_platform(platform) == "windows" } {
	    grid $b.add $b.delete $b.up $b.down \
		-padx 1 -pady 1
	    grid $j.miter $j.round $j.bevel \
		-padx 1 -pady 1
	}
    }
    
    proc create_bindings { IS ctl } {
	variable _Selection

	# bindings

	foreach { event binding } {
	    <Button-1>		focus
	    <ButtonRelease-1>	select
	    <KeyRelease>	select
	    <Shift-Key-Up>	up
	    <Shift-Key-Down>	down
	    <Key-plus>		add
	    <Key-KP_Add>	add
	    <Key-minus>		delete
	    <Key-KP_Subtract>	delete
	} {
	    bind $ctl.bends.lb $event \
		[namespace code "ev_$binding $IS $ctl"]
	}

	# traces
	
	trace var _Selection($ctl,x) w \
	    [namespace code "ev_change $IS $ctl ;\#"]
	trace var _Selection($ctl,y) w \
	    [namespace code "ev_change $IS $ctl ;\#"]
	
	return $ctl
    }

    #================================================== Update
    
    proc update { IS ctl } {
	update_joinstyle $IS $ctl
	update_bends $IS $ctl
    }
    
    proc update_joinstyle { IS ctl } {
	bind_attrs $IS $ctl

	set j $ctl.joinstyle
	
	foreach widget {
	    bevel miter round
	} {
	    
	    $j.$widget deselect
	    $j.$widget configure -state disabled

	    if { $::GT::IS::_HaveEdges($IS) } {
		
		$j.$widget configure -state normal
		
		if { $widget == $joinstyle } {
		    $j.$widget select
		}
	    }
	}
    }
    proc update_bends { IS ctl } {
	bind_attrs $IS $ctl

	# bends := line without endpoints

	set len [llength $line]
	set bends [lrange $line 2 [expr $len - 3]]

	# insert into listbox
	
	$ctl.bends.lb delete 0 end
	foreach { x y } $bends {
	    $ctl.bends.lb insert end "($x, $y)"
	}

	# show selection

	show_selection $IS $ctl 
    }

    #================================================== Event Handling

    proc ev_focus { IS ctl } {
	focus $ctl.bends.lb
    }

    proc ev_select { IS ctl } {
	variable _Selection

	set idx [$ctl.bends.lb curselection]

	if { $idx != {} } {
	    set_selection $IS $ctl $idx
	}
    }

    proc ev_change { IS ctl } {
	variable _Selection
	bind_attrs $IS $ctl

	if { ![info exists _Selection($ctl,notrace)] } {

	    set idx $_Selection($ctl)
	    set x $_Selection($ctl,x)
	    set y $_Selection($ctl,y)
	    
	    set line [lreplace $line [expr 2*$idx+2] [expr 2*$idx+3] $x $y]
	}
    }
    
    proc ev_add { IS ctl } {
	variable _Selection
	bind_attrs $IS $ctl

	if { $line != {} } {

	    set idx $_Selection($ctl)

	    GT::pset { x1 y1 x2 y2 } \
		[lrange $line [expr 2*$idx] [expr 2*$idx + 3]]

	    set x [expr ($x1+$x2)/2.0]
	    set y [expr ($y1+$y2)/2.0]	
	    
	    set line [linsert $line [expr 2*$idx + 2] $x $y ]
	    
	    show_selection $IS $ctl
	}	
    }
    
    proc ev_delete { IS ctl } {
	variable _Selection
	bind_attrs $IS $ctl

	if { [llength $line] >= 6 } {
	    
	    set idx $_Selection($ctl)

	    set line [lreplace $line [expr 2*$idx + 2] [expr 2*$idx + 3]]

	    show_selection $IS $ctl
	}
    }
    
    proc ev_up { IS ctl } {
	variable _Selection

	set idx $_Selection($ctl)

	if { $idx > 0 } {
	    exchange_bends $IS $ctl [expr $idx - 1]
	    set _Selection($ctl) [expr $idx - 1]
	}
    }
    
    proc ev_down { IS ctl } {
	variable _Selection

	set idx $_Selection($ctl)

	if { $idx < [expr [$ctl.bends.lb size] -1 ] } {
	    exchange_bends $IS $ctl $idx
	    set _Selection($ctl) [expr $idx + 1]
	}
    }

    proc ev_joinstyle_changed { IS ctl style } {
	bind_attrs $IS $ctl

	set joinstyle $style
    }

    #================================================== Utilities
    
    proc exchange_bends { IS ctl idx } {
	bind_attrs $IS $ctl
	
	GT::pset { x1 y1 x2 y2 } \
	    [lrange $line [expr 2*$idx + 2] [expr 2*$idx + 5]]

	set line [lreplace $line [expr 2*$idx + 2] [expr 2*$idx + 5] \
		       $x2 $y2 $x1 $y1]
    }

    proc show_selection { IS ctl } {
	variable _Selection

	if { [info exists _Selection($ctl)] } {
	    set_selection $IS $ctl $_Selection($ctl)
	} else {
	    set_selection $IS $ctl 0
	}
    }
    
    proc set_selection { IS ctl idx } {
	variable _Selection
	bind_attrs $IS $ctl
	
	set size [$ctl.bends.lb size]
	if { $idx >= $size	} { set idx [expr $size - 1]	}
	if { $idx < 0 		} { set idx 0			}

	set _Selection($ctl) $idx
	
	if { $size > 0 } {
	    
	    $ctl.bends.lb selection set $idx
	    $ctl.bends.lb activate $idx
	    $ctl.bends.lb see active

	    set x [lindex $line [expr 2*$idx + 2]]
	    set y [lindex $line [expr 2*$idx + 3]]

	    $ctl.buttons.x configure -state normal
	    $ctl.buttons.y configure -state normal
	    $ctl.buttons.delete configure -state normal
	    
	} else {

	    set x ""
	    set y ""

	    $ctl.buttons.x configure -state disabled
	    $ctl.buttons.y configure -state disabled
	    $ctl.buttons.delete configure -state disabled
	}

	set _Selection($ctl,notrace) 1
	set _Selection($ctl,x) $x
	set _Selection($ctl,y) $y
	unset _Selection($ctl,notrace)

	if { [llength $line] > 0 } {
	    $ctl.buttons.add configure -state normal
	} else {
	    $ctl.buttons.add configure -state disabled
	}
	
	if { $idx > 0 } {
	    $ctl.buttons.up configure -state normal
	} else {
	    $ctl.buttons.up configure -state disabled
	}
	
	if { $idx < [expr $size -1] } {
	    $ctl.buttons.down configure -state normal
	} else {
	    $ctl.buttons.down configure -state disabled
	}
    }
}

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