home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dream 52
/
Amiga_Dream_52.iso
/
Linux
/
Divers
/
angela-1.28-BETA-bin-Linux-i586.tar.gz
/
angela-1.28-BETA-bin-Linux-i586.tar
/
angela-1.28-BETA
/
angela
next >
Wrap
Text File
|
1998-05-05
|
91KB
|
3,212 lines
#!/bin/sh
# This line is to tell emacs to load tcl mode: -*- Mode: Tcl -*-
# If this file doesn't execute properly, check if the
# tixwish4.1.8.0 binary is on the current path. If not,
# make the required changes.
# The next line will be executed using the shell
# and ignored by Tcl because of the trailing backslash \
exec tixwish4.1.8.0 -f "$0" ${1+"$@"}
# Please read file LICENSE for licensing informations.
# If this file was not included with your distribution, please
# email pabst@mpi-sb.mpg.de to receive one copy.
# To report bug reports or other comments, please use the
# bug report generator in the file menu. This will include some
# precious informations about the Tcl/Tk context you are
# using. The generated text file can be send with any mail
# editor.
################################################################
################################################################
################################################################
##
## Constants and Variable set
##
################################################################
################################################################
################################################################
set angela_selected_nodes ""
set angela_state NORMAL
set angela_dragflag 0
set angela_lasthighlight ""
set angela_nodes ""
set angela_edges ""
set angela_debug 0
set angela_version ""
################################################################
################################################################
################################################################
##
## Procedures
##
################################################################
################################################################
################################################################
################################################################
#
# Module Management
#
################################################################
proc angela:mod:manager:browse { tree path action args } {
set module [lindex $action 1]
if { $module == "" } {
set ok 0
} else {
set ok 1
}
foreach { widget command } \
{ \
algname algorithm_name \
alglongname algorithm_longname \
algauthor algorithm_author \
algversion algorithm_version \
implname implementation_name \
impllongname implementation_longname \
implauthor implementation_author \
implversion implementation_version \
type type \
subtype subtype \
} {
[ $path.top.b.$widget subwidget entry] \
delete 0 end
if { $ok } {
[ $path.top.b.$widget subwidget entry] \
insert end \
[angela:mod:info:$command $module]
}
}
}
proc angela:mod:manager:run { tree path action args } {
angela:mod:manager:browse $tree $path $action $args
}
proc angela:mod:manager { w } {
global angela_mod_list
catch { destroy $w }
toplevel $w
wm title $w "angela!:Module Browser"
angela:prefs:window $w ModuleBrowser
frame $w.top -relief raised -bd 1
# Create a TixTree widget to display the module hierarchy
#
#
tixTree $w.top.a -options {
separator "/"
hlist.selectMode single
}
$w.top.a config \
-browsecmd "angela:mod:manager:browse $w.top.a $w" \
-command "angela:mod:manager:run $w.top.a $w"
frame $w.top.b
pack $w.top.a $w.top.b -expand yes -fill both -padx 10 \
-pady 10 -side left
foreach { name string } \
{ \
algname "Algorithm name" \
alglongname "Algorithm long name" \
algauthor "Algorithm author" \
algversion "Algorithm version" \
implname "Implementation name" \
impllongname "Implementation long name" \
implauthor "Implementation author" \
implversion "Implementation version" \
type "Module type" \
subtype "Module subtype"
} {
tixLabelEntry $w.top.b.$name -label $string: \
-options {
-anchor e
label.width 26
entry.width 30
}
pack $w.top.b.$name -fill x -expand yes
}
set tree $w.top.a
set hlist [$w.top.a subwidget hlist]
# STEP (1) Add the entries
$hlist add object -itemtype imagetext \
-text object -image [tix getimage folder]
$hlist add filter_out -itemtype imagetext \
-text filter_out -image [tix getimage folder]
$hlist add filter_in -itemtype imagetext \
-text filter_in -image [tix getimage folder]
$hlist add filter_exec -itemtype imagetext \
-text filter_exec -image [tix getimage folder]
$hlist add AGD -itemtype imagetext \
-text AGD -image [tix getimage folder]
$hlist add LEDA -itemtype imagetext \
-text LEDA -image [tix getimage folder]
foreach i $angela_mod_list {
set name [angela:mod:info:algorithm_name $i]
set type \
"[angela:mod:info:type $i]/[angela:mod:info:subtype $i] $i"
$hlist add $type -itemtype imagetext \
-text $name -image [tix getimage folder]
}
# STEP (2) Use the "autosetmode" method of TixTree to indicate
# which entries can be opened or closed. The
# "autosetmode" command will call the "setmode" method
# to set the mode of each entry to the following:
#
# "open" : the entry has some children and the children are
# currently visible
# "close": the entry has some children and the children are
# currently INvisible
# "none": the entry does not have children.
#
# If you don't like the "autosetmode" method, you can always call
# "setmode" yourself, but that takes more work.
$tree autosetmode
# Use a ButtonBox to hold the buttons.
#
tixButtonBox $w.box -orientation horizontal
$w.box add ok -text Done -underline 0 \
-command "angela:prefs:window:save $w ModuleBrowser" \
-width 6
$w.box add load -text "Load..." -underline 0 \
-command "angela:prefs:window:save $w ModuleBrowser" \
-width 6 -state disabled
$w.box add unload -text "Unload..." -underline 0 \
-command "angela:prefs:window:save $w ModuleBrowser" \
-width 6 -state disabled
pack $w.box -side bottom -fill x
pack $w.top -side top -fill both -expand yes
}
proc angela:mod:info:algorithm_name { module } {
return [angela:mod:info $module 0]
}
proc angela:mod:info:algorithm_longname { module } {
return [angela:mod:info $module 1]
}
proc angela:mod:info:algorithm_author { module } {
return [angela:mod:info $module 2]
}
proc angela:mod:info:algorithm_version { module } {
return [angela:mod:info $module 3]
}
proc angela:mod:info:implementation_name { module } {
return [angela:mod:info $module 4]
}
proc angela:mod:info:implementation_longname { module } {
return [angela:mod:info $module 5]
}
proc angela:mod:info:implementation_author { module } {
return [angela:mod:info $module 6]
}
proc angela:mod:info:implementation_version { module } {
return [angela:mod:info $module 7]
}
proc angela:mod:info:type { module } {
return [angela:mod:info $module 8]
}
proc angela:mod:info:subtype { module } {
return [angela:mod:info $module 9]
}
proc angela:mod:info { module id } {
set command [ format "%s long_info" $module ]
return [string trim [ lindex [ eval $command ] $id ] ]
}
proc angela:mod:scan { modules tag value } {
set result ""
foreach i $modules {
if { [angela:mod:info:$tag $i] == $value } {
lappend result $i
}
}
return $result
}
proc angela:mod:scan:type { type subtype } {
global angela_mod_list
set fromtype [angela:mod:scan $angela_mod_list type $type]
return [angela:mod:scan $fromtype subtype $subtype]
}
proc angela:mod:register { name } {
global angela_mod_list
lappend angela_mod_list $name
}
proc angela:mod:load:dll { name module } {
global angela_root
debug "Load DLL $name=$module"
if { ![file exists $angela_root/$module] } {
fatal \
"Cannot load $angela_root/$module as DLL. Check configuration."
}
load $angela_root/$module
angela:mod:register $name
}
proc angela:mod:load:tcl { name module } {
global angela_root
debug "Load TCL $name=$module"
if { ![file exists $angela_root/$module] } {
fatal \
"Cannot load $angela_root/$module as TCL. Check configuration."
}
source $angela_root/$module
angela:mod:register $name
$name init
}
proc angela:mod:load { name module type } {
switch $type {
dll
{
angela:mod:load:dll $name $module
}
tcl
{
angela:mod:load:tcl $name $module
}
}
}
proc angela:mod:init { } {
global angela_mod_list angela_option
debug "Initializing module engine..."
set angela_mod_list ""
foreach {name module type} $angela_option(modules:startup) {
angela:mod:load $name $module $type
}
}
################################################################
#
# Preferences Management
#
################################################################
proc angela:prefs:write { key value } {
global angela_prefs
if { [file exists $angela_prefs] == 0 } {
set handle [open $angela_prefs "w"]
puts $handle "$key=$value"
close $handle
return
}
set handle [open $angela_prefs "r"]
set handle2 [open "$angela_prefs.tmp" "w"]
set updated 0
while { ! [eof $handle] } {
set line [gets $handle]
set newline [ split $line = ]
if { $line!="" } {
if { [lindex $newline 0] == $key } {
puts $handle2 "$key=$value"
set updated 1
} else {
puts $handle2 $line
}
}
}
close $handle
if { ! $updated } {
puts $handle2 "$key=$value"
}
close $handle2
file delete $angela_prefs
file rename "$angela_prefs.tmp" $angela_prefs
}
proc angela:prefs:read { key } {
global angela_prefs
if { [file exists $angela_prefs] == 0 } {
return ""
}
set handle [open $angela_prefs "r"]
while { ! [eof $handle] } {
set line [ gets $handle ]
set line [ split $line = ]
if { [lindex $line 0 ] == $key } {
close $handle
return [lindex $line 1]
}
}
close $handle
return ""
}
proc angela:prefs:window { path windowname } {
# Read preference, if exist
set placement [angela:prefs:read $windowname]
if { $placement != "" } {
wm geometry $path $placement
wm protocol $path WM_DELETE_WINDOW \
"angela:prefs:window:save $path $windowname"
}
}
proc angela:prefs:window:save { path windowname } {
set placement [wm geometry $path]
angela:prefs:write $windowname $placement
destroy $path
}
################################################################
#
# Configuration Management
#
################################################################
proc angela:conf:write { } {
global \
angela_option \
angela_cap_value \
angela_root \
angela_prefs \
angela_user
# Write into configuration file the current settings.
set handle [open $angela_user w]
puts $handle "# This configuration file is part of angela!"
puts $handle "# angela! is located in $angela_root"
puts $handle "# Please do not edit this file manually unless"
puts $handle "# you know what you are doing!"
puts $handle ""
foreach i [array names angela_option] {
puts $handle "set angela_option($i)\t\t\t\"$angela_option($i)\""
}
foreach i [array names angela_cap_value] {
puts $handle "set angela_cap_value($i)\t\t\t\"$angela_cap_value($i)\""
}
close $handle
}
proc angela:conf:setup { } {
global \
angela_option \
angela_cap_value \
angela_root \
angela_prefs \
angela_user
set system \
[format "%s/angela.rc" $angela_root]
set user "~/angela.rc"
set angela_user $user
set forced \
[format "%s/angela.forced.rc" $angela_root]
set angela_prefs "~/.angela.runtime"
if { [file exists $system] } {
debug "Loading system configuration in $system"
source $system
}
if { [file exists $user] } {
debug "Loading user configuration in $user"
source $user
}
if { [file exists $forced] } {
debug "Loading forced configuration in $forced"
source $forced
}
}
################################################################
#
# Realtime Management
#
################################################################
proc angela:realtime:start { } {
after idle angela:realtime:idle
}
proc angela:realtime:idle { } {
angela:realtime:task
after 50 angela:realtime:idle
}
proc angela:realtime:task { } {
global angela_edges angela_canvas
foreach e $angela_edges {
$e spring_visc
}
foreach e $angela_edges {
$e spring_calculate 0.5
}
foreach e $angela_edges {
set n1 [$e export -node1]
set n2 [$e export -node2]
$n1 spring_update $angela_canvas 0.5
$n2 spring_update $angela_canvas 0.5
$e update $angela_canvas
}
}
################################################################
#
# Printing
#
################################################################
proc angela:print { path } {
global angela_option
set w .print
catch { destroy $w }
toplevel $w
wm title $w "angela!:Print"
angela:prefs:window $w Print
# Create the notebook widget and set its backpagecolor to gray.
# Note that the -backpagecolor option belongs to the "nbframe"
# subwidget.
tixNoteBook $w.nb -ipadx 6 -ipady 6
$w config -bg gray
$w.nb subwidget nbframe config -backpagecolor gray
# Create the two tabs on the notebook. The -underline option
# puts a underline on the first character of the labels of the tabs.
# Keyboard accelerators will be defined automatically according
# to the underlined character.
#
$w.nb add area -label "Area" -underline 0
pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
#----------------------------------------
# Create the area page
#----------------------------------------
set f [$w.nb subwidget area]
# Create two frames: one for the common buttons, one for the
# other widgets
#
frame $f.f
frame $f.common
pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
pack $f.common -side right -padx 2 -pady 2 -fill y
# Create the controls that only belong to this page
#
frame $f.f.left
frame $f.f.right
pack $f.f.left $f.f.right -side left -fill both -expand yes
canvas $f.f.left.c -width 155 -height 155 -background gray \
-borderwidth 0 -relief sunken
button $f.f.left.update -text "Refresh preview" \
-command "angela:print:refresh $f.f.left.c $path" \
-pady 5
pack $f.f.left.c $f.f.left.update -side top
tixLabelEntry $f.f.right.paperheight -label "Paper height:" \
-options {
entry.width 10
label.width 15
label.anchor e
entry.textVariable angela_option(print:paper:height)
}
tixLabelEntry $f.f.right.paperwidth -label "Paper width:" \
-options {
entry.width 10
label.width 15
label.anchor e
entry.textVariable angela_option(print:paper:width)
}
tixLabelEntry $f.f.right.paperleft -label "Left margin:" \
-options {
entry.width 10
label.width 15
label.anchor e
entry.textVariable angela_option(print:paper:left)
}
tixLabelEntry $f.f.right.paperright -label "Right margin:" \
-options {
entry.width 10
label.width 15
label.anchor e
entry.textVariable angela_option(print:paper:right)
}
tixLabelEntry $f.f.right.papertop -label "Top margin:" \
-options {
entry.width 10
label.width 15
label.anchor e
entry.textVariable angela_option(print:paper:top)
}
tixLabelEntry $f.f.right.paperbottom -label "Paper bottom:" \
-options {
entry.width 10
label.width 15
label.anchor e
entry.textVariable angela_option(print:paper:bottom)
}
frame $f.f.right.rotate
radiobutton $f.f.right.rotate.portrait -text "Portrait" \
-variable angela_paperportrait -value 1
radiobutton $f.f.right.rotate.landscape -text "Landscape" \
-variable angela_paperportrait -value 0
pack $f.f.right.rotate.portrait $f.f.right.rotate.landscape \
-side left -fill both -expand yes
pack $f.f.right.paperheight $f.f.right.paperwidth \
$f.f.right.paperleft $f.f.right.paperright \
$f.f.right.papertop $f.f.right.paperbottom \
$f.f.right.rotate \
-side top -fill x -expand yes
# Create the common buttons
#
angela:print:CreateCommonButtons $w $f.common $f.f.left.c $path
angela:print:refresh $f.f.left.c $path
}
proc angela:print:CreateCommonButtons {w f canvas path} {
button $f.printfile -text "Print to file..." -width 10 \
-command "angela:prefs:window:save $w Print"
button $f.print -text "Print" -width 10 \
-command "angela:prefs:window:save $w Print"
button $f.cancel -text Cancel -width 10 \
-command "angela:prefs:window:save $w Print"
pack $f.printfile $f.print $f.cancel -side top -padx 2 -pady 2
}
proc angela:print:refresh { canvas realcanvas} {
global angela_option
angela:msg GRAPH:CLEANUP
set previewwidth 150.0
set previewheight 150.0
set previewx 2
set previewy 2
set posterx 1
set postery 1
set paperwp 100
set paperhp 100
set paperwidth [winfo fpixels . $angela_option(print:paper:width)]
set paperheight [winfo fpixels . $angela_option(print:paper:height)]
set paperleft [winfo fpixels . $angela_option(print:paper:left)]
set paperright [winfo fpixels . $angela_option(print:paper:right)]
set papertop [winfo fpixels . $angela_option(print:paper:top)]
set paperbottom [winfo fpixels . $angela_option(print:paper:bottom)]
set printmaxwidth [expr $paperwidth-$paperleft-$paperright]
set printmaxheight [expr $paperheight-$papertop-$paperbottom]
set bbox [$realcanvas bbox all]
set realx [lindex $bbox 0]
set realy [lindex $bbox 1]
set realwidth [expr [lindex $bbox 2]-$realx]
set realheight [expr [lindex $bbox 3]-$realy]
set realprintscalex [expr 1/(($realwidth/$posterx)/$printmaxwidth)]
set realprintscaley [expr 1/(($realheight/$postery)/$printmaxheight)]
# Set the scales to the minimum value
if { $realprintscalex < $realprintscaley } {
set realprintscaley $realprintscalex
} else {
set realprintscalex $realprintscaley
}
set realprintscalex [expr $realprintscalex*$paperwp/100]
set realprintscaley [expr $realprintscaley*$paperhp/100]
set printwidth [expr ($realwidth/$posterx)*$realprintscalex]
set printheight [expr ($realheight/$postery)*$realprintscaley]
set pagecenterx [expr $printmaxwidth/2+$paperleft]
set pagecentery [expr $printmaxheight/2+$papertop]
set printx [expr $pagecenterx-($printwidth/2)]
set printy [expr $pagecentery-($printheight/2)]
# Compute values for preview display
set paperpreviewscalex [expr 1/($paperwidth/$previewwidth)]
set paperpreviewscaley [expr 1/($paperheight/$previewheight)]
if { $paperpreviewscalex > $paperpreviewscaley } {
set paperpreviewscalex $paperpreviewscaley
} else {
set paperpreviewscaley $paperpreviewscalex
}
set previewpaperwidth [expr $paperwidth*$paperpreviewscalex]
set previewpaperheight [expr $paperheight*$paperpreviewscaley]
set previeworiginx [expr $previewwidth/2-($paperwidth/2*$paperpreviewscalex)+2]
set previeworiginy [expr $previewheight/2-($paperheight/2*$paperpreviewscaley)+2]
set previewtop [expr $papertop*$paperpreviewscaley]
set previewbottom [expr $paperbottom*$paperpreviewscaley]
set previewleft [expr $paperleft*$paperpreviewscalex]
set previewright [expr $paperright*$paperpreviewscalex]
set previewprintx [expr $printx*$paperpreviewscalex]
set previewprinty [expr $printy*$paperpreviewscaley]
set previewprintheight [expr $printheight*$paperpreviewscaley]
set previewprintwidth [expr $printwidth*$paperpreviewscalex]
foreach i { \
previeworiginx previeworiginy \
paperpreviewscalex paperpreviewscaley \
previewpaperwidth previewpaperheight previewtop previewbottom \
previewleft previewright previewprintx previewprinty \
previewprintheight previewprintwidth \
realx realy realheight realwidth paperheight paperwidth \
papertop paperbottom paperleft paperright paperwp paperhp \
posterx postery printx printy printwidth printheight \
realprintscalex realprintscaley pagecenterx pagecentery } {
debug "$i=[set $i]"
}
# Delete old objects
$canvas delete all
# Draw sheet
$canvas create rectangle $previeworiginx $previeworiginy \
[expr $previeworiginx+$previewpaperwidth] \
[expr $previeworiginy+$previewpaperheight] \
-fill white -outline black -width 1 -tags sheet
# Draw margins
$canvas create line \
[expr $previeworiginx+$previewleft] \
$previeworiginy \
[expr $previeworiginx+$previewleft] \
[expr $previeworiginy+$previewpaperheight] \
-fill gray -width 1 -tags marginleft
$canvas create line \
[expr $previeworiginx+$previewpaperwidth-$previewright] \
$previeworiginy \
[expr $previeworiginx+$previewpaperwidth-$previewright] \
[expr $previeworiginy+$previewpaperheight] \
-fill gray -width 1 -tags marginright
$canvas create line \
$previeworiginx \
[expr $previeworiginy+$previewtop] \
[expr $previeworiginx+$previewpaperwidth] \
[expr $previeworiginy+$previewtop] \
-fill gray -width 1 -tags margintop
$canvas create line \
$previeworiginx \
[expr $previeworiginy+$previewpaperheight-$previewbottom] \
[expr $previeworiginx+$previewpaperwidth] \
[expr $previeworiginy+$previewpaperheight-$previewbottom] \
-fill gray -width 1 -tags marginbottom
# Draw to-print area
$canvas create rectangle \
[expr $previeworiginx+$previewprintx] \
[expr $previeworiginy+$previewprinty] \
[expr $previeworiginx+$previewprintx+$previewprintwidth] \
[expr $previeworiginy+$previewprinty+$previewprintheight] \
-fill steelblue -outline black -width 1 -tags area
$realcanvas postscript -file print.ps\
-width $realwidth\
-height $realheight\
-x $realx\
-y $realy\
-pageanchor sw \
-pagewidth [expr $paperwidth-$printx]\
-pageheight [expr $paperheight-$printy]\
-pagex $printx\
-pagey [expr $realheight-$printy]
}
################################################################
#
# Capabilities Management
#
################################################################
proc angela:capabilities:scan { what type subtype } {
global angela_cap angela_cap_value \
angela_allcap angela_allcap_value
set module [angela:mod:scan:type $type $subtype]
if { $module == "" } {
debug "No module for $type/$subtype found!"
return
}
if { [llength $module] > 1 } {
debug "More than one module for $type/$subtype"
set module [lindex $module 0]
}
set cap [$module attributes]
set angela_cap($what) $cap
foreach i $cap {
if { [lsearch [array names angela_cap_value] $what:$i] == -1 } {
set angela_cap_value($what:$i) "0"
}
}
set allcap [$module all_attributes]
set angela_allcap($what) $allcap
foreach i $allcap {
if { [lsearch [array names angela_allcap_value] $what:$i] == -1 } {
set angela_allcap_value($what:$i) "0"
}
}
}
proc angela:capabilities:get:all { command classes destcap destcap_value } {
global $destcap $destcap_value angela_allcap angela_allcap_value
catch { unset $destcap }
catch { unset $destcap_value }
foreach { class cmd } $classes {
foreach i $angela_allcap($class) {
set value [$cmd export -$i]
if { $value == "" } { set value "{}" }
eval [format "set %s(%s:%s) $value" \
$destcap_value $class $i]
eval [format "lappend %s(%s) $i" \
$destcap $class $i]
}
}
}
proc angela:capabilities:get:user { command classes destcap destcap_value } {
global $destcap $destcap_value angela_cap angela_cap_value
catch { unset $destcap }
catch { unset $destcap_value }
foreach { class cmd } $classes {
foreach i $angela_cap($class) {
set value [$cmd export -$i]
if { $value == "" } { set value "{}" }
eval [format "set %s(%s:%s) $value" \
$destcap_value $class $i]
eval [format "lappend %s(%s) $i" \
$destcap $class $i]
}
}
}
proc angela:capabilities:synonym { value } {
global angela_option
set retval $value
if { [lsearch [array names angela_option] synonym:$value] != -1 } {
set retval $angela_option(synonym:$value)
}
return $retval
}
proc angela:capabilities:manager { classes cap cap_value { command "" } } {
#global angela_cap angela_cap_value \
# angela_capfont
global angela_option $cap $cap_value
array set newcap [array get $cap]
array set newcap_value [array get $cap_value]
set w .cap
catch { destroy $w }
toplevel $w
wm title $w "Capabilities"
angela:prefs:window $w Capabilities
# Create the notebook widget and set its backpagecolor to gray.
# Note that the -backpagecolor option belongs to the "nbframe"
# subwidget.
tixNoteBook $w.nb -ipadx 6 -ipady 6
$w config
$w.nb subwidget nbframe config
# Create the two tabs on the notebook. The -underline option
# puts a underline on the first character of the labels of the tabs.
# Keyboard accelerators will be defined automatically according
# to the underlined character.
#
foreach class $classes {
$w.nb add $class -label $class
}
pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
foreach class $classes {
set f [$w.nb subwidget $class]
# Create two frames: one for the common buttons, one for the
# other widgets
#
frame $f.f
frame $f.common
pack $f.f -side top -padx 2 -pady 2 -fill both -expand yes
pack $f.common -side bottom -padx 2 -pady 2 -fill x
# Create the controls that only belong to this page
#
foreach i $newcap($class) {
frame $f.f.$i
pack $f.f.$i -fill both -expand yes
label $f.f.$i.l -text [angela:capabilities:synonym $class:$i]: \
-font $angela_option(gui:font:cap) \
-width 15 -anchor e
button $f.f.$i.b -text $newcap_value($class:$i) \
-command "angela:capabilities:manager:edit $f.f.$i.b\
$class $i $cap $cap_value \"$command\"" \
-font $angela_option(gui:font:cap) -borderwidth 1 \
-background white
pack $f.f.$i.l $f.f.$i.b -side left -fill x
}
}
frame $w.common -background gray -border 4
set majorclass ""
set first 1
foreach class $classes {
if { ! $first } {
set majorclass "$majorclass:$class"
} else {
set majorclass $class
set first 0
}
}
tixComboBox $w.common.select -label "Style:" -dropdown true \
-editable true -fancy true \
-command "angela:capabilities:manager:style:do $majorclass \
$cap $cap_value \"$command\" $w.nb" \
-options {
listbox.height 10
label.with 5
label.anchor e
entry.width 30
}
# Parse and register the styles
if { [lsearch [array names angela_option] style:$majorclass] != -1 } {
foreach style $angela_option(style:$majorclass) {
$w.common.select insert end [lindex $style 0]
}
}
pack $w.common.select -fill both -expand yes
button $w.common.close -text Close -width 6 \
-command "angela:prefs:window:save $w Capabilities" \
-font $angela_option(gui:font:cap)
pack $w.common.close -side bottom -fill both
pack $w.common -fill x -expand yes
}
proc angela:capabilities:manager:update { majorclass path cap cap_value } {
global $cap $cap_value
array set newcap [array get $cap]
array set newcap_value [array get $cap_value]
set classes [split $majorclass :]
foreach class $classes {
set f [$path subwidget $class]
foreach i $newcap($class) {
$f.f.$i.b configure -text $newcap_value($class:$i)
}
}
}
proc angela:capabilities:manager:style:do \
{ majorclass cap cap_value command path arg } {
global $cap $cap_value angela_option
array set newcap_value [array get $cap_value]
set found 0
foreach style $angela_option(style:$majorclass) {
if { [lindex $style 0] == $arg } {
set found 1
break
}
}
if { $found } {
set style [lrange $style 1 end]
foreach { attribute value } $style {
angela:capabilities:manager:edit:newval \
$cap_value $attribute $command $value
}
angela:capabilities:manager:update \
$majorclass $path $cap $cap_value
}
}
proc angela:capabilities:manager:edit \
{path class attribute cap cap_value { cmd "" } } {
global angela_cap_value angela_option $cap $cap_value
array set newcap [array get $cap]
array set newcap_value [array get $cap_value]
catch { destroy .capedit }
toplevel .capedit
wm title .capedit "angela!:Edit attribute"
set w .capedit
angela:prefs:window $w CapabilitiesEdit
frame $w.top -border 1 -relief raised
# $w.top.a is a drop-down combo box. It is not editable -- who wants
# to invent new months?
#
# [Hint] The -options switch sets the options of the subwidgets.
# [Hint] We set the label.width subwidget option of both comboboxes to
# be 10 so that their labels appear to be aligned.
#
# newcap_value($class:$attribute) \
tixComboBox $w.top.a \
-label "[angela:capabilities:synonym $class:$attribute]= " \
-dropdown true \
-editable true \
-command "angela:capabilities:manager:edit:newval \
$cap_value \
$class:$attribute \"$cmd\"" \
-history 1 \
-fancy 1 \
-options {
listbox.height 6
label.width 20
label.anchor e
}
$w.top.a subwidget entry insert end $newcap_value($class:$attribute)
focus [$w.top.a subwidget entry]
pack $w.top.a -side top -anchor e
if { [lsearch [array names angela_option] choice:$class:$attribute] == -1 } {
# Insert the choices into the combo boxes
#
$w.top.a insert end 1
$w.top.a insert end 5
$w.top.a insert end 10
$w.top.a insert end 20
$w.top.a insert end White
$w.top.a insert end Black
$w.top.a insert end Green
$w.top.a insert end SteelBlue
$w.top.a insert end { Arial 8 }
$w.top.a insert end { Arial 20 }
} else {
foreach element $angela_option(choice:$class:$attribute) {
$w.top.a insert end $element
}
}
# Use a ButtonBox to hold the buttons.
#
tixButtonBox $w.box -orientation horizontal
$w.box add ok -text Done -underline 0 \
-command "angela:capabilities:manager:edit:okcmd $path $w $class $attribute $cap $cap_value" \
-width 6
# $w.box add cancel -text Cancel -underline 0 \
# -command "angela:prefs:window:save $w CapabilitiesEdit" \
# -width 6
pack $w.box -side bottom -fill x
pack $w.top -side top -fill both -expand yes
}
proc angela:capabilities:manager:edit:newval \
{ \
cap_value attribute command value } \
{
global $cap_value
#set value [$path subwidget entry get]
eval set [format "%s(%s)" $cap_value $attribute] \"$value\"
if { $command != "" } { eval $command }
}
proc angela:capabilities:manager:edit:okcmd {path w class attribute cap cap_value} {
global angela_cap_value $cap $cap_value
array set newcap [array get $cap]
array set newcap_value [array get $cap_value]
$path configure -text $newcap_value($class:$attribute)
destroy $w
}
################################################################
#
# Workspace Management
#
################################################################
proc angela:ws:title:init { path } {
global angela_filename
wm title $path "angela!([angela:msg VERSION]):Workspace:$angela_filename"
}
proc angela:ws:menubar:init { path } {
menubutton $path.file -text "File" -underline 0 \
-menu $path.file.m -borderwidth 1
menubutton $path.edit -text "Edit" -underline 0 \
-menu $path.edit.m -borderwidth 1
menubutton $path.tools -text "Tools" -underline 0 \
-menu $path.tools.m -borderwidth 1
menubutton $path.help -text "Help" -underline 0 \
-menu $path.help.m -state disabled -borderwidth 1
pack $path.file -side left
pack $path.edit -side left
pack $path.tools -side left
pack $path.help -side right
angela:ws:menubar:set $path
}
proc angela:ws:menubar:set { path } {
menu $path.file.m -tearoff 0 -borderwidth 1
$path.file.m add command -label "New Graph" \
-underline 0 -command "angela:msg GRAPH:NEW"
$path.file.m add command -label "Open Graph..." \
-underline 0 -command "angela:msg GRAPH:OPEN"
$path.file.m add command -label "Save Graph" \
-underline 0 -command "angela:msg GRAPH:SAVE"
$path.file.m add command -label "Save Graph As..." \
-underline 0 -command "angela:msg GRAPH:SAVEAS"
$path.file.m add separator
$path.file.m add command -label "Print..." \
-underline 0 -command "angela:msg GRAPH:PRINT"
$path.file.m add separator
$path.file.m add command -label "Properties..." \
-underline 0 -command "angela:msg GRAPH:PROPERTIES"
$path.file.m add command -label "Save configuration" \
-underline 5 -command "angela:conf:write"
$path.file.m add separator
$path.file.m add command -label "Tcl command..." \
-underline 0 -command "angela:tcl"
$path.file.m add command -label "Bug Report..." \
-underline 0 -command "angela:msg BUG"
$path.file.m add separator
$path.file.m add command -label "Quit" \
-underline 0 -accelerator "Alt-F4" \
-command "angela:msg QUIT"
menu $path.edit.m -tearoff 0 -borderwidth 1
$path.edit.m add command -label "Undo" \
-underline 0 -command "angela:msg UNDO" -state disabled
$path.edit.m add command -label "Redo" \
-underline 0 -command "angela:msg REDO" -state disabled
$path.edit.m add separator
$path.edit.m add command -label "Copy" \
-underline 0 -command "angela:msg COPY" -state disabled
$path.edit.m add command -label "Cut" \
-underline 2 -command "angela:msg CUT"
$path.edit.m add command -label "Paste" \
-underline 0 -command "angela:msg PASTE" -state disabled
menu $path.tools.m -tearoff 0 -borderwidth 1
$path.tools.m add command -label "Modules..." \
-command "angela:msg MODULES"
$path.tools.m add separator
$path.tools.m add command -label "Create node" \
-command "angela:msg TOOL:NODE"
$path.tools.m add command -label "Create edge" \
-command "angela:msg TOOL:EDGE"
$path.tools.m add command -label "Edit Object" \
-command "angela:msg TOOL:EDIT"
$path.tools.m add separator
}
proc angela:ws:actionbar:init { path } {
global angela_option
# button $path.node -text "Create node" -borderwidth 1 \
# -command "angela:msg TOOL:NODE"
# button $path.edge -text "Create edge" -borderwidth 1 \
# -command "angela:msg TOOL:EDGE"
# button $path.edit -text "Edit" -borderwidth 1 \
# -command "angela:msg TOOL:EDIT"\
# pack $path.node -side top -fill x
# pack $path.edge -side top -fill x
# pack $path.edit -side top -fill x
tixSelect $path.sel \
-radio true -orientation vertical
$path.sel add node -text "Create node" \
-command "angela:msg TOOL:NODE" \
-font $angela_option(gui:font:tool) -borderwidth 1
$path.sel add edge -text "Create edge" \
-command "angela:msg TOOL:EDGE" \
-font $angela_option(gui:font:tool) -borderwidth 1
$path.sel add edit -text "Edit object" \
-command "angela:msg TOOL:EDIT" \
-font $angela_option(gui:font:tool) -borderwidth 1
.balloon bind $path.sel -balloonmsg "Choose Action" \
-statusmsg "Choose the action you will execute."
pack $path.sel -side top -fill x
}
proc angela:ws:statusbar:init { path } {
global angela_option
label $path.statusbar -font $angela_option(gui:font:status)
pack $path.statusbar -fill x -expand no
}
proc angela:ws:statusbar:set { path text } {
$path.statusbar configure -text $text
update
}
proc angela:ws:statusbuttons:init { path } {
global angela_option
label $path.statusbuttons -font $angela_option(gui:font:status)
pack $path.statusbuttons -fill x -expand no
}
proc angela:ws:statusbuttons:set { path text } {
$path.statusbuttons configure -text $text
}
proc angela:ws:statusdebug:init { path } {
global angela_option
label $path.statusdebug -font $angela_option(gui:font:status) \
-background black -foreground white
.balloon bind $path.statusdebug -balloonmsg "Debugging info"
pack $path.statusdebug -fill x -expand no
}
proc angela:ws:statusdebug:set { path text } {
global angela_debug argv0
if { $angela_debug } {
puts stderr "$argv0:dbg:$text"
}
}
proc debug { text } {
angela:ws:statusdebug:set .statusdebug $text
}
proc status { text } {
angela:ws:statusbar:set .statusbar $text
}
proc angela:ws:buttonbar:init { path } {
global angela_option
button $path.new -text "NEW" -font $angela_option(gui:font:tool) \
-command "angela:msg GRAPH:NEW" \
-borderwidth 1
.balloon bind $path.new -balloonmsg "Start a new graph" \
-statusmsg "Press this to start a new graph"
button $path.open -text "OPEN" -font $angela_option(gui:font:tool) \
-command "angela:msg GRAPH:OPEN" \
-borderwidth 1
.balloon bind $path.open -balloonmsg "Open a graph" \
-statusmsg "Press this to open a graph"
button $path.save -text "SAVE" -font $angela_option(gui:font:tool) \
-command "angela:msg GRAPH:SAVE" \
-borderwidth 1
.balloon bind $path.save -balloonmsg "Save the graph" \
-statusmsg "Press this to save the graph"
button $path.quit -text "QUIT" -font $angela_option(gui:font:tool) \
-command "angela:msg QUIT" \
-borderwidth 1
.balloon bind $path.quit -balloonmsg "Quit angela!" \
-statusmsg "Press this to quit angela!"
pack \
$path.new \
$path.open \
$path.save \
$path.quit \
-side left -fill none -expand no
}
proc angela:ws:canvas:init { path } {
global angela_canvas
canvas $path.c -background white \
-xscrollcommand "$path.horiz set" \
-yscrollcommand "$path.vert set" \
-borderwidth 2
scrollbar $path.horiz -orient horiz \
-command "$path.c xview"
scrollbar $path.vert -orient vert \
-command "$path.c yview"
pack $path.horiz -side bottom -fill x -expand no
pack $path.vert -side right -fill y -expand no
pack $path.c -side top -fill both -expand yes
angela:ws:canvas:grid:draw $path.c
set angela_canvas $path.c
# bind $path.c <Configure> \
# "angela:ws:canvas:resize $path %w %h"
}
proc angela:ws:canvas:resize { path width height } {
# Terrible hack here. Don't know why there is a difference
# of 6 units.
# Should find a way to expand canvas to minimum of window size.
incr width -6
incr height -6
set w [$path.c cget -width]
set h [$path.c cget -height]
if { $w < $width } {
$path.c configure -width $width
}
if { $h < $height } {
$path.c configure -height $height
}
angela:ws:canvas:refresh $path
}
proc angela:ws:canvas:refresh { path } {
$path.c configure -scrollregion [$path.c bbox all]
angela:ws:canvas:grid:refresh $path.c
}
proc angela:ws:canvas:grid:draw { path } {
global angela_option
# set width [$path cget -width]
# set height [$path cget -height]
# for { set i 0 } { $i < $width } { incr i $angela_gridx } {
# for { set j 0 } { $j < $height } { incr j $angela_gridy } {
# $path create line $i [expr $j-1] $i [expr $j+1] \
# -fill gray60 -tag grid
# $path create line [expr $i-1] $j [expr $i+1] $j\
# -fill gray60 -tag grid
# }
# }
# $path lower grid
}
proc angela:ws:canvas:grid:refresh { path } {
$path delete grid
angela:ws:canvas:grid:draw $path
}
proc angela:ws:init { } {
angela:ws:title:init .
angela:prefs:window . MainWindow
frame .menubar
frame .buttonbar -relief ridge -borderwidth 1
frame .middle
frame .statusbar -relief sunken -borderwidth 1
frame .statusbuttons -relief sunken -borderwidth 1
frame .statusdebug -relief sunken -borderwidth 1
pack .menubar -side top -fill x -expand no
pack .buttonbar -fill x -expand no
pack .middle -fill both -expand yes
pack .statusbar -fill x -expand no
pack .statusdebug -fill x -expand no \
-in .statusbar -side right
pack .statusbuttons -fill x -expand no \
-in .statusbar -side right
frame .middle.actionbar
frame .middle.canvas
pack .middle.actionbar -side left -expand no -fill y
pack .middle.canvas -side right -expand yes -fill both
tixBalloon .balloon -statusbar .statusbar.statusbar
angela:ws:menubar:init .menubar
angela:ws:actionbar:init .middle.actionbar
angela:ws:statusbar:init .statusbar
angela:ws:statusbuttons:init .statusbuttons
angela:ws:statusdebug:init .statusdebug
angela:ws:buttonbar:init .buttonbar
angela:ws:canvas:init .middle.canvas
angela:ws:statusbar:set .statusbar "Welcome to angela!"
angela:ws:statusbuttons:set .statusbuttons "ready"
angela:ws:statusdebug:set .statusdebug "angela! welcomes you"
}
################################################################
#
# Properties Management
#
################################################################
proc angela:properties { } {
global angela_option
set w .properties
catch { destroy $w }
toplevel $w
wm title $w "angela!:Properties"
angela:prefs:window $w Properties
tixNoteBook $w.nb -ipadx 6 -ipady 6
$w config
$w.nb subwidget nbframe config
$w.nb add general -label General
$w.nb add grid -label Grid
$w.nb add print -label Printing
pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
# General properties
set f [$w.nb subwidget general]
set index 0
foreach { label variable } \
{ "Font for tools" angela_option(gui:font:tool) \
"Font for status bar" angela_option(gui:font:status) \
"Font for capabilities" angela_option(gui:font:cap) } \
{
tixLabelEntry $f.$index -label "$label:" \
-options {
entry.width 30
label.width 20
label.anchor w
}
$f.$index subwidget entry configure -textvariable $variable
pack $f.$index
incr index
}
# Grid properties
set f [$w.nb subwidget grid]
set index 0
foreach { label variable } \
{ "Grid X-resolution" angela_option(gui:grid:x) \
"Grid Y-resolution" angela_option(gui:grid:y) } \
{
tixLabelEntry $f.$index -label "$label:" \
-options {
entry.width 30
label.width 20
label.anchor w
}
$f.$index subwidget entry configure -textvariable $variable
pack $f.$index
incr index
}
# Print properties
set f [$w.nb subwidget print]
set index 0
foreach { label variable } \
{ "Paper width" angela_option(print:paper:width) \
"Paper height" angela_option(print:paper:height) \
"Paper margin left" angela_option(print:paper:left) \
"Paper margin right" angela_option(print:paper:right) \
"Paper margin top" angela_option(print:paper:top) \
"Paper margin bottom" angela_option(print:paper:bottom) \
} \
{
tixLabelEntry $f.$index -label "$label:" \
-options {
entry.width 30
label.width 20
label.anchor w
}
$f.$index subwidget entry configure -textvariable $variable
pack $f.$index
incr index
}
set box [tixButtonBox $w.b -bd 1 -relief raised]
pack $box -side bottom -fill both
$box add done -text Done \
-command "angela:prefs:window:save $w Properties" -width 6
}
################################################################
#
# Tool Management
#
################################################################
proc angela:tool:add:cascade { path name command } {
set index 0
while { 1 } {
set newmenu $path.cascade$index
if { [lsearch [winfo children $path] $newmenu] != -1 } {
incr index
} else {
break
}
}
$path add cascade -label "$name" -menu $newmenu
# -command "$command angela:msg"
menu $newmenu -tearoff 0
return $newmenu
}
proc angela:tool:node { } {
global angela_canvas angela_state
bind $angela_canvas <B1-ButtonRelease> \
"angela:msg NODE:CREATE %x %y"
bind $angela_canvas <B1-Motion> \
""
angela:capabilities:manager "node shape text" \
angela_cap angela_cap_value
set angela_state NODE
.middle.actionbar.sel subwidget node configure -state disabled
.middle.actionbar.sel subwidget edge configure -state normal
.middle.actionbar.sel subwidget edit configure -state normal
}
proc angela:tool:edge { } {
global angela_canvas angela_state
bind $angela_canvas <B1-ButtonRelease> \
""
bind $angela_canvas <B1-Motion> \
""
angela:capabilities:manager "edge line" \
angela_cap angela_cap_value
set angela_state EDGE
.middle.actionbar.sel subwidget node configure -state normal
.middle.actionbar.sel subwidget edge configure -state disabled
.middle.actionbar.sel subwidget edit configure -state normal
}
proc angela:tool:edit { } {
global angela_canvas angela_state
# Destroy capabilities window
catch { destroy .cap }
bind $angela_canvas <B1-ButtonRelease> \
""
bind $angela_canvas <B1-Motion> \
""
set angela_state EDIT
.middle.actionbar.sel subwidget node configure -state normal
.middle.actionbar.sel subwidget edge configure -state normal
.middle.actionbar.sel subwidget edit configure -state disabled
}
################################################################
#
# Edges
#
################################################################
proc angela:edge:create { canvas node1 node2 } {
angela:msg \
EDGE:CREATE:DRAW \
$node1 $node2 \
angela_cap angela_cap_value "edge line"
}
proc angela:edge:create:direct { canvas node1 node2 cap capvalue } {
global thiscap thiscapvalue
array set thiscap $cap
array set thiscapvalue $capvalue
# This is the high-level code for creating a node
angela:msg \
EDGE:CREATE:DRAW \
$node1 $node2 \
thiscap thiscapvalue "edge line"
}
proc angela:edge:create:draw { canvas node1 node2 cap \
cap_value classes } {
global $cap $cap_value angela_edges
array set newcap [array get $cap]
array set newcap_value [array get $cap_value]
set edgecmd [angela:mod:scan:type object edge]
foreach type $classes {
set attr$type ""
foreach a $newcap($type) {
set attr$type \
"[set attr$type] -$a \"$newcap_value($type:$a)\" "
}
}
set edge [$edgecmd create $node1 $node2]
set line [$edge line]
eval "$edge update [set attredge]"
eval "$line update $canvas [set attrline]"
$edge update $canvas
lappend angela_edges $edge
set carriage [lindex [$node1 export -carriage] 0]
if { [lsearch $carriage $edge] == -1 } {
lappend carriage $edge
$node1 update -carriage $carriage
}
set carriage [lindex [$node2 export -carriage] 0]
if { [lsearch $carriage $edge] == -1 } {
lappend carriage $edge
$node2 update -carriage $carriage
}
$edge bind $canvas <Any-Enter> "angela:msg EDGE:ENTER $edge"
$edge bind $canvas <B1-ButtonRelease> \
"angela:msg EDGE:SPLIT $edge %x %y"
$edge bind $canvas <Double-B1-ButtonRelease> \
"angela:msg EDGE:EDIT $edge"
$edge bind $canvas <B3-ButtonRelease> \
"angela:msg EDGE:CONTEXT $edge %x %y"
}
proc angela:edge:delete { canvas edge } {
global angela_edges angela_nodes
# Search all nodes to find dependencies
foreach node $angela_nodes {
set carriage [lindex [$node export -carriage] 0]
set index [lsearch $carriage $edge]
if { $index != -1 } {
set carriage [lreplace $carriage $index $index]
$node update -carriage $carriage
}
}
[$edge line] delete $canvas
$edge delete
set index [lsearch $angela_edges $edge]
set angela_edges [lreplace $angela_edges $index $index]
}
proc angela:edge:highlight { canvas edge } {
global angela_lasthighlight angela_option
# debug "edge:highlight $canvas $edge$"
if { $angela_lasthighlight == $edge } { return }
set angela_lasthighlight $edge
angela:msg EDGE:SPLIT:NONE
set line [$edge line]
set coords [lindex [$line export -coords] 0]
set length [llength $coords]
set length [expr ($length-1)/2]
set which 0
foreach { x y } $coords {
if { $which != 0 && $which != $length } {
$canvas create rectangle \
[expr $x-4] [expr $y-4] [expr $x+4] [expr $y+4] \
-fill black -outline white -width 1 \
-tags "eh hl$edge $edge $line eh$which"
}
if { $which != 0 && $which != $length } {
$canvas bind eh$which <B1-Motion> \
"angela:msg EDGE:SPLIT:MOVE $edge $which eh$which %x %y"
# "angela:edge:split:move:grid $canvas $edge $which eh$which %x %y"
$canvas bind eh$which <B1-ButtonRelease> \
"angela:msg EDGE:SPLIT:MOVE:END $edge"
}
incr which
}
}
proc angela:edge:lowlight { canvas { edge "" } } {
# debug "edge:lowlight $canvas $edge"
if { $edge == "" } {
$canvas delete eh
} else {
$canvas delete hl$edge
}
}
proc angela:edge:split:distance { x1 y1 x2 y2 } {
set distance [expr sqrt( pow($x1-$x2,2) + pow($y1-$y2,2) )]
return $distance
}
proc angela:edge:split:add { canvas edge x y } {
global angela_lasthighlight
# debug "split:add $canvas $edge $x $y"
set line [$edge line]
set coords [lindex [$line export -coords] 0]
set origcoords $coords
angela:edge:lowlight $canvas $edge
# Scans for minimal distance
set found 0
for { set i 0 } { $i < [expr [llength $coords]-2] } { incr i 2 } {
set xa [lindex $coords $i]
set ya [lindex $coords [expr $i+1]]
set xb [lindex $coords [expr $i+2]]
set yb [lindex $coords [expr $i+3]]
if { [expr abs(([angela:edge:split:distance $xa $ya $x $y] + \
[angela:edge:split:distance $xb $yb $x $y]) - \
[angela:edge:split:distance $xa $ya $xb $yb])] <= 1 } {
set found 1
break
}
}
set i [expr $i/2]
# Set the beginning of the coords
set newcoords "[lrange $coords 0 1]"
set coords [lreplace $coords 0 1]
while { $i > 0 } {
# Get the next two coords
set newcoords "$newcoords [lrange $coords 0 1] "
set coords [lreplace $coords 0 1]
incr i -1
}
set newcoords "$newcoords $x $y $coords"
$line update $canvas -coords $newcoords
set angela_lasthighlight ""
angela:edge:highlight $canvas $edge
}
# proc angela:edge:split:move:grid { path edge id tag x y } {
# global angela_gridx angela_gridy
# angela:edge:split:move $path $edge $id $tag \
# [$path canvasx $x $angela_gridx] \
# [$path canvasy $y $angela_gridy]
# }
proc angela:edge:split:move { path edge id tag x y } {
# debug "split:move $path $edge $id $tag $x $y"
$path coords $tag [expr $x-4] [expr $y-4] [expr $x+4] [expr $y+4]
# Set leaf $id of edge $edgeid to $x,$y
set line [$edge line]
set coords [lindex [$line export -coords] 0]
set coords [lreplace $coords [expr $id*2] [expr $id*2] "$x"]
set coords [lreplace $coords [expr $id*2+1] [expr $id*2+1] "$y"]
$line update $path -coords $coords
# $edge update $path
}
proc angela:edge:split:move:end { path edge } {
$edge update $path
}
proc angela:edge:set { canvas edge cap cap_value } {
global edgecap edgecap_value
# debug "edge:set $canvas $edge ..."
foreach i $edgecap(edge) {
$edge update -$i $edgecap_value(edge:$i)
}
foreach i $edgecap(line) {
[$edge line] update $canvas -$i $edgecap_value(line:$i)
}
}
proc angela:edge:update { canvas edge } {
global edgecap edgecap_value
# debug "edge:update $canvas $edge"
angela:edge:set $canvas $edge edgecap edgecap_value
}
proc angela:edge:edit { canvas edge } {
global angela_cap angela_cap_value edgecap edgecap_value
# debug "edge:edit $canvas $edge"
angela:capabilities:get:user $edge \
" edge $edge line [$edge line] " \
edgecap edgecap_value
angela:capabilities:manager "edge line" \
edgecap edgecap_value "angela:edge:update $canvas $edge"
}
proc angela:edge:context { path edge x y } {
global angela_option
catch { $path delete contextmenu }
catch { destroy .contextmenu }
menu .contextmenu -tearoff 0 -font $angela_option(gui:font:cap) \
-borderwidth 1
.contextmenu add command -label "Delete Edge" \
-command "angela:msg EDGE:DELETE $edge;\
$path delete contextmenu;destroy .contextmenu"
tk_popup .contextmenu [winfo pointerx .] [winfo pointery .]
}
################################################################
#
# Nodes
#
################################################################
proc angela:node:create { canvas x y } {
global angela_option
# This is the high-level code for creating a node
return [angela:msg \
NODE:CREATE:DRAW \
[$canvas canvasx $x $angela_option(gui:grid:x)] \
[$canvas canvasy $y $angela_option(gui:grid:y)] \
angela_cap angela_cap_value "node shape text"]
}
proc angela:node:create:direct { canvas x y cap capvalue} {
global thiscap thiscapvalue
array set thiscap $cap
array set thiscapvalue $capvalue
# This is the high-level code for creating a node
return [angela:msg \
NODE:CREATE:DRAW \
$x \
$y \
thiscap thiscapvalue "node shape text"]
}
proc angela:node:create:draw { canvas x y cap cap_value classes } {
global $cap $cap_value angela_nodes
# This is the low-level code for creating a node
# This is hard-coded into node/shape/text
# Copy the capabilities into new variables
array set newcap [array get $cap]
array set newcap_value [array get $cap_value]
set nodecmd [angela:mod:scan:type object node]
set shapecmd [angela:mod:scan:type object shape]
set textcmd [angela:mod:scan:type object text]
set newcap_value(node:x) $x
set newcap_value(node:y) $y
set newcap_value(shape:x) $x
set newcap_value(shape:y) $y
set newcap_value(shape:coords) "$x $y"
set newcap_value(text:coords) "$x $y"
foreach type $classes {
set attr$type ""
foreach a $newcap($type) {
set attr$type \
"[set attr$type] -$a \"$newcap_value($type:$a)\" "
}
}
set node [$nodecmd create]
set shape [$node shape]
set text [$node text]
eval "$node update [set attrnode]"
eval "$shape update $canvas [set attrshape]"
eval "$text update $canvas [set attrtext]"
lappend angela_nodes $node
angela:ws:canvas:refresh .middle.canvas
$node bind $canvas <B1-ButtonRelease> \
"angela:msg NODE:MOTION:END $node"
$node bind $canvas <Double-B1-ButtonRelease> \
"angela:msg NODE:EDIT $node"
$node bind $canvas <B1-Motion> \
"angela:msg NODE:MOTION $node %x %y"
$node bind $canvas <Shift-B1-ButtonRelease> \
"debug sB1rel$node"
$node bind $canvas <Alt-B1-ButtonRelease> \
"debug aB1rel$node"
$node bind $canvas <Control-B1-ButtonRelease> \
"angela:msg NODE:SWITCH $node"
$node bind $canvas <B2-ButtonRelease> \
"angela:msg NODE:SWITCH $node"
$node bind $canvas <B3-ButtonRelease> \
"angela:msg NODE:CONTEXT $node %x %y"
return $node
}
proc angela:node:delete { canvas node } {
global angela_nodes angela_selected_nodes
angela:node:unselect $canvas $node
# Destroy all related edges
foreach edge [lindex [$node export -carriage] 0] {
angela:edge:delete $canvas $edge
}
# Destroy the node
[$node shape] delete $canvas
[$node text] delete $canvas
$node delete
# Remove the node from the node list
set index [lsearch $angela_nodes $node]
set angela_nodes [lreplace $angela_nodes $index $index]
}
proc angela:node:highlight { canvas node } {
set shape [$node shape]
eval "$canvas create rectangle [$canvas bbox $shape] \
-tags \"hl hl$node $node\" -width 2 -outline red"
}
proc angela:node:lowlight { canvas node } {
$canvas delete hl$node
}
proc angela:node:select { canvas node } {
global angela_selected_nodes
angela:node:highlight $canvas $node
lappend angela_selected_nodes $node
}
proc angela:node:unselect { canvas node } {
global angela_selected_nodes
set index [lsearch $angela_selected_nodes $node]
if { $index != -1 } {
angela:node:lowlight $canvas $node
set angela_selected_nodes \
[lreplace $angela_selected_nodes $index $index]
}
}
proc angela:node:switch { canvas node } {
global angela_selected_nodes
set index [lsearch $angela_selected_nodes $node]
if { $index == -1 } {
angela:node:select $canvas $node
} else {
angela:node:unselect $canvas $node
}
}
proc angela:node:move { canvas node dx dy } {
$node move $canvas $dx $dy
foreach e [lindex [$node export -carriage] 0] {
$e update $canvas
}
}
proc angela:node:drag:end { canvas } {
global angela_dragflag
set angela_dragflag 0
}
proc angela:node:drag { canvas node x y } {
global angela_dragflag angela_posx angela_posy angela_selected_nodes
set nodes $angela_selected_nodes
if { [lsearch $nodes $node] == -1 } {
lappend nodes $node
}
if { !$angela_dragflag } {
# Starting with drag
set angela_dragflag 1
set angela_posx $x
set angela_posy $y
} else {
# I am currently dragging
# Move to current position
set dx [expr $x-$angela_posx]
set dy [expr $y-$angela_posy]
foreach n $nodes {
angela:node:move $canvas $n $dx $dy
}
set angela_posx $x
set angela_posy $y
}
}
proc angela:node:set { canvas node cap cap_value } {
global nodecap nodecap_value
foreach i $nodecap(node) {
$node update -$i $nodecap_value(node:$i)
}
foreach i $nodecap(shape) {
[$node shape] update $canvas -$i $nodecap_value(shape:$i)
}
foreach i $nodecap(text) {
[$node text] update $canvas -$i $nodecap_value(text:$i)
}
[$node text] raise $canvas [$node shape]
}
proc angela:node:update { canvas node } {
global nodecap nodecap_value
angela:node:set $canvas $node nodecap nodecap_value
}
proc angela:node:edit { canvas node } {
global angela_cap angela_cap_value nodecap nodecap_value
angela:capabilities:get:user $node \
" node $node shape [$node shape] text [$node text] " \
nodecap nodecap_value
# foreach class { node shape text } {
# foreach i $nodecap($class) {
# debug "Cap $i=$nodecap_value($class:$i)"
# }
# }
angela:capabilities:manager "node shape text" \
nodecap nodecap_value "angela:node:update $canvas $node"
}
proc angela:node:context { path node x y } {
global angela_option
catch { $path delete contextmenu }
catch { destroy .contextmenu }
menu .contextmenu -tearoff 0 -font $angela_option(gui:font:cap) \
-borderwidth 1
.contextmenu add command -label "Switch node" \
-command "angela:msg NODE:SWITCH $node;\
$path delete contextmenu;destroy .contextmenu"
.contextmenu add separator
.contextmenu add command -label "Delete node" \
-command "angela:msg NODE:DELETE $node;\
$path delete contextmenu;destroy .contextmenu"
tk_popup .contextmenu [winfo pointerx .] [winfo pointery .]
}
################################################################
#
# Bug Management
#
################################################################
proc angela:bug { } {
global tcl_platform \
bugreport_name \
bugreport_source \
bugreport_system \
bugreport_install \
bugreport_motivation
set w .bugreport
catch { destroy $w }
toplevel $w
wm title $w "angela!:Bug Report generator"
angela:prefs:window $w BugReport
# Create the notebook widget
tixNoteBook $w.nb -ipadx 6 -ipady 6
$w config -bg gray
$w.nb subwidget nbframe configure -backpagecolor gray
# Create the tabs in the notebook
$w.nb add general -label "General" -underline 0
pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
# Create the general page
set f [$w.nb subwidget general]
label $f.head -text \
"This generates a file you can send to the author via your mail tool."
frame $f.f
frame $f.common
pack $f.head $f.f -side top -padx 2 -pady 2 -fill both -expand yes
pack $f.common -side bottom -padx 2 -pady 2 -fill x
tixLabelEntry $f.f.name -label "Your name: " \
-options {
entry.width 50
label.width 25
label.anchor e
entry.textVariable bugreport_name
}
tixComboBox $f.f.source -label "Where did you get angela!: " -dropdown true \
-editable true -variable bugreport_source \
-options {
listbox.height 5
label.width 25
label.anchor e
entry.width 50
}
$f.f.source insert end "Official Homepage of angela!"
$f.f.source insert end "Official FTP-Server"
$f.f.source insert end "Local FTP-Server"
$f.f.source insert end "Magazine's CD-ROM (Name: xyz)"
$f.f.source insert end "Local grocery"
$f.f.source insert end "My Milkman deposited it here!"
tixLabelEntry $f.f.system -label "Your system: " \
-options {
entry.width 50
label.width 25
label.anchor e
entry.textVariable bugreport_system
}
set newval ""
foreach i [array names tcl_platform] {
append newval $tcl_platform($i) " "
}
uplevel #0 set bugreport_system \"$newval\"
tixComboBox $f.f.install -label "Difficult to install ?: " -dropdown true \
-editable true -variable bugreport_install \
-options {
listbox.height 5
label.width 25
label.anchor e
entry.width 50
}
$f.f.install insert end "No, it was not difficult! (no major changes made)"
$f.f.install insert end "Yes, it was difficult! (major changes made)"
$f.f.install insert end "I used the binary version."
$f.f.install insert end "Our sysadmin made the installation!"
$f.f.install insert end "I didn't manage to get it work! (huh!)"
tixComboBox $f.f.motivation -label "Overall opinion ?: " -dropdown true \
-editable true -variable bugreport_motivation \
-options {
listbox.height 5
label.width 25
label.anchor e
entry.width 50
}
$f.f.motivation insert end "Continue improving angela!"
$f.f.motivation insert end "angela! will end in a dead-project!"
$f.f.motivation insert end "I am enjoying using angela!"
$f.f.motivation insert end "I cannot imagine working without angela! (really thanks)"
label $f.f.contexttext -text "Describe the context as the bug occured:"
tixScrolledText $f.f.context -height 60
label $f.f.actiontext -text "Describe the action you were doing (or wanted to do):"
tixScrolledText $f.f.action -height 60
label $f.f.changetext -text "Describe the change you would like to see:"
tixScrolledText $f.f.change -height 60
pack \
$f.f.name \
$f.f.source \
$f.f.system \
$f.f.install \
$f.f.motivation \
$f.f.contexttext \
$f.f.context \
$f.f.actiontext \
$f.f.action \
$f.f.changetext \
$f.f.change \
-side top -fill x -expand yes
# Create the common buttons
angela:bug:CreateCommonButtons $w $f.common $f
}
proc angela:bug:CreateCommonButtons {w f realf} {
button $f.ok -text "Save to bugreport.txt" \
-command "angela:bug:okcmd $w $realf;\
angela:prefs:window:save $w BugReport"
button $f.cancel -text Cancel -width 6 \
-command "angela:prefs:window:save $w BugReport"
pack $f.ok $f.cancel -side left -padx 2 -pady 2
}
proc angela:bug:okcmd {w f} {
global \
bugreport_name \
bugreport_source \
bugreport_system \
bugreport_install \
bugreport_motivation
if { [catch { set handle [open "bugreport.txt" w] }] } {
angela:dlg "Cannot open bugreport.txt file!!! Aborting."
return
}
puts $handle "Subject: \[angela! BR\]"
puts $handle ""
puts $handle "Bug report for angela! Send this file to angela@itm.uni-sb.de"
puts $handle "using your conventional and preferred mail tool."
puts $handle "Please make sure, that the subject line contains the content"
puts $handle "of the first line (without the Subject: prefix, of course)."
puts $handle ""
puts $handle "-------------------------------------------------------------"
puts $handle " Name of user: $bugreport_name"
puts $handle "Source of angela!: $bugreport_source"
puts $handle " Local system: $bugreport_system"
puts $handle "Installation deg.: $bugreport_install"
puts $handle " Motivation: $bugreport_motivation"
puts $handle ""
puts $handle "-------------------------------------------------------------"
puts $handle "Tcl/Tk infos:"
puts $handle " Command count: [info cmdcount]"
puts $handle " Loaded libraries: [info loaded]"
puts $handle " Called library: [info library]"
puts $handle " Executable: [info nameofexecutable]"
puts $handle " Patchlevel: [info patchlevel]"
puts $handle ""
puts $handle "-------------------------------------------------------------"
puts $handle "Context of problem:"
puts $handle "[$f.f.context subwidget text get 1.0 end]"
puts $handle ""
puts $handle "-------------------------------------------------------------"
puts $handle "Action trigerring the problem:"
puts $handle "[$f.f.action subwidget text get 1.0 end]"
puts $handle ""
puts $handle "-------------------------------------------------------------"
puts $handle "Change requested:"
puts $handle "[$f.f.change subwidget text get 1.0 end]"
puts $handle ""
puts $handle "-------------------------------------------------------------"
puts $handle "End of bug report. Append your comments below this line."
close $handle
}
################################################################
#
# Load
#
################################################################
proc angela:load { { filename "" } } {
global angela_mod_list angela_filename
set defaultextension ""
if { $filename == "" || ![file exists $filename]} {
# Scan all filter_in modules to produce extension list.
set extensions " { \"All files\" * } "
set modules [angela:mod:scan $angela_mod_list type "filter_in"]
foreach i $modules {
set extensions "$extensions { \
\"[angela:mod:info:algorithm_name $i]\" \
\"[$i extension]\" }"
set defaultextension [$i extension]
}
set initialdir [angela:prefs:read LoadPath]
if { $initialdir == "" || ![file exists $initialdir] } {
set initialdir ./
}
set file [ tk_getOpenFile -filetypes $extensions -parent . \
-initialdir $initialdir \
-defaultextension $defaultextension ]
if { $file != "" } {
angela:prefs:write LoadPath [file dirname $file]
angela:load $file
}
} else {
set extension [file ext $filename]
set modules [angela:mod:scan $angela_mod_list type "filter_in"]
set module ""
foreach i $modules {
if { [$i extension]==$extension } {
set module $i
break
}
}
if { $module == "" } {
debug "Did not found any module for file $filename"
}
debug "Filetype according to extension is $module"
angela:load:module $filename $module
}
}
proc angela:load:module { filename module } {
global angela_filename
# first delete the current graph
angela:msg GRAPH:NEW
# open the file and read the graph
set handle [open $filename r]
angela:load:module:do $handle $module
close $handle
# update file filename information in editor
set angela_filename $filename
angela:ws:title:init .
angela:msg TOOL:EDIT
}
proc angela:load:module:do { handle module } {
global angela_nodes angela_edges
$module load $handle angela:msg $angela_nodes $angela_edges
}
################################################################
#
# Save
#
################################################################
proc angela:save:as { { file "" } } {
global angela_mod_list
if { $file != "" } {
angela:save $file
return
}
# Scan all filter_out modules to produce extension list.
set extensions " { \"All files\" * } "
set modules \
[angela:mod:scan $angela_mod_list type "filter_out"]
set defaultextension ""
foreach i $modules {
set extensions "$extensions { \
\"[angela:mod:info:algorithm_name $i]\" \
\"[$i extension]\" }"
set defaultextension [$i extension]
}
set initialdir [angela:prefs:read SavePath]
if { $initialdir == "" || ![file exists $initialdir] } {
set initialdir [pwd]
}
set file [ tk_getSaveFile -filetypes $extensions -parent . \
-initialfile Untitled -initialdir $initialdir \
-defaultextension $defaultextension]
if { $file != "" } {
angela:prefs:write SavePath [file dirname $file]
angela:save $file
}
}
proc angela:save { filename } {
global angela_mod_list
set extension [file ext $filename]
set modules [angela:mod:scan $angela_mod_list type "filter_out"]
set module ""
foreach i $modules {
if { [$i extension]==$extension } {
set module $i
break
}
}
if { $module == "" } {
debug "Did not found any module for file $filename"
}
debug "Filetype according to extension is $module"
angela:save:module $filename $module
}
proc angela:save:module { filename module } {
global angela_filename
# Must save graph using filename and module
set handle [open $filename w]
angela:save:module:do $handle $module
close $handle
set angela_filename $filename
angela:ws:title:init .
}
proc angela:save:module:do { handle module } {
global angela_nodes angela_edges
$module save $handle angela:msg $angela_nodes $angela_edges
}
################################################################
#
# Niou
#
################################################################
proc angela:new { } {
global angela_nodes angela_edges angela_canvas angela_filename
foreach i $angela_edges {
[$i line] delete $angela_canvas
$i delete
}
foreach i $angela_nodes {
[$i shape] delete $angela_canvas
[$i text] delete $angela_canvas
$i delete
}
set angela_nodes ""
set angela_edges ""
set angela_filename ""
angela:ws:title:init .
}
################################################################
#
# Clipboard Management
#
################################################################
proc angela:clipboard:cut { } {
global angela_selected_nodes
# Scan which nodes I have to cut...
foreach node $angela_selected_nodes {
angela:msg NODE:SWITCH $node
angela:msg NODE:DELETE $node
}
set angela_selected_nodes ""
}
################################################################
#
# Message Management
#
################################################################
proc angela:msg \
{ \
message \
{ arg1 "" } \
{ arg2 "" } \
{ arg3 "" } \
{ arg4 "" } \
{ arg5 "" } } {
global angela_canvas angela_state angela_option angela_edgemem \
temp_cap temp_capvalue angela_filename
#debug "msg:$message $arg1 $arg2 $arg3 $arg4 $arg5"
switch $message {
CANVAS
{
return $angela_canvas
}
VERSION
{
set Revision "\$Revision"
set version "$Revision: 1.28 $"
set version [split $version :]
set version [string trim [lindex [lindex $version 1] 0] 0]
return $version
}
BUG
{
angela:bug
}
CUT
{
angela:clipboard:cut
}
MODULES
{
angela:mod:manager .modules
}
QUIT
{
angela:quit
}
TOOL:NODE
{
angela:tool:node
}
TOOL:EDGE
{
angela:tool:edge
}
TOOL:EDIT
{
angela:tool:edit
}
TOOL:ADD:CASCADE
{
return [angela:tool:add:cascade .menubar.tools.m $arg1 $arg2]
}
NODE:INFO
{
return [$arg1 export $arg2]
}
NODE:MOTION
{
switch $angela_state {
EDIT
{
angela:node:drag $angela_canvas $arg1 \
[$angela_canvas canvasx $arg2 $angela_option(gui:grid:x)] \
[$angela_canvas canvasy $arg3 $angela_option(gui:grid:y)]
}
}
}
NODE:MOTION:END
{
switch $angela_state {
EDIT
{
angela:node:drag:end $angela_canvas
}
EDGE2
{
set angela_state EDGE
angela:msg EDGE:CREATE $angela_edgemem $arg1
}
EDGE
{
set angela_edgemem $arg1
set angela_state EDGE2
}
}
}
NODE:CREATE
{
return [angela:node:create $angela_canvas $arg1 $arg2]
}
NODE:CREATE:DIRECT
{
return [angela:node:create:direct $angela_canvas $arg1 $arg2 \
$arg3 $arg4]
}
NODE:SWITCH
{
#if { $angela_state == "EDIT" } {
angela:node:switch $angela_canvas $arg1
#}
}
NODE:CREATE:DRAW
{
return [angela:node:create:draw \
$angela_canvas \
$arg1 $arg2 $arg3 $arg4 $arg5]
}
NODE:DELETE
{
angela:node:delete $angela_canvas $arg1
}
NODE:EDIT
{
switch $angela_state {
EDIT
{
angela:node:edit $angela_canvas $arg1
}
}
}
NODE:EDIT:GET
{
angela:capabilities:get:all $arg1 \
" node $arg1 shape [$arg1 shape] text [$arg1 text] " \
temp_cap temp_capvalue
return "\{ [array get temp_cap] \} \{ [array get temp_capvalue] \}"
}
NODE:CONTEXT
{
angela:node:context $angela_canvas $arg1 \
[$angela_canvas canvasx $arg2] \
[$angela_canvas canvasy $arg3]
}
EDGE:INFO
{
return [$arg1 export $arg2]
}
EDGE:EDIT
{
switch $angela_state {
EDIT
{
angela:edge:edit $angela_canvas $arg1
}
}
}
EDGE:EDIT:GET
{
angela:capabilities:get:all $arg1 \
" edge $arg1 line [$arg1 line] " \
temp_cap temp_capvalue
return "\{ [array get temp_cap] \} \{ [array get temp_capvalue] \}"
}
EDGE:CREATE
{
angela:edge:create $angela_canvas $arg1 $arg2
}
EDGE:CREATE:DIRECT
{
angela:edge:create:direct $angela_canvas $arg1 $arg2 $arg3 $arg4
}
EDGE:CREATE:DRAW
{
angela:edge:create:draw \
$angela_canvas \
$arg1 $arg2 $arg3 $arg4 $arg5
}
EDGE:DELETE
{
angela:edge:delete $angela_canvas $arg1
}
EDGE:ENTER
{
angela:edge:highlight $angela_canvas $arg1
}
EDGE:SPLIT:NONE
{
angela:edge:lowlight $angela_canvas
}
EDGE:SPLIT
{
switch $angela_state {
EDGE
{
angela:edge:split:add $angela_canvas \
$arg1 \
[$angela_canvas canvasx $arg2] \
[$angela_canvas canvasy $arg3]
}
}
}
EDGE:SPLIT:MOVE
{
switch $angela_state {
EDIT
{
angela:edge:split:move $angela_canvas $arg1 $arg2 $arg3 \
[$angela_canvas canvasx $arg4 $angela_option(gui:grid:x)] \
[$angela_canvas canvasy $arg5 $angela_option(gui:grid:y)]
}
}
}
EDGE:SPLIT:MOVE:END
{
switch $angela_state {
EDIT
{
angela:edge:split:move:end $angela_canvas $arg1
}
}
}
EDGE:CONTEXT
{
angela:edge:context $angela_canvas $arg1 \
[$angela_canvas canvasx $arg2] \
[$angela_canvas canvasy $arg3]
}
# Remove not needed hints such as edge bends to
# prepare for print.
GRAPH:CLEANUP
{
angela:edge:lowlight $angela_canvas
}
GRAPH:NEW
{
angela:new
}
GRAPH:PRINT
{
angela:print $angela_canvas
}
GRAPH:PROPERTIES
{
angela:properties
}
GRAPH:OPEN
{
angela:load $arg1
}
GRAPH:SAVE
{
set filename $angela_filename
if { $arg1 != "" } {
set filename $arg1
}
if { [file exists $filename] } {
angela:save $filename
} else {
angela:msg GRAPH:SAVEAS $arg1
}
}
GRAPH:SAVEAS
{
angela:save:as $arg1
}
default
{
tk_dialog .error \
"Unknown message" \
"The message server received an unknown\
message to process. Request will be\
ignored.\n\
$message $arg1 $arg2 $arg3\
$arg4 $arg5" \
"" \
0 \
"Ok"
}
}
switch $angela_state {
NORMAL
{
status "Press action button."
}
NODE
{
status "Left click to create node."
}
EDGE
{
status "Left click on first node for edge,\
Left click on existing edge to create bend."
}
EDGE2
{
status "Left click on second node to create edge."
}
EDIT
{
status "Left drag to move node(s) and edge bends.\
Ctrl Left click or middle click \
to switch node. Double Left to edit."
}
}
}
################################################################
#
# Fatal exit
#
################################################################
proc fatal { text } {
puts stderr ""
puts stderr "I am sorry. Something was wrong and I cannot\
continue executing angela!."
puts stderr "Reason: $text"
puts stderr "For bug reports: angela@itm.uni-sb.de"
puts stderr ""
exit
}
################################################################
#
# Quit
#
################################################################
proc angela:dlg { text } {
tk_dialog .error \
"Warning" \
"$text" \
"" \
0 \
"Ok"
}
################################################################
#
# Quit
#
################################################################
proc angela:quit { } {
angela:prefs:window:save . MainWindow
exit
}
################################################################
#
# Startup logo
#
################################################################
proc angela:logo { } {
catch { destroy .logo }
toplevel .logo
wm title .logo "Welcome to angela!"
angela:prefs:window .logo Logo
image create photo angela_logo -data R0lGODlhyACWAMYAAP////T09Ly8vOTk5I2Xa1GPSMzMzHCLIHCOWsnYv9zc3Et2Imx0FGyUFGqGD+zs7NTU1I+mOk2YGmyjD8TExKvLkjmLFYiXLJOofqS5jXKhTZSUlJycnPz09KSkpLS0tDltIDR8HCxpHEeHGqysrHx8fIyMjFG5H4W5VI2WiEapGmxsbHR0dFRUVCwsLBQUFCQkJDw8PBiIPeTs7AdMITehGPzs9ERERAAAAFxcXOJUYesFFO2apPwEHK0SHS6MFaKiov8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A//8A/yH+FG1hZGUgYnkgT2xpdmVyIFBhYnN0ACwAAAAAyACWAAAH/oAAgoOEhYaHiImKi4yNjo+QkZKTlJWWl5iZmpucnZ6foKGio6SlpqeoqaqrrK2ur7CxsrO0tba3uLm6u7y9vr/AwcLDxMXGx8jJysvMzc7P0KwBDwHV0dePAYPWiQMFMuAZBjPY5YcQGgUYAxkFGhTahAMkBhng9zIV8fIZGR4J1Mwpq7AghIgQBERYGDEiAzlBCmTQoPFtIkUBCh5sq1YDn7qHAnfF4zZIQIiTIEQsECFixEIMCgQVoIGP5goPHyAM0GbgGwdwFmVQmLEvpK0BBAoIMHAAQYJ4CgqeDLFgJUsRBRB4eDAAn0SaLDws3TnDo8UCHwwoKCpoGjW2/kZPDai6gEEDBw4aCND4AEIGAggQiAABggUBExvozaAgEVwIoC08UBhAzgNNmo1ZpCBBIWPRAR1lFBAHMm6pABHwVpUwoXUDChoDzDDwYWWIEQUSfxhbQXSKDd8ak4AQL/g9iynSZhQ0r57XfHBNg6owAa+FAw0atL4AU9sDBQYEM9QqAAIEBTMezIDwwYOHiiKGx7sXosTxEhihfq04Uely6ZmQxNYDCfylAV4FELABB+VpBIB6CiAAwgIm5DQANR0AEAB4FEBggAApFCCfIGK19xNQJQw1yEz02YSTTtEBmE07CHSogQbrxNPBhhRk5wADG+DUYIZtKaBBCgwq/kDkIFwN4KQCFOxGXFsD0CaAAO/JkMJkzHk1kQxhjRWjjIw8UAAIJxVQQEsWFDAlAB30FUF2B4hlgE4PLAmADRAIkNYAh+wTwADmrTXIDIQqoECfHIgFKAAGNCbDYxJF1hlI3JBEZqAFoDSYVQwV8FRbfV0wAQH0XBiAnoL0dZ4NjcyQXiHqVTMDhwY82lsBvwVH04gP0mgjjjttaggGI0xFFWEsLZDVAER20EECGHCQk4OIuLWJbApQdih77sE3XKtnptmpS26OmYkCOrSrww4Q7KLABxggQEBBKpVQQpCdFdWXAJ2xepqA4BlgMIgiEhdApyd9Olioo4LCQw8U/u/QwiwExvOdNjtCWUIIIDBkggckfNBZQILEaR62rzRJGZRSBoDBVIQx2+yz6lbCJ8U9+GBALAFUcMIEKCRQgXYHPDUoeymNsEByd+JZiLR5ziLooudtWEG99xK2gL78GtrJABNXfDEsD6DQWmsoDC2BdhlQ890HIZPn2arCqOcgjwScJDLJu/23CQ86UOzD4fG2jEJ2a6vd2tsT6NNqBggkZgDLxyz9wWBUQX1eRgJbYkMPO/hAQQclwDKAqa2dMHQEEQztmgQRVxk45plzRULdYnkWOiYCsPD7KtMYjQLsB6gwgQasL4/B3oRCULUzD1DOAT24YzMNzASwNsEJ/gSk8Fuq+zyA8jMDRNlhzs5s/6EGErB2QQQc1C+Z4HBiEz20cOKtIfvG2B4FMKCdCVyAANf7gMmkB0BluEUbEEgKBmbQjndkzxGdycWOBqAAAcBvAhFIzFLuBDrTdKACaDJIQhbSkNJAgnAi+U4FVHAkO3XrQhfEhkmmohKW3MYCOYqEDd7FA14MCgMkuN7JqjG8a0QFJSBbSUompJUGDqJsPujFv0qmFis+oy9/CQzIQLACBVkrV5AYYsWK+IoAUIAAEchANQxAAALIcWkUuFMOQyIb9oygJbjRjZgcwS6e+eAGsGrFAOZ0FwZEoAIMYMCPGAAbDnbLi9H4Tnge/kYeEhbrEYXbAQteoYALZOeUB7hAJCP5owzgEJPX4AoEJESh4ZgPlqFMnTQycEo6OeAABJikJC9wgQqcz1jbMFIKegdLQYRylKwYQAWOd4AD5IUB1VTlKodpgGaWIwB9+lMldHA4aK5CWhykAAkwQABJ5iUCCFgBAwyDPT5C4jvn2WMv3NceBODFAcQ8DGI28CdvAqMaD+DADXTJCBvM6hgbhECUVJkXUyGQZFz8JDSqMQATwAAHOMiBQRGhT1hMg1AG8IADRpDKCzRqNwBTy/SaUQ0FsOAFIAWpSLfFAhywQFO1OGmVMFDRkaXlc91qYjGqQYKcOnWnARJATm8A/lRBJC4WHagSAS6AGM7gKU/+o2kAPuCCGzgVBy0oaSOqUQKnCiA6MJxF+jyQwFwpNRkcBU8LnJrWAD2gpznlAO5swIMdsBFoMDMZ/qKRVwoAFqQtGOk2HtDWnG6FLQYI5WHb2BeD6eSueOUWBSoLWbUyYhomcCoJjgmAsvXsqqd5owbuSEc7dsszRsFnCvhaVUkMygNu1SgABlA40vlgs6NYpI8cEAEKCJMBAhCuOZa2Ad769QNOZSAheFC2HXDgFKXsJV606c4DYECywthedXPaV0xMQ6o51W4hQqmD0/Cyl9YE5nOJKTk+Emq9kO1tJKYBgZy+ALeFwGIppElN/ms2AJup3GYkL2CAaGkoQ6BNBMd8qyFKaENd6rWuhju8iO3l1AUI3m7pskgKdEJpnQQ4gCQbcIF4MsBenNmJWzjQAhe8AAYviEEJYNuWamyoBDAwgZE7GoMft0AAijCyAkpwAyC/wAUrgHKUp+GBHPj4xzcwwaO28V++4q4aH/DyC9bsghxo+RBcwSkOXKAqQxBWSabgpwcQYBeAHnCgSryhB+T8gio71ZwIfYABcpDTEpjvAx89K0MLwdHHllXOc17QguoXEyNzAKdlvQGmcTDpELOXLQEwgAumGgOn3uDMXFk1WhfLiohOdMYWbZR7SLAUBaQWpC/ojAIYndMN/iRaAGY99AAAfFYcfIDS20s2DkjwpBU0O6cincZec6ATJw3AA5FG60jKzF5sVYMCqnUSsyNrCK60OqQXksVJPaTSEdDYpUJSYIcMgGlu3wndBj4paQ/NgTmzwAQrGHUMaPUdaYtZUeaRNqkVmBNt42ArLlOUqrFNKgUwOwfmfoC0UQxxWYO0m7QaQLJXEG95N8kARKWxUfPoWQMUnL0GoIDOTY6DjChAoRLHgVmH7CcSMBsHe9vezUF620VRALg5jYHczNfWFZjPfE/y0NJx8LNBeVzEHHWqC8zjIWKDlAMDGgCxS9ByRSTyFFmlIwK62iFFFUwAmC7Bh3Yj8clI/rQ9Qf8Ah9pDgnDjgAIdh4DJb3AhDub8A6OWHqIKzPWrY93pAAfpCjTUl3XvjSvSzoHdDfBYHJgAc+azNg42IN1DcFcV6UsiTnJlvkUZbLQl+ACh1EkCieu+Tx4wwV5zugJEgUcAJPCAxElApT49FaG7/4DEBeskwLLg+iwowfVXkIPuiz2v67bGvEuwAhPckIMDZ8ExB/VrD7R+aoWrLyp4pMA7QYsrdleV13nv+3Qm0eykdnkf4gHDd3acVyVblwNMAh5p5lSsx0E8d23N9gIIBQHhV2RPoijpsT0DZ3VFMSg3Nxk5AwE8owNv12KdZX/SEidNckuyRAE8dlZ7/sGAXeZUurQ0yFeAOPBdArRbHNcqVSIAqgdSD2cAwEZzBnN7FFB0u3En4Gdmk4UorzQoSHZo6/dtJ8dahuBapTNmKMhBMxUANnB1bjEPyTZqe0EoyDeEpNZx6qSDPPgdTyd2TKKGbMgBHNRUOPACTqI3jcdBhYIeb9F5vCUobkENEKB6o+aBhDANAOckOeNaPiMKAWA0KZABb7UjQGVkV9d7IBUDJiBxb6WGJMCGNyiHJACHGhJ9mEaBzScAAPg5AAYB6WF5GfdKq/h1pzY1c0RsN8ABHbh+iraHdaYI7VIxiOcJRqMBKhACP/ADJ5ECF2YIiUYByRYDjaJQboVH/qVog6Tyd6ooQA2YU8+2in3ybkIHiKSFcbZoi5lCiOVGaWoHUjAgeBAQjB/IFTgAA8WYCBlSMfLXCRBwAiqgAjXwjB3xAwMgABWQAESSaB1FfFFCV6JIYOpkim74AeGoSX4Sbgv3IISCXTmVK4vyayGFNwIjflSiiwG2EZAHWbdFelaYjw9QVrfUCFiUYZAQJxlAkAVZAyHgDj9gARagAZzoJKTVAh6CJcq3jbvXjY2WMnKokU71XSApUcgXbj8lh+jofoC4dV4YKDBwMQTmedsgkvt4Q+CBj5RGhg2kAKUDcp/AFR+gATVgASFQlERJlCHwPPinhyAleDlHAp6Y/lNv1RcX6Y2cBzOquJg5dyUF6AIskAOExo7H52rZgmY4EANPiG2xsSF5522LwpYbYWQC5nph1Qk4mAISQJQSUJB7OQJq4SE6iH+00ZSGyY0Y2SqMWZUYKFFR4mOUKXZDpiovaHibR43TsGo/VZZQiFpO5X5XNwCk2YimiTEKgAF3WQM1MAIFqQJ7iQEeQgE8V3tRQgLoiAOHKVEkAICn2JuBNVngMWgwMBm7NxmKomMclXNsmI7W+QCqBw/OeWoIBYB4CH3V2Yi2MCitWQMGqQIr8J1EKQ4dGZ1TuQFoOCgfApUg9Z5R0piLKZKCd37edpNXqU6jBlkb4CcbMJyb/smJFmhmJwWAIOcdCiBxjGgIeWQLD/CgBikDJpACCAA/FlABtIGeTvUC/9ZTo6ZkG7ACb3hobpiKivkgsRaY3lai5tOImvQBpSeB5DiI9+hq0PelH1ANAuBjrvYAwUMID/BuZ2M132mQK7AgHrABJsACAJN8/VloOJUDOuinS0gCPOcChwIz6XkDpDIAaCl0LfCogNoC3dd9HuAdpAiAYOpoSwYBEseH2wOYrCZ0JglSopaMGsJsbwUJEKADMfEJAYACKoACGBCkOPEBSbQBeSR7KQpSLMABfboUBNhsJZARu3d0pEYc6QSm1wYD3dSlNaisLKB/qTZwpIqfBhB0/poHAaAKUpVaZANHAgBEWITjAzopCUZqIjhBc8i3FEy5AYb3AtfDARh6YneCqWcVA4QCddcWrYviARGorC+ArMfnASXwr3PmAd3yFl96r4tCVmdlfhKFji+wWuKXanIGA2uRMxRQXD0jCrfCewsUkx1ynruBcCywAQdDcSxwE4DYopCaAyuQfWCjhoDafTErs7/3IbAYUjDbs9x3AzdgciJlm0X3pJAaFmohraU4qZIKs9fHektpAt2nd4BIG9ynd3fzPwsZs7SXMx1QXBZDifdpMJ4hS+aRc3l0HpbkITmnFufHIX6SR5fEicdnMvY3iI43WqZXc0kYNYqSWi9w/oBOdyUUBzBq+xYHiJVNmLBNMp5p23RnK7f6p7WAeEk4WTHmBApL4xcogAJrkQCymgDnQXYJ+4d2V7pZl4QJy4n4x7bdZpqOV3As4FkeUru02y1mRWaA6Lqfo2NF1rpJeLhliDWHm6Wnu6WTlaVaqKOG4wNW6bEQoDZDcwIJsDYTkAHnd0tHiUNvcVKnO4VHmZ+re5RSNXane76kO4+l6TLKKyBlaEl92L3vC75lqL3/6ZZuh0UGYAOtKgoD4DitEwETcEoT4JeaYpof9j+W90Due4jdq8ADsGqOxr22aEnd4gKGap2JhrjK6cD42xb/Y2QaLGDXyQiF5bzlWgkK/sBI1gvApwQQlxAdoYNQM1BZJVBVS9YtwKVkzWAAJnAKoNs2rnMC1RQ7a6MdEJDClcBREQxsP5MtdDlnpoVMgXJS9YABGjABrIECBHAjqHI5eYZ/6cl2gUKdICWgVFwJL+gB8fM9FyA+CyJOpJBXELB1INVmJWACwLgC7/YCb4VetWY1U/k28rNMgJMrgFxiXpdzJrCr1+YCsHGau0BcyNUKeJTF3xMBJAMwefR+nrDIS0iVYAoDjmaiwVAlo0MxOkBkqoBQHTQBNLQZS/E5y/vJ+KRznCy1MYDBZcUC1IaLp8yxPPNaiFWXSKJYHzwKdIy2SBiI+Tm5weBaPLMD/jHAypbMHslXHjo2xQGyPbbXtrfLuImsCiS4Yj3TAkosCnHnJ/SiAckSlNasuUIFcc4cv+OsCh2QE840aVYzABhgkAf5jM9YAERxzyVmeVrKwcrQvwuqAELzndw5lBWgAQvwDuk8CQgswmlsCrIEqwaJlwXAlwuBcsYCTnvhRrDRPlxhAMDhEiPAjCowlEXJzRuFAQsAAhpwLw5AAGKzDH0kAAjAnd0Jm3hpAXuxKZBEFwTsuQZtUkZClEJdABIKRJ5sDgNwF/9UQK0RAWGZDAMgAQ76kyyAAD9ZlNIjIxUQAdhxACPwSwcQAQQgeE3dRgBtkCGgxxwAGGqCARiA/olzvQs7wh7Y4QALECQlIz0XjQuvWpAnUAB67AFCGtLOCI0hkAJ/rQsaegDVcQDWkrY0bUSy6h4Lwms9+ZMCDQ4L2ZCXXQtxwg6toRUdgkPOoIa7NkIG4NFlLQEaINNGyUfV88a2lNgicXxXkrRVQgJ2iZcvvZd5KUfKwKbIKtdTs5CHfYI0dSuetbrHXQJgXQOvCZ7K/SbGEBU3nQFO4wBHTQgdUDBVjVdSuIGLiQENOtREbQEZ0Cd8TQIM7QsPIGNVYU2uYUzT3d4OpNAQMd/cuQLf/YwuIdAnQeCtrAi89E/YsTbFxBbSQiY9GtYqAKRCCtMAjZAyIJ4VIOCu/hA0cERbdRQ3D4ICpiQB1vRLcC0On609c1oDddooG1ACZA3RQOnORDkCo1KJW0NQqw0Rah3jBABJ23Q6gzJAqlEC9ZNjRx4Miy2rtEpxd7oBCNCaeEnWzN0QzHgSz1jZ6BUjG2JK4kVe7hQ3fYEBA+wA5CG31m0s50pX6XowyQfZBcCd3vnRFvADPxnTPxAaqR0xw4UBB5QAD8JOPD0SFZDic7Ti7NBLDZBfwbRKfmZMiibAb6wc/UjFH0uYIet4yFcALsGdCzDVC/DPEB0Cus3b1VAB2IHVBsDmBMBBSY4XzfVcEYABu/5g2SRhDEBh1JAAB8Qg/LPRZAacJBQb/t+BAUT5oGpC1CPQHsl9GxrA3EBEQKgEUNs0XmruIxHGSpGEAYPJTjL2TjaGY5cjLQlgq2jE7I1Yuf0oMw6a744NGPETAtbyASkwAtz53UFu6XcBTDKm6ZaO6cIEUOa1hHvWZwEFaH+SIZ111vROCLJS0IZQARxeAFLuHilgAghEL9tJ3+DZ1qmUX8J+AQmv6djRZ8NO7Lz2ARRFY6eia7NXLK09UxkPwohgADVwIyOfQLa6ax/QoACt4AUJjQigQHntTxUFGPNkL0HKTuVVY/JkGOn6dCt1by+1hHKLkhn+844AAQmAfI3Ca+p6JRQA1t/p4UPamiIC9e50byaQ/vd5Xz8c4E/D9Gd5nxh1B3NFNXtIBeFmHygMSJi9lnXm8aAJbqd4WgIEUKsZ8CN+dgF2aj/uoUrZkWsYhcxaNXeC/1U2kJqJ/wiapHNJS8NOAqtYvkxavvac7E+fX/k1b6sKpFILAPZCwvprkVXq9FJ2lfoxjE/dQhTWeedhf3t+0mt9gh3Jzmt30reEL3N2Eog70TFRgszCbfyct4HR8bG6X3e7m08b8gEHkMcMQnsITUdcVfpXtyMYpkkqCP7uVWJji/4nlR4ZAk6A8OHBQUKh8ACQqDhAMejxYTDQoUjZ8TBwOEm5ydnp+QkaKjpKWmpqGjAAAaEwgEgZQDlg/iDwIRAZuxmgQGFrAPGgydkREHx6jJysvMz8OfMckPuZCvGbOfxQ/SsZKtz8DR4ufiwtmtpq7Hl5WD7u/g4fvxwd4D1c3C6vv8+/32HfL6DAgYqAGASyyWBBhYkONjyI0JPDhxEXJkQIMaJChp0mAthY8VRGiSE5cSQoKqTGiSA/YlRZ0mLLkx4dMpwZ86FLnctu5jxpMidKkzwr+tzZ0mLHl0hhGk2Kc6lMplBv7iy6MuvTrENDYWz4UWlUjkApVS0J0WXVplJ1jqX6EqZbt3DZdgX1taBStVr3juRrdy5clkyDTmUL0ibatBQLc716VyLFsDz3Qi5rOCndumYLXF88bHVl58+joZYWGhmsXrF1j356O5qyZrqqD9slHLgybdiYUy8ESjb4U6/CSYsG7jjocLKdRcc+zVitZd/U36Gujj17vOvau3v/Dj68+PHky5s/jz69+vXsOQUCADs=
button .logo.logo \
-command "angela:prefs:window:save .logo Logo" \
-image angela_logo
pack .logo.logo
update
after 8000 { catch { angela:prefs:window:save .logo Logo } }
}
################################################################
#
# Execute a Tcl command
#
################################################################
proc angela:tcl:exec { path } {
set command [$path get]
debug "Executing $command"
puts stderr [eval $command]
}
proc angela:tcl { } {
catch { destroy .tcl }
toplevel .tcl
wm title .tcl "angela!:Tcl Command"
frame .tcl.up -borderwidth 2 -relief ridge
frame .tcl.down -borderwidth 2 -relief ridge
pack .tcl.up .tcl.down -side top -fill both -expand yes
button .tcl.down.exec -text "Execute..." \
-command "angela:tcl:exec .tcl.up.entry"
button .tcl.down.cancel -text "Cancel" \
-command "destroy .tcl"
label .tcl.up.label -text "Command:" -width 10
entry .tcl.up.entry -background white -width 30
bind .tcl.up.entry <Return> "angela:tcl:exec .tcl.up.entry"
focus .tcl.up.entry
pack .tcl.up.label .tcl.up.entry -side left -fill x \
-expand yes
pack .tcl.down.exec .tcl.down.cancel -side left -fill both \
-expand yes
}
################################################################
################################################################
################################################################
##
## Main part
##
################################################################
################################################################
################################################################
puts stderr "\n"
puts stderr "--"
puts -nonewline stderr " angela! [angela:msg VERSION]"
foreach i [array names tcl_platform] {
puts -nonewline stderr " $tcl_platform($i)"
}
puts stderr ""
puts stderr " Copyright ⌐ 1997-98 by Oliver Pabst &"
puts stderr " Max Planck Institute for Computer Science."
puts stderr " angela! comes with ABSOLUTELY NO WARRANTY; for details see the"
puts stderr " provided LICENSE file."
puts stderr "--"
puts stderr "\n"
# The directory from which angela is called.
set angela_root [file dirname $argv0]
# Process command line
set lastused 0
for { set i 0 } { $i < $argc } { incr i } {
switch -exact -- [lindex $argv $i] {
--debug
{
set lastused [expr $i+1]
set angela_debug 1
}
--help
{
puts stderr "Help:"
puts stderr ""
puts stderr "$argv0 \[options\] \[file\]"
puts stderr ""
puts stderr " where"
puts stderr ""
puts stderr "\[options\] is optional and in the following list:"
puts stderr " --debug Activate debug mode."
puts stderr " --help Shows this help message."
puts stderr ""
puts stderr " -display display Display (and screen) on which to display window."
puts stderr ""
puts stderr " and"
puts stderr ""
puts stderr "\[file\] is a optional file to load after startup."
puts stderr ""
puts stderr "Enjoy angela!"
puts stderr ""
exit
}
}
}
# Default filename
set angela_filename "Untitled"
angela:conf:setup
angela:ws:init
angela:mod:init
angela:logo
angela:capabilities:scan node object node
angela:capabilities:scan edge object edge
angela:capabilities:scan shape object shape
angela:capabilities:scan text object text
angela:capabilities:scan line object line
#angela:realtime:start
debug "Initialization done."
# Check if there are some unused arguments, and try to load them
if { $lastused < $argc && $argc > 0 } {
angela:load [lindex $argv [expr $argc-1]]
}