# This software is distributed under the Lesser General Public License
#
# inspector/linestyle_ctl.tcl
#
# Control for editing edge linestyle
#
#------------------------------------------ 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/linestyle_ctl.tcl,v $
# $Author: forster $
# $Revision: 1.7 $
# $Date: 1999/03/02 14:48:54 $
# $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::linestyle_ctl {

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

    proc create { IS ctl attrs } {
	define_attrs $IS $ctl $attrs { capstyle arrow tlength olength width}

	# creation

	frame $ctl
	
	foreach linestyle {butt arrow_last projecting arrow_both round arrow_first } {
	    set attr [lindex $attrs 1]
	    
	    Flatbutton::create $ctl.l$linestyle \
		-image [GT::get_image inspector/linestyle/$linestyle] \
		-command [namespace code "ev_changed $IS $ctl $linestyle"]
	}

#	::GT::IS::create_sep $ctl.sep "Arrow Shape" 
#	create_arrow_control $IS $ctl

	# layout
	
	grid columnconfigure $ctl { 0 1 } -weight 1
	
	grid $ctl.lbutt		$ctl.larrow_last
	grid $ctl.lprojecting	$ctl.larrow_both
	grid $ctl.lround	$ctl.larrow_first

	eval grid [grid slaves $ctl] \
	    -sticky nwse

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

	return $ctl
    }

    proc create_arrow_control { IS ctl } {

	set c [canvas $ctl.arrow -width 0 -height 0 -highlightthickness 0]
	bind $c <Configure> [namespace code "update_arrowshape $IS $ctl"]

	$c create line 0 0 0 0 \
	    -tag line
	
	return $c
    }

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

	switch $style {
	    arrow_first { set arrow first }
	    arrow_last  { set arrow last }
	    arrow_both  { set arrow both }
	    default     { set arrow none; set capstyle $style }
	}
    }

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

	
	if { $arrow == "none" || $arrow == {} } {
	    set style $capstyle
	} else {
	    set style arrow_$arrow
	}

# 	if { $_HaveEdges($IS) } {

# 	    grid $ctl.sep \
# 		-columnspan 3 \
# 		-padx 2 \
# 		-sticky nwse
	    
# 	    grid $ctl.arrow \
# 		-columnspan 3 \
# 		-sticky nwse
	    
# 	    update_arrowshape $IS $ctl
# 	} else {
# 	    grid forget $ctl.sep $ctl.arrow
# 	}
	
	foreach widget {
	    larrow_last larrow_first larrow_both lbutt lprojecting lround
	} {	
	    $ctl.$widget deselect
	    if { $_HaveEdges($IS) } {
		$ctl.$widget configure -state normal
		if { $widget == "l$style" } {
		    $ctl.$widget select
		}
	    } else {
		$ctl.$widget configure -state disabled
	    }
	}
    }

    proc update_arrowshape { IS ctl } {
	bind_attrs $IS $ctl

	GT::pset { x y w h } [::GT::IS::init_ctl_coords $IS $ctl.arrow]
	
	$ctl.arrow coords line \
	    $x [expr $y + $h/2.0] \
	    [expr $x+$w] [expr $y + $h/2.0]

	$ctl.arrow itemconfigure line \
	    -width 10 \
	    -arrow last \
	    -arrowshape [ list \
			      [expr $tlength*5] \
			      [expr $olength*5] \
			      [expr $width*5] \
			     ]
    }
}

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