# This software is distributed under the Lesser General Public License
#
# inspector/utils.tcl
#
# Various Utilities for the inspector
#
#------------------------------------------ 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/utils.tcl,v $
# $Author: forster $
# $Revision: 1.14 $
# $Date: 1999/03/01 16:58:31 $
# $Locker:  $
# $State: Exp $
#
#------------------------------------------ CVS
#
# (C) University of Passau 1995-1999, Graphlet Project
#     Author: Michael Forster

package require Graphlet
package provide Graphscript [gt_version]

namespace eval ::GT::IS {

    namespace export \
	define_attrs bind_attrs \
	items_for_attr \
	read_attr write_attrs \
	disable_update enable_update update_enabled

    #================================================== Attribute bindings

    #
    # define_attrs/bind_attrs:
    #   associate locally used names to the really modified, rather
    #   complicate attribute variables for the attributes attrs. This
    #   way the same control type can be used for different attribute
    #   sets.
    #   Use define_attrs to define the bindings and bind_attrs to use
    #   them.
    #
    
    proc define_attrs { IS ctl attrs names } {
	variable _BindCode

	if [info exists _BindCode($ctl)] {
	    return
	}
	
	set _BindCode($ctl) {}
	
	foreach attr $attrs name $names {
	    
	    set _BindCode($ctl) \
		[concat \
		     $_BindCode($ctl) \
		     [list \
			  upvar \#0 ::GT::IS::_Value($IS,$attr) $name \
			 ] \
		    ]
	}
    }
    
    proc bind_attrs { IS ctl } {
	variable _BindCode
	uplevel 1 $_BindCode($ctl)
    }
    
    #================================================== read/write
    
    proc read_attr { IS attr } {
	global GT
	variable _Value
	variable _Constraint
	variable _DefaultValue

	set editor [winfo parent $IS]
	set graph $GT($editor,graph)
	set items [items_for_attr $IS $attr]

	set value [do_read_attrs $graph $items $attr]

	disable_update $IS $attr
	set _Value($IS,$attr) $value
	enable_update $IS $attr
    }

    proc do_read_attrs { g items attr } {
	variable _DefaultValue
	global GT_options

	GT::pset { attrSection attrType attrName } [split $attr "-"]

	foreach item $items {

	    switch -regexp $attr {

		"^b-label_graphics-font$" {
		    set newvalue [$g get $item label_graphics -font]

		    if { $newvalue == {} } {
			set newvalue $GT_options(system_default_font)
		    }
		}

		"^b-label_graphics-font_size$" {
		    set newvalue [$g get $item label_graphics -font_size]

		    if { $newvalue == 0 } {
			set newvalue $GT_options(system_default_font_size)
		    }
		}

		"^b-label_graphics-font_style$" {
		    set newvalue [$g get $item label_graphics -font_style]

		    if { $newvalue == {} } {
			set newvalue $GT_options(system_default_font_style)
		    }
		}

		"^e--(source|target)_anchor$" {
		    set end [string range $attr 3 8]
		    
		    set function [$g get $item -${end}_function]
		    set port [$g get $item -${end}_port]

		    if { $port == {} } {
			if { $function == "None" } {
			    set newvalue "Explicit"
			} else {
			    set newvalue $function
			}
		    } else {
			set newvalue $port
		    }
		}
		
		"^n-graphics-line$" {

		    set type [$g get $item graphics -type]

		    if { $type == "polygon" || $type == "line" } {
		    
			set x [$g get $item graphics -x]
			set y [$g get $item graphics -y]
			set w [$g get $item graphics -w]
			set h [$g get $item graphics -h]

			set line [$g get $item graphics -line]

			set newvalue {}
			foreach { abs_x abs_y } $line {
				
			    set rel_x [expr 2.0* ($abs_x - $x) / $w]
			    set rel_y [expr 2.0* ($abs_y - $y) / $h]

			    lappend newvalue $rel_x $rel_y
			}
		    } else {
			set newvalue {}
		    }
		}

		"^b-(label_)?graphics-stipple$" {
		    set newvalue [$g get $item $attrType -$attrName]

		    if { $newvalue == {} } {
			set newvalue "gray100"
		    }
		}
		
		"^.--" {
		    set newvalue [$g get $item -$attrName]
		}
	    
		default {
		    set newvalue [$g get $item $attrType -$attrName]
		}
	    }

	    
	    if { ![info exists value] } {
		set value $newvalue
	    } elseif { $value != $newvalue } {
		set value {}
	    }
	}

	if { ![info exists value] || $value == {} } {
	    set value $_DefaultValue($attr)
	}

	return $value
    }
    
    proc write_attrs { IS attrs } {
	global GT
	variable _Value
	
	set editor [winfo parent $IS]
	set g $GT($editor,graph)

	foreach attr $attrs {
	    
	    set items [items_for_attr $IS $attr]
	    set value $_Value($IS,$attr)

	    if { ![update_enabled $IS $attr] || $items == {} } {
		continue
	    }

	    GT::pset { - attrType attrName } [split $attr "-"]
	    switch -regexp $attr {

		"^e--(source|target)_anchor$" {
		    set end [string range $attr 3 8]
		    
		    switch -regexp $value {
			"^Explicit$" {
			    GT::action $editor set_attr $items \
				-${end}_port {} \
				-${end}_function "None"
			}
			"^(Orthogonal|Next middle|Next corner)$" {
			    GT::action $editor set_attr $items \
				-${end}_port {} \
				-${end}_function $value
			}
			default {
			    GT::action $editor set_attr $items \
				-${end}_port $value
			}
		    }
		}
		
		"^n-graphics-line$" {

		    foreach item $items {
			set x [$g get $item graphics -x]
			set y [$g get $item graphics -y]
			set w [$g get $item graphics -w]
			set h [$g get $item graphics -h]

			set line {}
			foreach { rel_x rel_y } $value {
			    
			    set abs_x [expr 0.5 * $rel_x*$w + $x]
			    set abs_y [expr 0.5 * $rel_y*$h + $y]
			    lappend line $abs_x $abs_y
			}

			GT::action $editor set_attr $items \
			    { graphics -line } $line
		    }
		}

		"^b-(label_)?graphics-stipple$" {
		    if { $value == "gray100" } {
			set value {}
		    }
		    GT::action $editor set_attr $items \
			-$attrName $value
		}

		"^.--" {
		    GT::action $editor set_attr $items \
			-$attrName $value
		}

		default {
		    GT::action $editor set_attr $items \
			[list $attrType -$attrName] $value
		}
	    }
	}
    }

    proc ::GT::action_set_attr { editor { items {} } args } {
	global GT

	if { $items == {} } {
	    return
	}

	set g $GT($editor,graph)

	foreach { attr value } $args {
	    GT::undo $editor attributes $items $attr
	    eval $g set { $items } $attr { $value }
	}

	$g draw
    }
   
    #==================================================
    
    proc items_for_attr { IS attr } {
	global GT GT_selection

	set editor [winfo parent $IS]
	set nodes $GT_selection($editor,selected,node)
	set edges $GT_selection($editor,selected,edge)

	switch -regexp -- $attr {
	    "^n"	{ return $nodes }
	    "^e"	{ return $edges }
	    "^b"	{ return [concat $nodes $edges] }
	    default	{ return {} }
	}
    }

    proc enable_update { IS attr } {
	variable _Update

	if { ![info exists _Update($IS,attr)] } {
	    set _Update($IS,attr) 1
	} else {
	    set _Update($IS,attr) [expr $_Update($IS,attr) + 1]
	}
    }
    
    proc disable_update { IS attr } {
	variable _Update

	if { ![info exists _Update($IS,attr)] } {
	    set _Update($IS,attr) 0
	} else {
	    set _Update($IS,attr) [expr $_Update($IS,attr) - 1]
	}
    }
    
    proc update_enabled { IS attr } {
	variable _Update

	if { ![info exists _Update($IS,attr)] } {
	    return 1
	} else {
	    return [expr $_Update($IS,attr) > 0]
	}
    }

    #================================================== generic canvas utils
    
    bind init_canvas_coords <Configure> \
	    [namespace code "init_canvas_coords %W"]

    proc create_node_canvas { canvas { type "rectangle" } } {
	variable _Options
	
	# canvas
	
	canvas $canvas \
	    -width 0 -height 0 \
	    -highlightthickness 0

	bindtags $canvas [concat init_canvas_coords [bindtags $canvas]]
	
	# border

	$canvas create $type \
	    0 0 0 0 \
	    -fill $_Options(color,border,fill) \
	    -outline $_Options(color,border,outline) \
	    -tag border
	
	$canvas create line \
	    0 0 0 0 \
	    -fill $_Options(color,border,outline) \
	    -tag border.vert
	
	$canvas create line \
	    0 0 0 0\
	    -fill $_Options(color,border,outline) \
	    -tag border.horz

	return $canvas
    }
    
    proc init_canvas_coords { canvas } {

	set coords [::GT::IS::get_canvas_coords $canvas]
	GT::pset { bx by iw ih } $coords

	$canvas configure -height [expr $ih + 2*$by]

	# adjust border coords

	$canvas coords border \
	    $bx $by \
	    [expr $bx + $iw] [expr $by + $ih]
	
	$canvas coords border.vert \
	    [expr $bx + $iw/2.0] $by \
	    [expr $bx + $iw/2.0] [expr $by + $ih]
	
	$canvas coords border.horz \
	    $bx [expr $by + $ih/2.0] \
	    [expr $bx + $iw] [expr $by + $ih/2.0]

	return $coords
    }
    
    proc get_canvas_coords { canvas } {
	variable _Options

	# calculate canvas dimensions
	
	GT::pset { bx by } $_Options(ctl_borders)

	set ow [winfo width $canvas]	;# outer width

	set iw [expr $ow - 2*$bx]	;# inner width
	set ih $iw			;# inner height

	return [list $bx $by $iw $ih]
    }
}

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