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 >
Text File  |  1998-05-05  |  91KB  |  3,212 lines
  1. #!/bin/sh
  2. # This line is to tell emacs to load tcl mode: -*- Mode: Tcl -*-
  3.  
  4. # If this file doesn't execute properly, check if the
  5. # tixwish4.1.8.0 binary is on the current path. If not,
  6. # make the required changes.
  7.  
  8. # The next line will be executed using the shell 
  9. # and ignored by Tcl because of the trailing backslash \
  10. exec tixwish4.1.8.0 -f "$0" ${1+"$@"}
  11.  
  12. # Please read file LICENSE for licensing informations.
  13. # If this file was not included with your distribution, please
  14. # email pabst@mpi-sb.mpg.de to receive one copy.
  15.  
  16. # To report bug reports or other comments, please use the
  17. # bug report generator in the file menu. This will include some
  18. # precious informations about the Tcl/Tk context you are 
  19. # using. The generated text file can be send with any mail
  20. # editor.
  21.  
  22. ################################################################
  23. ################################################################
  24. ################################################################
  25. ##
  26. ## Constants and Variable set
  27. ##
  28. ################################################################
  29. ################################################################
  30. ################################################################
  31.  
  32. set angela_selected_nodes ""
  33. set angela_state NORMAL
  34. set angela_dragflag 0
  35. set angela_lasthighlight ""
  36. set angela_nodes ""
  37. set angela_edges ""
  38. set angela_debug 0
  39. set angela_version ""
  40.  
  41. ################################################################
  42. ################################################################
  43. ################################################################
  44. ##
  45. ## Procedures 
  46. ##
  47. ################################################################
  48. ################################################################
  49. ################################################################
  50.  
  51. ################################################################
  52. #
  53. # Module Management
  54. #
  55. ################################################################
  56.  
  57. proc angela:mod:manager:browse { tree path action args } {
  58.  
  59.     set module [lindex $action 1]
  60.  
  61.     if { $module == "" } {
  62.     set ok 0
  63.     } else {
  64.     set ok 1 
  65.     }
  66.  
  67.     foreach { widget command } \
  68.     { \
  69.           algname algorithm_name \
  70.           alglongname algorithm_longname \
  71.           algauthor algorithm_author \
  72.           algversion algorithm_version \
  73.           implname implementation_name \
  74.           impllongname implementation_longname \
  75.           implauthor implementation_author \
  76.           implversion implementation_version \
  77.           type type \
  78.           subtype subtype \
  79.       } {
  80.           [ $path.top.b.$widget subwidget entry] \
  81.           delete 0 end
  82.           if { $ok } {
  83.           [ $path.top.b.$widget subwidget entry] \
  84.               insert end \
  85.               [angela:mod:info:$command $module]
  86.           }
  87.       }
  88. } 
  89.  
  90. proc angela:mod:manager:run { tree path action args } {
  91.  
  92.     angela:mod:manager:browse $tree $path $action $args
  93.  
  94. }
  95.  
  96. proc angela:mod:manager { w } {
  97. global angela_mod_list
  98.     
  99.     catch { destroy $w }
  100.     toplevel $w
  101.     wm title $w "angela!:Module Browser"
  102.  
  103.     angela:prefs:window $w ModuleBrowser
  104.  
  105.     frame $w.top -relief raised -bd 1
  106.  
  107.     # Create a TixTree widget to display the module hierarchy
  108.     # 
  109.     #
  110.     tixTree $w.top.a -options {
  111.     separator "/"
  112.     hlist.selectMode single
  113.     }
  114.  
  115.     $w.top.a config \
  116.      -browsecmd "angela:mod:manager:browse $w.top.a $w" \
  117.      -command   "angela:mod:manager:run $w.top.a $w"
  118.  
  119.     frame $w.top.b
  120.  
  121.     pack $w.top.a $w.top.b -expand yes -fill both -padx 10 \
  122.     -pady 10 -side left
  123.  
  124.     foreach { name string } \
  125.     { \
  126.       algname "Algorithm name" \
  127.       alglongname "Algorithm long name" \
  128.       algauthor "Algorithm author" \
  129.       algversion "Algorithm version" \
  130.       implname "Implementation name" \
  131.       impllongname "Implementation long name" \
  132.       implauthor "Implementation author" \
  133.       implversion "Implementation version" \
  134.       type "Module type" \
  135.       subtype "Module subtype"
  136.     } {
  137.     
  138.     tixLabelEntry $w.top.b.$name -label $string: \
  139.         -options {
  140.         -anchor e
  141.         label.width 26
  142.         entry.width 30
  143.         }
  144.     
  145.     pack $w.top.b.$name -fill x -expand yes
  146.     }
  147.     
  148.     set tree $w.top.a 
  149.     set hlist [$w.top.a subwidget hlist]
  150.  
  151.     # STEP (1) Add the entries
  152.  
  153.     $hlist add object -itemtype imagetext \
  154.          -text object -image [tix getimage folder]
  155.  
  156.     $hlist add filter_out -itemtype imagetext \
  157.          -text filter_out -image [tix getimage folder]
  158.  
  159.     $hlist add filter_in -itemtype imagetext \
  160.          -text filter_in -image [tix getimage folder]
  161.  
  162.     $hlist add filter_exec -itemtype imagetext \
  163.          -text filter_exec -image [tix getimage folder]
  164.  
  165.     $hlist add AGD -itemtype imagetext \
  166.     -text AGD -image [tix getimage folder]
  167.  
  168.     $hlist add LEDA -itemtype imagetext \
  169.     -text LEDA -image [tix getimage folder]
  170.  
  171.     foreach i $angela_mod_list {
  172.  
  173.     set name [angela:mod:info:algorithm_name $i]
  174.     set type \
  175.         "[angela:mod:info:type $i]/[angela:mod:info:subtype $i] $i"
  176.  
  177.     $hlist add $type -itemtype imagetext \
  178.         -text $name -image [tix getimage folder]
  179.  
  180.     }
  181.  
  182.     # STEP (2) Use the "autosetmode" method of TixTree to indicate 
  183.     #           which entries can be opened or closed. The
  184.     #           "autosetmode" command will call the "setmode" method
  185.     #           to set the mode of each entry to the following:
  186.     #
  187.     #        "open" : the entry has some children and the children are
  188.     #             currently visible
  189.     #        "close": the entry has some children and the children are
  190.     #             currently INvisible
  191.     #        "none": the entry does not have children.
  192.     #
  193.     #    If you don't like the "autosetmode" method, you can always call
  194.     #    "setmode" yourself, but that takes more work.
  195.     
  196.     $tree autosetmode
  197.  
  198.     # Use a ButtonBox to hold the buttons.
  199.     #
  200.     tixButtonBox $w.box -orientation horizontal
  201.     $w.box add ok     -text Done   -underline 0 \
  202.     -command "angela:prefs:window:save $w ModuleBrowser" \
  203.     -width 6
  204.     $w.box add load -text "Load..." -underline 0 \
  205.     -command "angela:prefs:window:save $w ModuleBrowser" \
  206.     -width 6 -state disabled
  207.     $w.box add unload -text "Unload..." -underline 0 \
  208.     -command "angela:prefs:window:save $w ModuleBrowser" \
  209.          -width 6 -state disabled
  210.  
  211.     pack $w.box -side bottom -fill x
  212.     pack $w.top -side top -fill both -expand yes
  213.  
  214. }
  215.  
  216. proc angela:mod:info:algorithm_name { module } {
  217.     return [angela:mod:info $module 0]
  218. }
  219.  
  220. proc angela:mod:info:algorithm_longname { module } {
  221.     return [angela:mod:info $module 1]
  222. }
  223.  
  224. proc angela:mod:info:algorithm_author { module } {
  225.     return [angela:mod:info $module 2]
  226. }
  227.  
  228. proc angela:mod:info:algorithm_version { module } {
  229.     return [angela:mod:info $module 3]
  230. }
  231.  
  232. proc angela:mod:info:implementation_name { module } {
  233.     return [angela:mod:info $module 4]
  234. }
  235.  
  236. proc angela:mod:info:implementation_longname { module } {
  237.     return [angela:mod:info $module 5]
  238. }
  239.  
  240. proc angela:mod:info:implementation_author { module } {
  241.     return [angela:mod:info $module 6]
  242. }
  243.  
  244. proc angela:mod:info:implementation_version { module } {
  245.     return [angela:mod:info $module 7]
  246. }
  247.  
  248. proc angela:mod:info:type { module } {
  249.     return [angela:mod:info $module 8]
  250. }
  251.  
  252. proc angela:mod:info:subtype { module } {
  253.     return [angela:mod:info $module 9]
  254. }
  255.  
  256. proc angela:mod:info { module id } {
  257.     set command [ format "%s long_info" $module ]
  258.     return [string trim [ lindex [ eval $command ] $id ] ]
  259. }
  260.  
  261. proc angela:mod:scan { modules tag value } {
  262.     set result ""
  263.     foreach i $modules {
  264.     if { [angela:mod:info:$tag $i] == $value } {
  265.         lappend result $i
  266.     }
  267.     }
  268.     return $result
  269. }
  270.  
  271. proc angela:mod:scan:type { type subtype } {
  272. global angela_mod_list
  273.     set fromtype [angela:mod:scan $angela_mod_list type $type]
  274.     return [angela:mod:scan $fromtype subtype $subtype]
  275. }
  276.  
  277. proc angela:mod:register { name } {
  278. global angela_mod_list
  279.     
  280.     lappend angela_mod_list $name
  281.  
  282. }
  283.  
  284. proc angela:mod:load:dll { name module } {
  285. global angela_root
  286.  
  287.     debug "Load DLL $name=$module"
  288.  
  289.     if { ![file exists $angela_root/$module] } {
  290.     fatal \
  291.         "Cannot load $angela_root/$module as DLL. Check configuration."
  292.     }
  293.  
  294.     load $angela_root/$module
  295.  
  296.     angela:mod:register $name
  297.  
  298. }
  299.  
  300. proc angela:mod:load:tcl { name module } {
  301. global angela_root 
  302.  
  303.     debug "Load TCL $name=$module"
  304.  
  305.     if { ![file exists $angela_root/$module] } {
  306.     fatal \
  307.         "Cannot load $angela_root/$module as TCL. Check configuration."
  308.     }
  309.  
  310.     source $angela_root/$module
  311.  
  312.     angela:mod:register $name
  313.     $name init
  314. }
  315.  
  316. proc angela:mod:load { name module type } {
  317.     switch $type {
  318.     dll
  319.     {
  320.         angela:mod:load:dll $name $module
  321.     }
  322.     tcl
  323.     {
  324.         angela:mod:load:tcl $name $module
  325.     }
  326.     }
  327. }
  328.  
  329. proc angela:mod:init { } {
  330. global angela_mod_list angela_option
  331.     debug "Initializing module engine..."
  332.     set angela_mod_list ""
  333.     foreach {name module type} $angela_option(modules:startup) {
  334.         angela:mod:load $name $module $type
  335.     }
  336. }
  337.  
  338. ################################################################
  339. #
  340. # Preferences Management
  341. #
  342. ################################################################
  343.  
  344. proc angela:prefs:write { key value } {
  345. global angela_prefs
  346.  
  347.     if { [file exists $angela_prefs] == 0 } {
  348.         
  349.         set handle [open $angela_prefs "w"]
  350.         puts $handle "$key=$value"
  351.         close $handle
  352.         return
  353.     }
  354.  
  355.     set handle [open $angela_prefs "r"]
  356.     set handle2 [open "$angela_prefs.tmp" "w"]
  357.     set updated 0
  358.  
  359.     while { ! [eof $handle] } {
  360.  
  361.         set line [gets $handle]
  362.         set newline [ split $line = ]
  363.         if { $line!="" } {
  364.             if { [lindex $newline 0] == $key } {
  365.                 puts $handle2 "$key=$value"
  366.                 set updated 1
  367.             } else {
  368.                 puts $handle2 $line
  369.             }
  370.         }
  371.     }
  372.  
  373.     close $handle
  374.  
  375.     if { ! $updated } {
  376.         
  377.         puts $handle2 "$key=$value"
  378.         
  379.     }
  380.  
  381.     close $handle2
  382.  
  383.     file delete $angela_prefs
  384.     file rename "$angela_prefs.tmp" $angela_prefs
  385.  
  386. }
  387.  
  388. proc angela:prefs:read { key } {
  389. global angela_prefs
  390.  
  391.     if { [file exists $angela_prefs] == 0 } {
  392.         return ""
  393.     }
  394.  
  395.     set handle [open $angela_prefs "r"]
  396.  
  397.     while { ! [eof $handle] } {
  398.  
  399.         set line [ gets $handle ]
  400.         set line [ split $line = ]
  401.         
  402.         if { [lindex $line 0 ] == $key } {
  403.             close $handle
  404.             return [lindex $line 1]
  405.         }
  406.     }
  407.  
  408.     close $handle
  409.  
  410.     return ""
  411. }
  412.  
  413. proc angela:prefs:window { path windowname } {
  414.  
  415.     # Read preference, if exist
  416.     set placement [angela:prefs:read $windowname]
  417.  
  418.     if { $placement != "" } {
  419.     wm geometry $path $placement
  420.     wm protocol $path WM_DELETE_WINDOW \
  421.         "angela:prefs:window:save $path $windowname"
  422.     }
  423.  
  424. }
  425.  
  426. proc angela:prefs:window:save { path windowname } {
  427.  
  428.     set placement [wm geometry $path]
  429.     angela:prefs:write $windowname $placement
  430.     destroy $path
  431.  
  432. }
  433.  
  434. ################################################################
  435. #
  436. # Configuration Management
  437. #
  438. ################################################################
  439.  
  440. proc angela:conf:write { } {
  441. global \
  442.     angela_option \
  443.     angela_cap_value \
  444.     angela_root \
  445.     angela_prefs \
  446.     angela_user
  447.     
  448.     # Write into configuration file the current settings.
  449.  
  450.     set handle [open $angela_user w]
  451.  
  452.     puts $handle "# This configuration file is part of angela!"
  453.     puts $handle "# angela! is located in $angela_root"
  454.     puts $handle "# Please do not edit this file manually unless"
  455.     puts $handle "# you know what you are doing!"
  456.  
  457.     puts $handle ""
  458.  
  459.     foreach i [array names angela_option] {
  460.     puts $handle "set angela_option($i)\t\t\t\"$angela_option($i)\""
  461.     }
  462.  
  463.     foreach i [array names angela_cap_value] {
  464.     puts $handle "set angela_cap_value($i)\t\t\t\"$angela_cap_value($i)\""
  465.     }
  466.  
  467.     close $handle
  468. }
  469.  
  470. proc angela:conf:setup { } {
  471. global \
  472.     angela_option \
  473.     angela_cap_value \
  474.     angela_root \
  475.     angela_prefs \
  476.     angela_user
  477.  
  478.     set system \
  479.     [format "%s/angela.rc" $angela_root]
  480.  
  481.     set user "~/angela.rc"
  482.     set angela_user $user
  483.  
  484.     set forced \
  485.     [format "%s/angela.forced.rc" $angela_root]
  486.  
  487.     set angela_prefs "~/.angela.runtime"
  488.  
  489.     if { [file exists $system] } {
  490.     debug "Loading system configuration in $system"
  491.     source $system
  492.     }
  493.  
  494.     if { [file exists $user] } {
  495.     debug "Loading user configuration in $user"
  496.     source $user
  497.     }
  498.  
  499.     if { [file exists $forced] } {
  500.     debug "Loading forced configuration in $forced"
  501.     source $forced
  502.     }
  503.  
  504. }
  505.  
  506. ################################################################
  507. #
  508. # Realtime Management
  509. #
  510. ################################################################
  511.  
  512. proc angela:realtime:start { } {
  513.     after idle angela:realtime:idle
  514. }
  515.  
  516. proc angela:realtime:idle { } {
  517.     angela:realtime:task
  518.     after 50 angela:realtime:idle
  519. }
  520.  
  521. proc angela:realtime:task { } {
  522. global angela_edges angela_canvas
  523.  
  524.     foreach e $angela_edges {
  525.     $e spring_visc
  526.     }
  527.  
  528.     foreach e $angela_edges {
  529.     $e spring_calculate 0.5
  530.     }
  531.  
  532.     foreach e $angela_edges {
  533.     set n1 [$e export -node1]
  534.     set n2 [$e export -node2]
  535.     $n1 spring_update $angela_canvas 0.5
  536.     $n2 spring_update $angela_canvas 0.5
  537.     $e update $angela_canvas
  538.     }
  539. }
  540.  
  541. ################################################################
  542. #
  543. # Printing
  544. #
  545. ################################################################
  546.  
  547. proc angela:print { path } {
  548. global angela_option
  549.  
  550.     set w .print
  551.     catch { destroy $w }
  552.     toplevel $w
  553.     wm title $w "angela!:Print"
  554.  
  555.     angela:prefs:window $w Print
  556.  
  557.     # Create the notebook widget and set its backpagecolor to gray.
  558.     # Note that the -backpagecolor option belongs to the "nbframe"
  559.     # subwidget.
  560.     tixNoteBook $w.nb -ipadx 6 -ipady 6
  561.     $w config -bg gray
  562.     $w.nb subwidget nbframe config -backpagecolor gray
  563.  
  564.     # Create the two tabs on the notebook. The -underline option
  565.     # puts a underline on the first character of the labels of the tabs.
  566.     # Keyboard accelerators will be defined automatically according
  567.     # to the underlined character.    
  568.     #
  569.     $w.nb add area -label "Area" -underline 0
  570.     pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
  571.     
  572.     #----------------------------------------
  573.     # Create the area page
  574.     #----------------------------------------
  575.     set f [$w.nb subwidget area]
  576.  
  577.     # Create two frames: one for the common buttons, one for the
  578.     # other widgets
  579.     #
  580.     frame $f.f
  581.     frame $f.common
  582.     pack $f.f      -side left  -padx 2 -pady 2 -fill both -expand yes
  583.     pack $f.common -side right -padx 2 -pady 2 -fill y
  584.  
  585.     # Create the controls that only belong to this page
  586.     #
  587.  
  588.     frame $f.f.left
  589.     frame $f.f.right
  590.     pack $f.f.left $f.f.right -side left -fill both -expand yes
  591.  
  592.     canvas $f.f.left.c -width 155 -height 155 -background gray \
  593.     -borderwidth 0 -relief sunken
  594.  
  595.     button $f.f.left.update -text "Refresh preview" \
  596.     -command "angela:print:refresh $f.f.left.c $path" \
  597.         -pady 5
  598.  
  599.     pack $f.f.left.c $f.f.left.update -side top
  600.  
  601.     tixLabelEntry $f.f.right.paperheight -label "Paper height:" \
  602.     -options {
  603.     entry.width 10
  604.     label.width 15
  605.     label.anchor e
  606.     entry.textVariable angela_option(print:paper:height)
  607.     }
  608.  
  609.     tixLabelEntry $f.f.right.paperwidth -label "Paper width:" \
  610.     -options {
  611.     entry.width 10
  612.     label.width 15
  613.     label.anchor e
  614.     entry.textVariable angela_option(print:paper:width)
  615.     }
  616.  
  617.     tixLabelEntry $f.f.right.paperleft -label "Left margin:" \
  618.     -options {
  619.     entry.width 10
  620.     label.width 15
  621.     label.anchor e
  622.     entry.textVariable angela_option(print:paper:left)
  623.     }
  624.  
  625.     tixLabelEntry $f.f.right.paperright -label "Right margin:" \
  626.     -options {
  627.     entry.width 10
  628.     label.width 15
  629.     label.anchor e
  630.     entry.textVariable angela_option(print:paper:right)
  631.     }
  632.  
  633.     tixLabelEntry $f.f.right.papertop -label "Top margin:" \
  634.     -options {
  635.     entry.width 10
  636.     label.width 15
  637.     label.anchor e
  638.     entry.textVariable angela_option(print:paper:top)
  639.     }
  640.  
  641.     tixLabelEntry $f.f.right.paperbottom -label "Paper bottom:" \
  642.     -options {
  643.     entry.width 10
  644.     label.width 15
  645.     label.anchor e
  646.     entry.textVariable angela_option(print:paper:bottom)
  647.     }
  648.  
  649.     frame $f.f.right.rotate
  650.  
  651.     radiobutton $f.f.right.rotate.portrait -text "Portrait" \
  652.     -variable angela_paperportrait -value 1
  653.     
  654.     radiobutton $f.f.right.rotate.landscape -text "Landscape" \
  655.     -variable angela_paperportrait -value 0
  656.  
  657.     pack $f.f.right.rotate.portrait $f.f.right.rotate.landscape \
  658.     -side left -fill both -expand yes
  659.  
  660.     pack $f.f.right.paperheight $f.f.right.paperwidth \
  661.     $f.f.right.paperleft $f.f.right.paperright \
  662.     $f.f.right.papertop $f.f.right.paperbottom \
  663.     $f.f.right.rotate \
  664.     -side top -fill x -expand yes
  665.  
  666.     # Create the common buttons
  667.     #
  668.     angela:print:CreateCommonButtons $w $f.common $f.f.left.c $path
  669.  
  670.     angela:print:refresh $f.f.left.c $path
  671.     
  672. }
  673.  
  674. proc angela:print:CreateCommonButtons {w f canvas path} {
  675.  
  676.     button $f.printfile -text "Print to file..."  -width 10 \
  677.     -command "angela:prefs:window:save $w Print"
  678.     button $f.print -text "Print"  -width 10 \
  679.     -command "angela:prefs:window:save $w Print"
  680.     button $f.cancel -text Cancel -width 10 \
  681.     -command "angela:prefs:window:save $w Print"
  682.  
  683.     pack $f.printfile $f.print $f.cancel -side top -padx 2 -pady 2
  684. }
  685.  
  686. proc angela:print:refresh { canvas realcanvas} {
  687. global angela_option
  688.     
  689.     angela:msg GRAPH:CLEANUP
  690.  
  691.     set previewwidth 150.0
  692.     set previewheight 150.0
  693.     set previewx 2
  694.     set previewy 2
  695.  
  696.     set posterx 1
  697.     set postery 1
  698.     set paperwp 100
  699.     set paperhp 100
  700.  
  701.     set paperwidth  [winfo fpixels . $angela_option(print:paper:width)]
  702.     set paperheight [winfo fpixels . $angela_option(print:paper:height)]
  703.     set paperleft   [winfo fpixels . $angela_option(print:paper:left)]
  704.     set paperright  [winfo fpixels . $angela_option(print:paper:right)]
  705.     set papertop    [winfo fpixels . $angela_option(print:paper:top)]
  706.     set paperbottom [winfo fpixels . $angela_option(print:paper:bottom)]
  707.  
  708.     set printmaxwidth  [expr $paperwidth-$paperleft-$paperright]
  709.     set printmaxheight [expr $paperheight-$papertop-$paperbottom]
  710.  
  711.     set bbox [$realcanvas bbox all]
  712.     set realx [lindex $bbox 0]
  713.     set realy [lindex $bbox 1]
  714.     set realwidth  [expr [lindex $bbox 2]-$realx]
  715.     set realheight [expr [lindex $bbox 3]-$realy]
  716.  
  717.     set realprintscalex [expr 1/(($realwidth/$posterx)/$printmaxwidth)]
  718.     set realprintscaley [expr 1/(($realheight/$postery)/$printmaxheight)]
  719.  
  720.     # Set the scales to the minimum value
  721.     
  722.     if { $realprintscalex < $realprintscaley } {
  723.     set realprintscaley $realprintscalex
  724.     } else {
  725.     set realprintscalex $realprintscaley
  726.     }
  727.  
  728.     set realprintscalex [expr $realprintscalex*$paperwp/100]
  729.     set realprintscaley [expr $realprintscaley*$paperhp/100]
  730.  
  731.     set printwidth  [expr ($realwidth/$posterx)*$realprintscalex]
  732.     set printheight [expr ($realheight/$postery)*$realprintscaley]
  733.  
  734.     set pagecenterx [expr $printmaxwidth/2+$paperleft]
  735.     set pagecentery [expr $printmaxheight/2+$papertop]
  736.  
  737.     set printx [expr $pagecenterx-($printwidth/2)]
  738.     set printy [expr $pagecentery-($printheight/2)]
  739.  
  740.     # Compute values for preview display
  741.     set paperpreviewscalex [expr 1/($paperwidth/$previewwidth)]
  742.     set paperpreviewscaley [expr 1/($paperheight/$previewheight)]
  743.  
  744.     if { $paperpreviewscalex > $paperpreviewscaley } {
  745.     set paperpreviewscalex $paperpreviewscaley
  746.     } else {
  747.     set paperpreviewscaley $paperpreviewscalex
  748.     }
  749.  
  750.     set previewpaperwidth [expr $paperwidth*$paperpreviewscalex]
  751.     set previewpaperheight [expr $paperheight*$paperpreviewscaley]
  752.  
  753.     set previeworiginx [expr $previewwidth/2-($paperwidth/2*$paperpreviewscalex)+2]
  754.     set previeworiginy [expr $previewheight/2-($paperheight/2*$paperpreviewscaley)+2]
  755.  
  756.     set previewtop    [expr $papertop*$paperpreviewscaley]
  757.     set previewbottom [expr $paperbottom*$paperpreviewscaley]
  758.     set previewleft   [expr $paperleft*$paperpreviewscalex]
  759.     set previewright  [expr $paperright*$paperpreviewscalex]
  760.     
  761.     set previewprintx [expr $printx*$paperpreviewscalex]
  762.     set previewprinty [expr $printy*$paperpreviewscaley]
  763.  
  764.     set previewprintheight [expr $printheight*$paperpreviewscaley]
  765.     set previewprintwidth  [expr $printwidth*$paperpreviewscalex]
  766.  
  767.     foreach i { \
  768.             previeworiginx previeworiginy \
  769.             paperpreviewscalex paperpreviewscaley \
  770.             previewpaperwidth previewpaperheight previewtop previewbottom \
  771.             previewleft previewright previewprintx previewprinty \
  772.             previewprintheight previewprintwidth \
  773.             realx realy realheight realwidth paperheight paperwidth \
  774.             papertop paperbottom paperleft paperright paperwp paperhp \
  775.             posterx postery printx printy printwidth printheight \
  776.             realprintscalex realprintscaley pagecenterx pagecentery } {
  777.     debug "$i=[set $i]"
  778.     }
  779.  
  780.     # Delete old objects
  781.     $canvas delete all
  782.     
  783.     # Draw sheet
  784.     $canvas create rectangle $previeworiginx $previeworiginy \
  785.     [expr $previeworiginx+$previewpaperwidth] \
  786.     [expr $previeworiginy+$previewpaperheight] \
  787.     -fill white -outline black -width 1 -tags sheet
  788.  
  789.     # Draw margins
  790.     $canvas create line \
  791.     [expr $previeworiginx+$previewleft] \
  792.     $previeworiginy \
  793.     [expr $previeworiginx+$previewleft] \
  794.     [expr $previeworiginy+$previewpaperheight] \
  795.     -fill gray -width 1 -tags marginleft
  796.  
  797.     $canvas create line \
  798.     [expr $previeworiginx+$previewpaperwidth-$previewright] \
  799.     $previeworiginy \
  800.     [expr $previeworiginx+$previewpaperwidth-$previewright] \
  801.     [expr $previeworiginy+$previewpaperheight] \
  802.     -fill gray -width 1 -tags marginright
  803.  
  804.     $canvas create line \
  805.     $previeworiginx \
  806.     [expr $previeworiginy+$previewtop] \
  807.     [expr $previeworiginx+$previewpaperwidth] \
  808.     [expr $previeworiginy+$previewtop] \
  809.     -fill gray -width 1 -tags margintop
  810.  
  811.     $canvas create line \
  812.     $previeworiginx \
  813.     [expr $previeworiginy+$previewpaperheight-$previewbottom] \
  814.     [expr $previeworiginx+$previewpaperwidth] \
  815.     [expr $previeworiginy+$previewpaperheight-$previewbottom] \
  816.     -fill gray -width 1 -tags marginbottom
  817.  
  818.     # Draw to-print area
  819.     $canvas create rectangle \
  820.     [expr $previeworiginx+$previewprintx] \
  821.     [expr $previeworiginy+$previewprinty] \
  822.     [expr $previeworiginx+$previewprintx+$previewprintwidth] \
  823.     [expr $previeworiginy+$previewprinty+$previewprintheight] \
  824.     -fill steelblue -outline black -width 1 -tags area
  825.  
  826.     $realcanvas postscript -file print.ps\
  827.     -width  $realwidth\
  828.     -height $realheight\
  829.     -x $realx\
  830.     -y $realy\
  831.     -pageanchor sw \
  832.     -pagewidth [expr $paperwidth-$printx]\
  833.     -pageheight [expr $paperheight-$printy]\
  834.     -pagex $printx\
  835.     -pagey [expr $realheight-$printy]
  836.  
  837. }
  838.  
  839. ################################################################
  840. #
  841. # Capabilities Management
  842. #
  843. ################################################################
  844.  
  845. proc angela:capabilities:scan { what type subtype } {
  846. global angela_cap angela_cap_value \
  847.     angela_allcap angela_allcap_value
  848.  
  849.     set module [angela:mod:scan:type $type $subtype]
  850.  
  851.     if { $module == "" } {
  852.     debug "No module for $type/$subtype found!"
  853.     return
  854.     }
  855.  
  856.     if { [llength $module] > 1 } {
  857.     debug "More than one module for $type/$subtype"
  858.     set module [lindex $module 0]
  859.     }
  860.  
  861.     set cap [$module attributes]
  862.     set angela_cap($what) $cap
  863.     foreach i $cap {
  864.     if { [lsearch [array names angela_cap_value] $what:$i] == -1 } {
  865.         set angela_cap_value($what:$i) "0"
  866.     }
  867.     }
  868.  
  869.     set allcap [$module all_attributes]
  870.     set angela_allcap($what) $allcap
  871.     foreach i $allcap {
  872.     if { [lsearch [array names angela_allcap_value] $what:$i] == -1 } {
  873.         set angela_allcap_value($what:$i) "0"
  874.     }
  875.     }
  876. }
  877.  
  878. proc angela:capabilities:get:all { command classes destcap destcap_value } {
  879.     global $destcap $destcap_value angela_allcap angela_allcap_value
  880.  
  881.     catch { unset $destcap }
  882.     catch { unset $destcap_value }
  883.  
  884.     foreach { class cmd } $classes {
  885.     foreach i $angela_allcap($class) {
  886.         set value [$cmd export -$i]
  887.         if { $value == "" } { set value "{}" }
  888.         eval [format "set %s(%s:%s) $value" \
  889.               $destcap_value $class $i]
  890.         eval [format "lappend %s(%s) $i" \
  891.               $destcap $class $i]
  892.     }
  893.     }
  894. }
  895.  
  896. proc angela:capabilities:get:user { command classes destcap destcap_value } {
  897.     global $destcap $destcap_value angela_cap angela_cap_value
  898.  
  899.     catch { unset $destcap }
  900.     catch { unset $destcap_value }
  901.  
  902.     foreach { class cmd } $classes {
  903.     foreach i $angela_cap($class) {
  904.         set value [$cmd export -$i]
  905.         if { $value == "" } { set value "{}" }
  906.         eval [format "set %s(%s:%s) $value" \
  907.               $destcap_value $class $i]
  908.         eval [format "lappend %s(%s) $i" \
  909.               $destcap $class $i]
  910.     }
  911.     }
  912. }
  913.  
  914. proc angela:capabilities:synonym { value } {
  915. global angela_option
  916.  
  917.     set retval $value
  918.     if { [lsearch [array names angela_option] synonym:$value] != -1 } {
  919.     set retval $angela_option(synonym:$value)
  920.     }
  921.     return $retval
  922.     
  923. }
  924.  
  925. proc angela:capabilities:manager { classes cap cap_value { command "" } } {
  926. #global angela_cap angela_cap_value \
  927. #    angela_capfont
  928. global angela_option $cap $cap_value
  929.  
  930.     array set newcap [array get $cap]
  931.     array set newcap_value [array get $cap_value]
  932.  
  933.     set w .cap
  934.     
  935.     catch { destroy $w }
  936.     toplevel $w
  937.     wm title $w "Capabilities"
  938.  
  939.     angela:prefs:window $w Capabilities
  940.  
  941.     # Create the notebook widget and set its backpagecolor to gray.
  942.     # Note that the -backpagecolor option belongs to the "nbframe"
  943.     # subwidget.
  944.     tixNoteBook $w.nb -ipadx 6 -ipady 6
  945.     $w config 
  946.     $w.nb subwidget nbframe config 
  947.  
  948.     # Create the two tabs on the notebook. The -underline option
  949.     # puts a underline on the first character of the labels of the tabs.
  950.     # Keyboard accelerators will be defined automatically according
  951.     # to the underlined character.    
  952.     #
  953.     
  954.     foreach class $classes {
  955.     $w.nb add $class -label $class
  956.     }
  957.     pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
  958.     
  959.     foreach class $classes {
  960.  
  961.     set f [$w.nb subwidget $class]
  962.  
  963.     # Create two frames: one for the common buttons, one for the
  964.     # other widgets
  965.     #
  966.     frame $f.f
  967.     frame $f.common
  968.     pack $f.f      -side top  -padx 2 -pady 2 -fill both -expand yes
  969.     pack $f.common -side bottom -padx 2 -pady 2 -fill x
  970.     
  971.     # Create the controls that only belong to this page
  972.     #
  973.     foreach i $newcap($class) {
  974.         frame $f.f.$i
  975.         pack $f.f.$i -fill both -expand yes
  976.         label $f.f.$i.l -text [angela:capabilities:synonym $class:$i]: \
  977.         -font $angela_option(gui:font:cap) \
  978.         -width 15 -anchor e
  979.  
  980.         button $f.f.$i.b -text $newcap_value($class:$i) \
  981.         -command "angela:capabilities:manager:edit $f.f.$i.b\
  982.                           $class $i $cap $cap_value \"$command\"" \
  983.         -font $angela_option(gui:font:cap) -borderwidth 1 \
  984.         -background white
  985.  
  986.         pack $f.f.$i.l $f.f.$i.b -side left -fill x
  987.     }
  988.     }
  989.  
  990. frame $w.common -background gray -border 4
  991.  
  992. set majorclass ""
  993. set first 1
  994. foreach class $classes {
  995.     if { ! $first } {
  996.     set majorclass "$majorclass:$class"
  997.     } else {
  998.     set majorclass $class
  999.     set first 0
  1000.     }
  1001. }
  1002.  
  1003. tixComboBox $w.common.select -label "Style:" -dropdown true \
  1004.     -editable true -fancy true \
  1005.     -command "angela:capabilities:manager:style:do $majorclass \
  1006.               $cap $cap_value \"$command\" $w.nb" \
  1007.     -options {
  1008.     listbox.height 10
  1009.     label.with 5
  1010.     label.anchor e
  1011.     entry.width 30
  1012.     }
  1013.  
  1014. # Parse and register the styles
  1015.  
  1016. if { [lsearch [array names angela_option] style:$majorclass] != -1 } {
  1017.     foreach style $angela_option(style:$majorclass) {
  1018.     $w.common.select insert end [lindex $style 0]
  1019.     }
  1020. }
  1021.  
  1022. pack $w.common.select -fill both -expand yes
  1023. button $w.common.close -text Close -width 6 \
  1024.     -command "angela:prefs:window:save $w Capabilities" \
  1025.     -font $angela_option(gui:font:cap)
  1026.  
  1027. pack $w.common.close -side bottom -fill both
  1028. pack $w.common -fill x -expand yes
  1029. }
  1030.  
  1031. proc angela:capabilities:manager:update { majorclass path cap cap_value } {
  1032. global $cap $cap_value
  1033.  
  1034.     array set newcap [array get $cap]
  1035.     array set newcap_value [array get $cap_value]
  1036.  
  1037.     set classes [split $majorclass :]
  1038.  
  1039.     foreach class $classes {
  1040.     set f [$path subwidget $class]
  1041.     foreach i $newcap($class) {
  1042.         $f.f.$i.b configure -text $newcap_value($class:$i)
  1043.     }
  1044.     }
  1045. }
  1046.  
  1047. proc angela:capabilities:manager:style:do \
  1048.     { majorclass cap cap_value command path arg } {
  1049. global $cap $cap_value angela_option
  1050.  
  1051.     array set newcap_value [array get $cap_value]
  1052.  
  1053.     set found 0
  1054.     foreach style $angela_option(style:$majorclass) {
  1055.     if { [lindex $style 0] == $arg } {
  1056.         set found 1
  1057.         break
  1058.     }
  1059.     }
  1060.     
  1061.     if { $found } {
  1062.     set style [lrange $style 1 end]
  1063.     foreach { attribute value } $style {
  1064.         angela:capabilities:manager:edit:newval \
  1065.         $cap_value $attribute $command $value
  1066.     }
  1067.     angela:capabilities:manager:update \
  1068.         $majorclass $path $cap $cap_value
  1069.     }
  1070. }
  1071.  
  1072. proc angela:capabilities:manager:edit \
  1073.     {path class attribute cap cap_value { cmd "" } } {
  1074. global angela_cap_value angela_option $cap $cap_value
  1075.  
  1076.     array set newcap [array get $cap]
  1077.     array set newcap_value [array get $cap_value]
  1078.  
  1079.     catch { destroy .capedit }
  1080.     toplevel .capedit
  1081.     wm title .capedit "angela!:Edit attribute"
  1082.  
  1083.     set w .capedit
  1084.  
  1085.     angela:prefs:window $w CapabilitiesEdit
  1086.  
  1087.     frame $w.top -border 1 -relief raised
  1088.  
  1089.     # $w.top.a is a drop-down combo box. It is not editable -- who wants
  1090.     # to invent new months?
  1091.     #
  1092.     # [Hint] The -options switch sets the options of the subwidgets.
  1093.     # [Hint] We set the label.width subwidget option of both comboboxes to 
  1094.     #        be 10 so that their labels appear to be aligned.
  1095.     #
  1096.     # newcap_value($class:$attribute) \    
  1097.  
  1098.     tixComboBox $w.top.a \
  1099.         -label "[angela:capabilities:synonym $class:$attribute]= " \
  1100.     -dropdown true \
  1101.     -editable true \
  1102.         -command "angela:capabilities:manager:edit:newval \
  1103.                   $cap_value \
  1104.                   $class:$attribute \"$cmd\"" \
  1105.         -history 1 \
  1106.         -fancy 1 \
  1107.         -options {
  1108.         listbox.height 6
  1109.         label.width 20
  1110.         label.anchor e
  1111.     }
  1112.  
  1113.     $w.top.a subwidget entry insert end $newcap_value($class:$attribute)
  1114.     focus [$w.top.a subwidget entry]
  1115.  
  1116.     pack $w.top.a -side top -anchor e
  1117.  
  1118.     if { [lsearch [array names angela_option] choice:$class:$attribute] == -1 } {
  1119.     # Insert the choices into the combo boxes
  1120.     #
  1121.     $w.top.a insert end 1
  1122.     $w.top.a insert end 5
  1123.     $w.top.a insert end 10
  1124.     $w.top.a insert end 20
  1125.     $w.top.a insert end White
  1126.     $w.top.a insert end Black
  1127.     $w.top.a insert end Green
  1128.     $w.top.a insert end SteelBlue
  1129.     $w.top.a insert end { Arial 8 }
  1130.     $w.top.a insert end { Arial 20 }
  1131.     } else {
  1132.     foreach element $angela_option(choice:$class:$attribute) {
  1133.         $w.top.a insert end $element
  1134.     }
  1135.     }
  1136.     # Use a ButtonBox to hold the buttons.
  1137.     #
  1138.     tixButtonBox $w.box -orientation horizontal
  1139.     $w.box add ok     -text Done   -underline 0 \
  1140.     -command "angela:capabilities:manager:edit:okcmd $path $w $class $attribute $cap $cap_value" \
  1141.         -width 6
  1142. #    $w.box add cancel -text Cancel -underline 0 \
  1143. #    -command "angela:prefs:window:save $w CapabilitiesEdit" \
  1144. #    -width 6
  1145.  
  1146.     pack $w.box -side bottom -fill x
  1147.     pack $w.top -side top -fill both -expand yes
  1148. }
  1149.  
  1150. proc angela:capabilities:manager:edit:newval \
  1151.     { \
  1152.       cap_value attribute command value } \
  1153.     {
  1154.     global $cap_value
  1155.  
  1156.     #set value [$path subwidget entry get]
  1157.     eval set [format "%s(%s)" $cap_value $attribute] \"$value\"
  1158.     if { $command != "" } { eval $command }
  1159.     }
  1160.  
  1161. proc angela:capabilities:manager:edit:okcmd {path w class attribute cap cap_value} {
  1162. global angela_cap_value $cap $cap_value
  1163.     
  1164.     array set newcap [array get $cap]
  1165.     array set newcap_value [array get $cap_value]
  1166.  
  1167.     $path configure -text $newcap_value($class:$attribute)
  1168.     destroy $w
  1169. }
  1170.  
  1171. ################################################################
  1172. #
  1173. # Workspace Management
  1174. #
  1175. ################################################################
  1176.  
  1177. proc angela:ws:title:init { path } {
  1178. global angela_filename
  1179.  
  1180.     wm title $path "angela!([angela:msg VERSION]):Workspace:$angela_filename"
  1181.  
  1182. }
  1183.  
  1184. proc angela:ws:menubar:init { path } { 
  1185.  
  1186.     menubutton $path.file    -text "File"  -underline 0 \
  1187.     -menu $path.file.m -borderwidth 1
  1188.     menubutton $path.edit    -text "Edit"  -underline 0 \
  1189.     -menu $path.edit.m -borderwidth 1
  1190.     menubutton $path.tools   -text "Tools" -underline 0 \
  1191.     -menu $path.tools.m -borderwidth 1
  1192.     menubutton $path.help    -text "Help"  -underline 0 \
  1193.     -menu $path.help.m -state disabled -borderwidth 1
  1194.  
  1195.     pack $path.file  -side left
  1196.     pack $path.edit  -side left
  1197.     pack $path.tools -side left
  1198.  
  1199.     pack $path.help  -side right
  1200.  
  1201.     angela:ws:menubar:set $path
  1202.  
  1203. }
  1204.  
  1205. proc angela:ws:menubar:set { path } {
  1206.  
  1207.     menu $path.file.m -tearoff 0 -borderwidth 1
  1208.     $path.file.m add command -label "New Graph" \
  1209.     -underline 0 -command "angela:msg GRAPH:NEW"
  1210.     $path.file.m add command -label "Open Graph..." \
  1211.     -underline 0 -command "angela:msg GRAPH:OPEN"
  1212.     $path.file.m add command -label "Save Graph" \
  1213.     -underline 0 -command "angela:msg GRAPH:SAVE"
  1214.     $path.file.m add command -label "Save Graph As..." \
  1215.     -underline 0 -command "angela:msg GRAPH:SAVEAS"
  1216.     $path.file.m add separator
  1217.     $path.file.m add command -label "Print..." \
  1218.     -underline 0 -command "angela:msg GRAPH:PRINT"
  1219.     $path.file.m add separator
  1220.     $path.file.m add command -label "Properties..." \
  1221.     -underline 0 -command "angela:msg GRAPH:PROPERTIES"
  1222.     $path.file.m add command -label "Save configuration" \
  1223.     -underline 5 -command "angela:conf:write"
  1224.     $path.file.m add separator
  1225.     $path.file.m add command -label "Tcl command..." \
  1226.     -underline 0 -command "angela:tcl"
  1227.     $path.file.m add command -label "Bug Report..." \
  1228.     -underline 0 -command "angela:msg BUG"
  1229.     $path.file.m add separator
  1230.     $path.file.m add command -label "Quit" \
  1231.     -underline 0 -accelerator "Alt-F4" \
  1232.     -command "angela:msg QUIT"
  1233.  
  1234.     menu $path.edit.m -tearoff 0 -borderwidth 1
  1235.     $path.edit.m add command -label "Undo" \
  1236.     -underline 0 -command "angela:msg UNDO" -state disabled
  1237.     $path.edit.m add command -label "Redo" \
  1238.     -underline 0 -command "angela:msg REDO" -state disabled
  1239.     $path.edit.m add separator
  1240.     $path.edit.m add command -label "Copy" \
  1241.     -underline 0 -command "angela:msg COPY" -state disabled
  1242.     $path.edit.m add command -label "Cut" \
  1243.     -underline 2 -command "angela:msg CUT"
  1244.     $path.edit.m add command -label "Paste" \
  1245.     -underline 0 -command "angela:msg PASTE" -state disabled
  1246.  
  1247.     menu $path.tools.m -tearoff 0 -borderwidth 1
  1248.     $path.tools.m add command -label "Modules..." \
  1249.     -command "angela:msg MODULES"
  1250.     $path.tools.m add separator
  1251.     $path.tools.m add command -label "Create node" \
  1252.     -command "angela:msg TOOL:NODE"
  1253.     $path.tools.m add command -label "Create edge" \
  1254.     -command "angela:msg TOOL:EDGE"
  1255.     $path.tools.m add command -label "Edit Object" \
  1256.     -command "angela:msg TOOL:EDIT"
  1257.     $path.tools.m add separator
  1258.  
  1259. }
  1260.  
  1261. proc angela:ws:actionbar:init { path } { 
  1262. global angela_option
  1263.  
  1264. #     button $path.node -text "Create node" -borderwidth 1 \
  1265. #     -command "angela:msg TOOL:NODE"
  1266. #     button $path.edge -text "Create edge" -borderwidth 1 \
  1267. #     -command "angela:msg TOOL:EDGE"
  1268. #     button $path.edit -text "Edit"        -borderwidth 1 \
  1269. #     -command "angela:msg TOOL:EDIT"\
  1270.  
  1271. #     pack $path.node -side top -fill x
  1272. #     pack $path.edge -side top -fill x
  1273. #     pack $path.edit -side top -fill x
  1274.  
  1275.     tixSelect $path.sel \
  1276.     -radio true -orientation vertical
  1277.     $path.sel add node -text "Create node" \
  1278.     -command "angela:msg TOOL:NODE" \
  1279.         -font $angela_option(gui:font:tool) -borderwidth 1
  1280.     $path.sel add edge -text "Create edge" \
  1281.     -command "angela:msg TOOL:EDGE" \
  1282.         -font $angela_option(gui:font:tool) -borderwidth 1
  1283.     $path.sel add edit -text "Edit object" \
  1284.     -command "angela:msg TOOL:EDIT" \
  1285.         -font $angela_option(gui:font:tool) -borderwidth 1
  1286.  
  1287.     .balloon bind $path.sel -balloonmsg "Choose Action" \
  1288.     -statusmsg "Choose the action you will execute."
  1289.  
  1290.     pack $path.sel -side top -fill x
  1291.  
  1292. }
  1293.  
  1294. proc angela:ws:statusbar:init { path } { 
  1295. global angela_option
  1296.  
  1297.     label $path.statusbar -font $angela_option(gui:font:status)
  1298.  
  1299.     pack $path.statusbar -fill x -expand no
  1300.  
  1301. }
  1302.  
  1303. proc angela:ws:statusbar:set { path text } {
  1304.  
  1305.     $path.statusbar configure -text $text
  1306.     update
  1307. }
  1308.  
  1309. proc angela:ws:statusbuttons:init { path } { 
  1310. global angela_option
  1311.  
  1312.     label $path.statusbuttons -font $angela_option(gui:font:status)
  1313.  
  1314.     pack $path.statusbuttons -fill x -expand no
  1315.  
  1316. }
  1317.  
  1318. proc angela:ws:statusbuttons:set { path text } {
  1319.  
  1320.     $path.statusbuttons configure -text $text
  1321.  
  1322. }
  1323.  
  1324. proc angela:ws:statusdebug:init { path } { 
  1325. global angela_option
  1326.  
  1327.     label $path.statusdebug -font $angela_option(gui:font:status) \
  1328.     -background black -foreground white
  1329.  
  1330.     .balloon bind $path.statusdebug -balloonmsg "Debugging info"
  1331.  
  1332.     pack $path.statusdebug -fill x -expand no
  1333.  
  1334. }
  1335.  
  1336. proc angela:ws:statusdebug:set { path text } {
  1337. global angela_debug argv0
  1338.  
  1339.     if { $angela_debug } {
  1340.     puts stderr "$argv0:dbg:$text"
  1341.     }
  1342. }
  1343.  
  1344. proc debug { text } {
  1345.     angela:ws:statusdebug:set .statusdebug $text
  1346. }
  1347.  
  1348. proc status { text } {
  1349.     angela:ws:statusbar:set .statusbar $text
  1350. }
  1351.  
  1352. proc angela:ws:buttonbar:init { path } { 
  1353. global angela_option
  1354.  
  1355.     button $path.new -text "NEW" -font $angela_option(gui:font:tool) \
  1356.     -command "angela:msg GRAPH:NEW" \
  1357.     -borderwidth 1
  1358.  
  1359.     .balloon bind $path.new -balloonmsg "Start a new graph" \
  1360.     -statusmsg "Press this to start a new graph"
  1361.  
  1362.     button $path.open -text "OPEN" -font $angela_option(gui:font:tool) \
  1363.     -command "angela:msg GRAPH:OPEN" \
  1364.     -borderwidth 1
  1365.  
  1366.     .balloon bind $path.open -balloonmsg "Open a graph" \
  1367.     -statusmsg "Press this to open a graph"
  1368.  
  1369.     button $path.save -text "SAVE" -font $angela_option(gui:font:tool) \
  1370.     -command "angela:msg GRAPH:SAVE" \
  1371.     -borderwidth 1
  1372.  
  1373.     .balloon bind $path.save -balloonmsg "Save the graph" \
  1374.     -statusmsg "Press this to save the graph"
  1375.  
  1376.     button $path.quit -text "QUIT" -font $angela_option(gui:font:tool) \
  1377.     -command "angela:msg QUIT" \
  1378.     -borderwidth 1
  1379.  
  1380.     .balloon bind $path.quit -balloonmsg "Quit angela!" \
  1381.     -statusmsg "Press this to quit angela!"
  1382.  
  1383.     pack \
  1384.     $path.new \
  1385.     $path.open \
  1386.     $path.save \
  1387.     $path.quit \
  1388.     -side left -fill none -expand no
  1389.  
  1390. }
  1391.  
  1392. proc angela:ws:canvas:init { path } { 
  1393. global angela_canvas
  1394.  
  1395.     canvas $path.c -background white \
  1396.     -xscrollcommand "$path.horiz set" \
  1397.     -yscrollcommand "$path.vert  set" \
  1398.     -borderwidth 2
  1399.     
  1400.     scrollbar $path.horiz -orient horiz \
  1401.     -command "$path.c xview"
  1402.     scrollbar $path.vert  -orient vert \
  1403.     -command "$path.c yview"
  1404.  
  1405.     pack $path.horiz -side bottom -fill x    -expand no
  1406.     pack $path.vert  -side right  -fill y    -expand no
  1407.     pack $path.c     -side top    -fill both -expand yes
  1408.  
  1409.     angela:ws:canvas:grid:draw $path.c
  1410.  
  1411.     set angela_canvas $path.c
  1412.  
  1413. #     bind $path.c <Configure> \
  1414. #     "angela:ws:canvas:resize $path %w %h"
  1415.     
  1416. }
  1417.  
  1418. proc angela:ws:canvas:resize { path width height } {
  1419.  
  1420.     # Terrible hack here. Don't know why there is a difference 
  1421.     # of 6 units.
  1422.     # Should find a way to expand canvas to minimum of window size.
  1423.  
  1424.     incr width -6
  1425.     incr height -6
  1426.  
  1427.     set w [$path.c cget -width]
  1428.     set h [$path.c cget -height]
  1429.  
  1430.     if { $w < $width } {
  1431.     $path.c configure -width $width
  1432.     }
  1433.  
  1434.     if { $h < $height } {
  1435.     $path.c configure -height $height
  1436.     }
  1437.  
  1438.     angela:ws:canvas:refresh $path
  1439.     
  1440. }
  1441.  
  1442. proc angela:ws:canvas:refresh { path } {
  1443.  
  1444.     $path.c configure -scrollregion [$path.c bbox all]
  1445.     angela:ws:canvas:grid:refresh $path.c
  1446.     
  1447. }
  1448.  
  1449. proc angela:ws:canvas:grid:draw { path } {
  1450. global angela_option
  1451.  
  1452. #     set width  [$path cget -width]
  1453. #     set height [$path cget -height]
  1454.  
  1455. #     for { set i 0 } { $i < $width } { incr i $angela_gridx } {
  1456. #     for { set j 0 } { $j < $height } { incr j $angela_gridy } {
  1457. #         $path create line $i [expr $j-1] $i [expr $j+1] \
  1458. #         -fill gray60 -tag grid
  1459. #         $path create line [expr $i-1] $j [expr $i+1] $j\
  1460. #         -fill gray60 -tag grid
  1461. #     }
  1462. #     }
  1463. #     $path lower grid
  1464.  
  1465. }
  1466.  
  1467. proc angela:ws:canvas:grid:refresh { path } {
  1468.  
  1469.     $path delete grid
  1470.     angela:ws:canvas:grid:draw $path
  1471.     
  1472. }
  1473.  
  1474. proc angela:ws:init { } {
  1475.  
  1476.     angela:ws:title:init .
  1477.  
  1478.     angela:prefs:window . MainWindow
  1479.  
  1480.     frame .menubar
  1481.     frame .buttonbar -relief ridge -borderwidth 1
  1482.     frame .middle
  1483.     frame .statusbar -relief sunken -borderwidth 1
  1484.     frame .statusbuttons -relief sunken -borderwidth 1
  1485.     frame .statusdebug -relief sunken -borderwidth 1
  1486.  
  1487.     pack .menubar -side top -fill x -expand no
  1488.     pack .buttonbar -fill x -expand no
  1489.     pack .middle -fill both -expand yes
  1490.     pack .statusbar -fill x -expand no
  1491.     pack .statusdebug -fill x -expand no \
  1492.     -in .statusbar -side right
  1493.     pack .statusbuttons -fill x -expand no \
  1494.     -in .statusbar -side right
  1495.  
  1496.     frame .middle.actionbar
  1497.     frame .middle.canvas
  1498.  
  1499.     pack .middle.actionbar -side left -expand no -fill y
  1500.     pack .middle.canvas -side right -expand yes -fill both
  1501.  
  1502.     tixBalloon .balloon -statusbar .statusbar.statusbar
  1503.  
  1504.     angela:ws:menubar:init       .menubar
  1505.     angela:ws:actionbar:init     .middle.actionbar
  1506.     angela:ws:statusbar:init     .statusbar
  1507.     angela:ws:statusbuttons:init .statusbuttons
  1508.     angela:ws:statusdebug:init   .statusdebug
  1509.     angela:ws:buttonbar:init     .buttonbar
  1510.     angela:ws:canvas:init        .middle.canvas
  1511.  
  1512.     angela:ws:statusbar:set .statusbar "Welcome to angela!"
  1513.     angela:ws:statusbuttons:set .statusbuttons "ready"
  1514.     angela:ws:statusdebug:set .statusdebug "angela! welcomes you"
  1515.  
  1516. }
  1517.  
  1518. ################################################################
  1519. #
  1520. # Properties Management
  1521. #
  1522. ################################################################
  1523.  
  1524. proc angela:properties { } {
  1525. global angela_option
  1526.  
  1527.     set w .properties
  1528.  
  1529.     catch { destroy $w }
  1530.     toplevel $w
  1531.     wm title $w "angela!:Properties"
  1532.  
  1533.     angela:prefs:window $w Properties
  1534.  
  1535.     tixNoteBook $w.nb -ipadx 6 -ipady 6
  1536.     $w config
  1537.     $w.nb subwidget nbframe config
  1538.  
  1539.     $w.nb add general -label General
  1540.     $w.nb add grid    -label Grid
  1541.     $w.nb add print   -label Printing
  1542.     pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
  1543.  
  1544.     # General properties
  1545.     set f [$w.nb subwidget general]
  1546.  
  1547.     set index 0
  1548.     foreach { label variable } \
  1549.     { "Font for tools"        angela_option(gui:font:tool) \
  1550.       "Font for status bar"   angela_option(gui:font:status) \
  1551.       "Font for capabilities" angela_option(gui:font:cap) } \
  1552.     {
  1553.     tixLabelEntry $f.$index -label "$label:" \
  1554.         -options {
  1555.         entry.width 30
  1556.         label.width 20
  1557.         label.anchor w
  1558.         }
  1559.     $f.$index subwidget entry configure -textvariable $variable
  1560.     pack $f.$index
  1561.     incr index
  1562.     }
  1563.  
  1564.     # Grid properties
  1565.     set f [$w.nb subwidget grid]
  1566.  
  1567.     set index 0
  1568.     foreach { label variable } \
  1569.     { "Grid X-resolution"     angela_option(gui:grid:x) \
  1570.       "Grid Y-resolution"     angela_option(gui:grid:y) } \
  1571.     {
  1572.     tixLabelEntry $f.$index -label "$label:" \
  1573.         -options {
  1574.         entry.width 30
  1575.         label.width 20
  1576.         label.anchor w
  1577.         }
  1578.     $f.$index subwidget entry configure -textvariable $variable
  1579.     pack $f.$index
  1580.     incr index
  1581.     }
  1582.  
  1583.     # Print properties
  1584.     set f [$w.nb subwidget print]
  1585.  
  1586.     set index 0
  1587.     foreach { label variable } \
  1588.     { "Paper width"         angela_option(print:paper:width) \
  1589.       "Paper height"        angela_option(print:paper:height) \
  1590.       "Paper margin left"   angela_option(print:paper:left) \
  1591.       "Paper margin right"  angela_option(print:paper:right) \
  1592.       "Paper margin top"    angela_option(print:paper:top) \
  1593.       "Paper margin bottom" angela_option(print:paper:bottom) \
  1594.       } \
  1595.     {
  1596.     tixLabelEntry $f.$index -label "$label:" \
  1597.         -options {
  1598.         entry.width 30
  1599.         label.width 20
  1600.         label.anchor w
  1601.         }
  1602.     $f.$index subwidget entry configure -textvariable $variable
  1603.     pack $f.$index
  1604.     incr index
  1605.     }
  1606.  
  1607.     set box [tixButtonBox $w.b -bd 1 -relief raised]
  1608.     pack $box -side bottom -fill both
  1609.     $box add done -text Done \
  1610.       -command "angela:prefs:window:save $w Properties" -width 6
  1611.  
  1612. }
  1613.  
  1614. ################################################################
  1615. #
  1616. # Tool Management
  1617. #
  1618. ################################################################
  1619.  
  1620. proc angela:tool:add:cascade { path name command } {
  1621.  
  1622.     set index 0
  1623.     while { 1 } {
  1624.     set newmenu $path.cascade$index
  1625.     if { [lsearch [winfo children $path] $newmenu] != -1 } {
  1626.         incr index
  1627.     } else {
  1628.         break
  1629.     }
  1630.     }
  1631.     $path add cascade -label "$name" -menu $newmenu
  1632. #    -command "$command angela:msg"
  1633.  
  1634.     menu $newmenu -tearoff 0
  1635.  
  1636.     return $newmenu
  1637.  
  1638. }
  1639.  
  1640. proc angela:tool:node { } {
  1641. global angela_canvas angela_state
  1642.  
  1643.     bind $angela_canvas <B1-ButtonRelease> \
  1644.     "angela:msg NODE:CREATE %x %y"
  1645.  
  1646.     bind $angela_canvas <B1-Motion> \
  1647.        ""
  1648.     angela:capabilities:manager "node shape text" \
  1649.       angela_cap angela_cap_value
  1650.  
  1651.     set angela_state NODE
  1652.  
  1653.     .middle.actionbar.sel subwidget node configure -state disabled
  1654.     .middle.actionbar.sel subwidget edge configure -state normal
  1655.     .middle.actionbar.sel subwidget edit configure -state normal
  1656. }
  1657.  
  1658. proc angela:tool:edge { } {
  1659. global angela_canvas angela_state
  1660.  
  1661.     bind $angela_canvas <B1-ButtonRelease> \
  1662.        ""
  1663.  
  1664.     bind $angela_canvas <B1-Motion> \
  1665.        ""
  1666.     
  1667.     angela:capabilities:manager "edge line" \
  1668.        angela_cap angela_cap_value
  1669.  
  1670.     set angela_state EDGE
  1671.  
  1672.     .middle.actionbar.sel subwidget node configure -state normal
  1673.     .middle.actionbar.sel subwidget edge configure -state disabled
  1674.     .middle.actionbar.sel subwidget edit configure -state normal
  1675. }
  1676.  
  1677. proc angela:tool:edit { } {
  1678. global angela_canvas angela_state
  1679.  
  1680.     # Destroy capabilities window
  1681.     catch { destroy .cap }
  1682.     
  1683.     bind $angela_canvas <B1-ButtonRelease> \
  1684.        ""
  1685.  
  1686.     bind $angela_canvas <B1-Motion> \
  1687.        ""
  1688.     
  1689.     set angela_state EDIT
  1690.  
  1691.     .middle.actionbar.sel subwidget node configure -state normal
  1692.     .middle.actionbar.sel subwidget edge configure -state normal
  1693.     .middle.actionbar.sel subwidget edit configure -state disabled
  1694. }
  1695.  
  1696. ################################################################
  1697. #
  1698. # Edges
  1699. #
  1700. ################################################################
  1701.  
  1702. proc angela:edge:create { canvas node1 node2 } {
  1703.  
  1704.     angela:msg \
  1705.     EDGE:CREATE:DRAW \
  1706.     $node1 $node2 \
  1707.     angela_cap angela_cap_value "edge line"
  1708.  
  1709. }
  1710.  
  1711. proc angela:edge:create:direct { canvas node1 node2 cap capvalue } {
  1712. global thiscap thiscapvalue
  1713.  
  1714.     array set thiscap $cap
  1715.     array set thiscapvalue $capvalue
  1716.  
  1717.     # This is the high-level code for creating a node
  1718.  
  1719.     angela:msg \
  1720.     EDGE:CREATE:DRAW \
  1721.     $node1 $node2 \
  1722.     thiscap thiscapvalue "edge line"
  1723.  
  1724. }
  1725.  
  1726. proc angela:edge:create:draw { canvas node1 node2 cap \
  1727.                    cap_value classes } {
  1728. global $cap $cap_value angela_edges
  1729.     
  1730.     array set newcap [array get $cap]
  1731.     array set newcap_value [array get $cap_value]
  1732.  
  1733.     set edgecmd [angela:mod:scan:type object edge]
  1734.  
  1735.     foreach type $classes {
  1736.     set attr$type ""
  1737.     foreach a $newcap($type) {
  1738.         set attr$type \
  1739.         "[set attr$type] -$a \"$newcap_value($type:$a)\" "
  1740.     }
  1741.     }
  1742.  
  1743.     set edge [$edgecmd create $node1 $node2]
  1744.     set line [$edge line]
  1745.  
  1746.     eval "$edge update [set attredge]"
  1747.     eval "$line update $canvas [set attrline]"
  1748.  
  1749.     $edge update $canvas
  1750.  
  1751.     lappend angela_edges $edge
  1752.  
  1753.     set carriage [lindex [$node1 export -carriage] 0]
  1754.     if { [lsearch $carriage $edge] == -1 } {
  1755.     lappend carriage $edge
  1756.     $node1 update -carriage $carriage
  1757.     }
  1758.  
  1759.     set carriage [lindex [$node2 export -carriage] 0]
  1760.     if { [lsearch $carriage $edge] == -1 } {
  1761.     lappend carriage $edge
  1762.     $node2 update -carriage $carriage
  1763.     }
  1764.  
  1765.     $edge bind $canvas <Any-Enter> "angela:msg EDGE:ENTER $edge"
  1766.     $edge bind $canvas <B1-ButtonRelease> \
  1767.          "angela:msg EDGE:SPLIT $edge %x %y"
  1768.     $edge bind $canvas <Double-B1-ButtonRelease> \
  1769.          "angela:msg EDGE:EDIT $edge"
  1770.     $edge bind $canvas <B3-ButtonRelease> \
  1771.          "angela:msg EDGE:CONTEXT $edge %x %y"
  1772.  
  1773. }
  1774.  
  1775. proc angela:edge:delete { canvas edge } {
  1776. global angela_edges angela_nodes
  1777.  
  1778.     # Search all nodes to find dependencies
  1779.  
  1780.     foreach node $angela_nodes {
  1781.     set carriage [lindex [$node export -carriage] 0]
  1782.     set index [lsearch $carriage $edge]
  1783.  
  1784.     if { $index != -1 } {
  1785.         set carriage [lreplace $carriage $index $index]
  1786.         $node update -carriage $carriage
  1787.     }
  1788.     }
  1789.  
  1790.     [$edge line] delete $canvas
  1791.     $edge delete
  1792.  
  1793.     set index [lsearch $angela_edges $edge]
  1794.     set angela_edges [lreplace $angela_edges $index $index]
  1795.  
  1796. }
  1797.  
  1798. proc angela:edge:highlight { canvas edge } {
  1799. global angela_lasthighlight angela_option
  1800.  
  1801. #    debug "edge:highlight $canvas $edge$"
  1802.     if { $angela_lasthighlight == $edge } { return }
  1803.  
  1804.     set angela_lasthighlight $edge
  1805.  
  1806.     angela:msg EDGE:SPLIT:NONE
  1807.  
  1808.     set line [$edge line]
  1809.     set coords [lindex [$line export -coords] 0]
  1810.     set length [llength $coords]
  1811.     set length [expr ($length-1)/2]
  1812.     set which 0
  1813.     foreach { x y } $coords {
  1814.     if { $which != 0 && $which != $length } {
  1815.         $canvas create rectangle \
  1816.         [expr $x-4] [expr $y-4] [expr $x+4] [expr $y+4] \
  1817.         -fill black -outline white -width 1 \
  1818.         -tags "eh hl$edge $edge $line eh$which"
  1819.     }
  1820.     if { $which != 0 && $which != $length } {
  1821.         $canvas bind eh$which <B1-Motion> \
  1822.         "angela:msg EDGE:SPLIT:MOVE $edge $which eh$which %x %y"
  1823. #        "angela:edge:split:move:grid $canvas $edge $which eh$which %x %y"
  1824.         $canvas bind eh$which <B1-ButtonRelease> \
  1825.         "angela:msg EDGE:SPLIT:MOVE:END $edge"
  1826.     }
  1827.     incr which
  1828.     }
  1829. }
  1830.  
  1831. proc angela:edge:lowlight { canvas { edge "" } } {
  1832.  
  1833. #    debug "edge:lowlight $canvas $edge"
  1834.     if { $edge == "" } {
  1835.     $canvas delete eh
  1836.     } else {
  1837.     $canvas delete hl$edge
  1838.     }
  1839. }
  1840.  
  1841. proc angela:edge:split:distance { x1 y1 x2 y2 } {
  1842.     set distance [expr sqrt( pow($x1-$x2,2) + pow($y1-$y2,2) )]
  1843.     return $distance
  1844. }
  1845.  
  1846. proc angela:edge:split:add { canvas edge x y } {
  1847. global angela_lasthighlight
  1848.  
  1849. #    debug "split:add $canvas $edge $x $y"
  1850.     set line [$edge line]
  1851.     set coords [lindex [$line export -coords] 0]
  1852.     set origcoords $coords
  1853.  
  1854.     angela:edge:lowlight $canvas $edge
  1855.  
  1856.     # Scans for minimal distance
  1857.     set found 0
  1858.     for { set i 0 } { $i < [expr [llength $coords]-2] } { incr i 2 } {
  1859.     set xa [lindex $coords $i]
  1860.     set ya [lindex $coords [expr $i+1]]
  1861.     set xb [lindex $coords [expr $i+2]]
  1862.     set yb [lindex $coords [expr $i+3]]
  1863.  
  1864.     if { [expr abs(([angela:edge:split:distance $xa $ya $x $y] + \
  1865.                 [angela:edge:split:distance $xb $yb $x $y]) - \
  1866.                [angela:edge:split:distance $xa $ya $xb $yb])] <= 1 } {
  1867.         set found 1
  1868.         break
  1869.     }
  1870.     }
  1871.     
  1872.     set i [expr $i/2]
  1873.  
  1874.     # Set the beginning of the coords
  1875.     set newcoords "[lrange $coords 0 1]"
  1876.     set coords [lreplace $coords 0 1]
  1877.     
  1878.     while { $i > 0 } {
  1879.     # Get the next two coords
  1880.     set newcoords "$newcoords [lrange $coords 0 1] "
  1881.     set coords [lreplace $coords 0 1]
  1882.     incr i -1
  1883.     }
  1884.  
  1885.     set newcoords "$newcoords $x $y $coords"
  1886.     $line update $canvas -coords $newcoords
  1887.     set angela_lasthighlight ""
  1888.     angela:edge:highlight $canvas $edge
  1889. }
  1890.  
  1891. # proc angela:edge:split:move:grid { path edge id tag x y } {
  1892. # global angela_gridx angela_gridy
  1893.  
  1894. #     angela:edge:split:move $path $edge $id $tag \
  1895. #     [$path canvasx $x $angela_gridx] \
  1896. #     [$path canvasy $y $angela_gridy]
  1897.  
  1898. # }
  1899.  
  1900. proc angela:edge:split:move { path edge id tag x y } {
  1901.  
  1902. #    debug "split:move $path $edge $id $tag $x $y"
  1903.     $path coords $tag [expr $x-4] [expr $y-4] [expr $x+4] [expr $y+4]
  1904.     # Set leaf $id of edge $edgeid to $x,$y
  1905.     set line [$edge line]
  1906.     set coords [lindex [$line export -coords] 0]
  1907.     set coords [lreplace $coords [expr $id*2] [expr $id*2] "$x"]
  1908.     set coords [lreplace $coords [expr $id*2+1] [expr $id*2+1] "$y"]
  1909.     $line update $path -coords $coords
  1910. #    $edge update $path
  1911.  
  1912. }
  1913.  
  1914. proc angela:edge:split:move:end { path edge } {
  1915.  
  1916.     $edge update $path
  1917.  
  1918. }
  1919.  
  1920. proc angela:edge:set { canvas edge cap cap_value } {
  1921. global edgecap edgecap_value
  1922.  
  1923. #    debug "edge:set $canvas $edge ..."
  1924.     foreach i $edgecap(edge) {
  1925.     $edge update -$i $edgecap_value(edge:$i)
  1926.     }
  1927.  
  1928.     foreach i $edgecap(line) {
  1929.     [$edge line] update $canvas -$i $edgecap_value(line:$i)
  1930.     }
  1931.  
  1932. }
  1933.  
  1934. proc angela:edge:update { canvas edge } {
  1935. global edgecap edgecap_value
  1936.  
  1937. #    debug "edge:update $canvas $edge"
  1938.     angela:edge:set $canvas $edge edgecap edgecap_value
  1939. }
  1940.  
  1941. proc angela:edge:edit { canvas edge } {
  1942. global angela_cap angela_cap_value edgecap edgecap_value
  1943.  
  1944. #    debug "edge:edit $canvas $edge"
  1945.     angela:capabilities:get:user $edge \
  1946.     " edge $edge line [$edge line] " \
  1947.     edgecap edgecap_value
  1948.  
  1949.     angela:capabilities:manager "edge line" \
  1950.     edgecap edgecap_value "angela:edge:update $canvas $edge"
  1951.  
  1952. }
  1953. proc angela:edge:context { path edge x y } {
  1954. global angela_option
  1955.  
  1956.     catch { $path delete contextmenu }
  1957.     catch { destroy .contextmenu }
  1958.     
  1959.     menu .contextmenu -tearoff 0 -font $angela_option(gui:font:cap) \
  1960.     -borderwidth 1
  1961.  
  1962.     .contextmenu add command -label "Delete Edge" \
  1963.     -command "angela:msg EDGE:DELETE $edge;\
  1964.               $path delete contextmenu;destroy .contextmenu"
  1965.  
  1966.     tk_popup .contextmenu [winfo pointerx .] [winfo pointery .]
  1967.  
  1968. }
  1969.  
  1970. ################################################################
  1971. #
  1972. # Nodes
  1973. #
  1974. ################################################################
  1975.  
  1976. proc angela:node:create { canvas x y } {
  1977. global angela_option
  1978.  
  1979.     # This is the high-level code for creating a node
  1980.  
  1981.     return [angela:msg \
  1982.         NODE:CREATE:DRAW \
  1983.         [$canvas canvasx $x $angela_option(gui:grid:x)] \
  1984.         [$canvas canvasy $y $angela_option(gui:grid:y)] \
  1985.         angela_cap angela_cap_value "node shape text"]
  1986.  
  1987. }
  1988. proc angela:node:create:direct { canvas x y cap capvalue} {
  1989. global thiscap thiscapvalue
  1990.  
  1991.     array set thiscap $cap
  1992.     array set thiscapvalue $capvalue
  1993.  
  1994.     # This is the high-level code for creating a node
  1995.  
  1996.     return [angela:msg \
  1997.         NODE:CREATE:DRAW \
  1998.         $x \
  1999.         $y \
  2000.         thiscap thiscapvalue "node shape text"]
  2001.  
  2002. }
  2003.  
  2004. proc angela:node:create:draw { canvas x y cap cap_value classes } {
  2005. global $cap $cap_value angela_nodes
  2006.  
  2007.     # This is the low-level code for creating a node
  2008.     # This is hard-coded into node/shape/text
  2009.  
  2010.     # Copy the capabilities into new variables
  2011.     array set newcap [array get $cap]
  2012.     array set newcap_value [array get $cap_value]
  2013.     
  2014.     set nodecmd  [angela:mod:scan:type object node]
  2015.     set shapecmd [angela:mod:scan:type object shape]
  2016.     set textcmd  [angela:mod:scan:type object text]
  2017.  
  2018.     set newcap_value(node:x) $x
  2019.     set newcap_value(node:y) $y
  2020.     set newcap_value(shape:x) $x
  2021.     set newcap_value(shape:y) $y
  2022.     set newcap_value(shape:coords) "$x $y"
  2023.     set newcap_value(text:coords) "$x $y"
  2024.  
  2025.     foreach type $classes {
  2026.     set attr$type ""
  2027.     foreach a $newcap($type) {
  2028.         set attr$type \
  2029.         "[set attr$type] -$a \"$newcap_value($type:$a)\" "
  2030.     }
  2031.     }
  2032.  
  2033.     set node [$nodecmd create]
  2034.     set shape [$node shape]
  2035.     set text [$node text]
  2036.     
  2037.     eval "$node update [set attrnode]"
  2038.     eval "$shape update $canvas [set attrshape]"
  2039.     eval "$text update $canvas [set attrtext]"
  2040.  
  2041.     lappend angela_nodes $node
  2042.     angela:ws:canvas:refresh .middle.canvas
  2043.  
  2044.     $node bind $canvas <B1-ButtonRelease> \
  2045.          "angela:msg NODE:MOTION:END $node"
  2046.     $node bind $canvas <Double-B1-ButtonRelease> \
  2047.          "angela:msg NODE:EDIT $node"
  2048.     $node bind $canvas <B1-Motion> \
  2049.          "angela:msg NODE:MOTION $node %x %y"
  2050.     $node bind $canvas <Shift-B1-ButtonRelease> \
  2051.          "debug sB1rel$node"
  2052.     $node bind $canvas <Alt-B1-ButtonRelease> \
  2053.          "debug aB1rel$node"
  2054.     $node bind $canvas <Control-B1-ButtonRelease> \
  2055.          "angela:msg NODE:SWITCH $node"
  2056.     $node bind $canvas <B2-ButtonRelease> \
  2057.          "angela:msg NODE:SWITCH $node"
  2058.     $node bind $canvas <B3-ButtonRelease> \
  2059.          "angela:msg NODE:CONTEXT $node %x %y"
  2060.  
  2061.     return $node
  2062. }
  2063.  
  2064. proc angela:node:delete { canvas node } {
  2065. global angela_nodes angela_selected_nodes
  2066.  
  2067.     angela:node:unselect $canvas $node
  2068.  
  2069.     # Destroy all related edges
  2070.  
  2071.     foreach edge [lindex [$node export -carriage] 0] {
  2072.  
  2073.     angela:edge:delete $canvas $edge
  2074.  
  2075.     }
  2076.  
  2077.     # Destroy the node
  2078.     
  2079.     [$node shape] delete $canvas
  2080.     [$node text] delete $canvas
  2081.     $node delete
  2082.  
  2083.     # Remove the node from the node list
  2084.     
  2085.     set index [lsearch $angela_nodes $node]    
  2086.     set angela_nodes [lreplace $angela_nodes $index $index]
  2087.     
  2088. }
  2089.  
  2090. proc angela:node:highlight { canvas node } {
  2091.  
  2092.     set shape [$node shape]
  2093.     eval "$canvas create rectangle [$canvas bbox $shape] \
  2094.     -tags \"hl hl$node $node\" -width 2 -outline red"
  2095.  
  2096. }
  2097.  
  2098. proc angela:node:lowlight { canvas node } {
  2099.  
  2100.     $canvas delete hl$node
  2101.  
  2102. }
  2103.  
  2104. proc angela:node:select { canvas node } {
  2105. global angela_selected_nodes
  2106.  
  2107.     angela:node:highlight $canvas $node
  2108.     lappend angela_selected_nodes $node
  2109. }
  2110.  
  2111. proc angela:node:unselect { canvas node } {
  2112. global angela_selected_nodes
  2113.     set index [lsearch $angela_selected_nodes $node]
  2114.     if { $index != -1 } {
  2115.     angela:node:lowlight $canvas $node
  2116.     set angela_selected_nodes \
  2117.         [lreplace $angela_selected_nodes $index $index]
  2118.     }
  2119. }
  2120.  
  2121. proc angela:node:switch { canvas node } {
  2122. global angela_selected_nodes
  2123.     set index [lsearch $angela_selected_nodes $node]
  2124.     if { $index == -1 } {
  2125.     angela:node:select $canvas $node
  2126.     } else {
  2127.     angela:node:unselect $canvas $node
  2128.     }
  2129. }
  2130.  
  2131. proc angela:node:move { canvas node dx dy } {
  2132.     $node move $canvas $dx $dy
  2133.     foreach e [lindex [$node export -carriage] 0] {
  2134.     $e update $canvas
  2135.     }    
  2136. }
  2137.  
  2138. proc angela:node:drag:end { canvas } {
  2139. global angela_dragflag
  2140.  
  2141.     set angela_dragflag 0
  2142. }
  2143.  
  2144. proc angela:node:drag { canvas node x y } {
  2145. global angela_dragflag angela_posx angela_posy angela_selected_nodes
  2146.  
  2147.     set nodes $angela_selected_nodes
  2148.  
  2149.     if { [lsearch $nodes $node] == -1 } {
  2150.     lappend nodes $node
  2151.     }
  2152.     if { !$angela_dragflag } {
  2153.     # Starting with drag
  2154.     set angela_dragflag 1
  2155.     set angela_posx $x
  2156.     set angela_posy $y    
  2157.     } else {
  2158.     # I am currently dragging
  2159.     # Move to current position
  2160.     set dx [expr $x-$angela_posx]
  2161.     set dy [expr $y-$angela_posy]
  2162.     foreach n $nodes {
  2163.         angela:node:move $canvas $n $dx $dy
  2164.     }
  2165.     set angela_posx $x
  2166.     set angela_posy $y    
  2167.     }
  2168. }
  2169.  
  2170. proc angela:node:set { canvas node cap cap_value } {
  2171. global nodecap nodecap_value
  2172.  
  2173.     foreach i $nodecap(node) {
  2174.     $node update -$i $nodecap_value(node:$i)
  2175.     }
  2176.  
  2177.     foreach i $nodecap(shape) {
  2178.     [$node shape] update $canvas -$i $nodecap_value(shape:$i)
  2179.     }
  2180.  
  2181.     foreach i $nodecap(text) {
  2182.     [$node text] update $canvas -$i $nodecap_value(text:$i)
  2183.     }
  2184.  
  2185.     [$node text] raise $canvas [$node shape]
  2186. }
  2187.  
  2188. proc angela:node:update { canvas node } {
  2189. global nodecap nodecap_value
  2190.  
  2191.     angela:node:set $canvas $node nodecap nodecap_value
  2192. }
  2193.  
  2194. proc angela:node:edit { canvas node } {
  2195. global angela_cap angela_cap_value nodecap nodecap_value
  2196.  
  2197.     angela:capabilities:get:user $node \
  2198.     " node $node shape [$node shape] text [$node text] " \
  2199.     nodecap nodecap_value
  2200.  
  2201. #    foreach class { node shape text } {
  2202. #    foreach i $nodecap($class) {
  2203. #        debug "Cap $i=$nodecap_value($class:$i)"
  2204. #    }
  2205. #    }
  2206.  
  2207.     angela:capabilities:manager "node shape text" \
  2208.     nodecap nodecap_value "angela:node:update $canvas $node"
  2209.  
  2210. }
  2211.  
  2212. proc angela:node:context { path node x y } {
  2213. global angela_option
  2214.  
  2215.     catch { $path delete contextmenu }
  2216.     catch { destroy .contextmenu }
  2217.     
  2218.     menu .contextmenu -tearoff 0 -font $angela_option(gui:font:cap) \
  2219.     -borderwidth 1
  2220.  
  2221.     .contextmenu add command -label "Switch node" \
  2222.     -command "angela:msg NODE:SWITCH $node;\
  2223.               $path delete contextmenu;destroy .contextmenu"
  2224.  
  2225.     .contextmenu add separator
  2226.  
  2227.     .contextmenu add command -label "Delete node" \
  2228.     -command "angela:msg NODE:DELETE $node;\
  2229.               $path delete contextmenu;destroy .contextmenu"
  2230.  
  2231.     tk_popup .contextmenu [winfo pointerx .] [winfo pointery .]
  2232.  
  2233.  
  2234. }
  2235.  
  2236. ################################################################
  2237. #
  2238. # Bug Management
  2239. #
  2240. ################################################################
  2241.  
  2242. proc angela:bug { } {
  2243. global tcl_platform \
  2244.     bugreport_name \
  2245.     bugreport_source \
  2246.     bugreport_system \
  2247.     bugreport_install \
  2248.     bugreport_motivation
  2249.  
  2250.     set w .bugreport
  2251.     catch { destroy $w }
  2252.     toplevel $w
  2253.     wm title $w "angela!:Bug Report generator"
  2254.  
  2255.     angela:prefs:window $w BugReport
  2256.  
  2257.     # Create the notebook widget
  2258.     tixNoteBook $w.nb -ipadx 6 -ipady 6
  2259.     $w config -bg gray
  2260.     $w.nb subwidget nbframe configure -backpagecolor gray
  2261.  
  2262.     # Create the tabs in the notebook
  2263.     $w.nb add general -label "General" -underline 0
  2264.     pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
  2265.  
  2266.     # Create the general page
  2267.     set f [$w.nb subwidget general]
  2268.  
  2269.     label $f.head -text \
  2270.     "This generates a file you can send to the author via your mail tool."
  2271.  
  2272.     frame $f.f
  2273.     frame $f.common
  2274.     pack $f.head $f.f -side top -padx 2 -pady 2 -fill both -expand yes
  2275.     pack $f.common -side bottom -padx 2 -pady 2 -fill x
  2276.  
  2277.     tixLabelEntry $f.f.name -label "Your name: " \
  2278.     -options {
  2279.         entry.width 50
  2280.         label.width 25
  2281.         label.anchor e
  2282.         entry.textVariable bugreport_name
  2283.     }
  2284.  
  2285.     tixComboBox $f.f.source -label "Where did you get angela!: " -dropdown true \
  2286.     -editable true -variable bugreport_source \
  2287.     -options {
  2288.         listbox.height 5
  2289.         label.width 25
  2290.         label.anchor e
  2291.         entry.width 50
  2292.     }
  2293.     
  2294.     $f.f.source insert end "Official Homepage of angela!"
  2295.     $f.f.source insert end "Official FTP-Server"
  2296.     $f.f.source insert end "Local FTP-Server"
  2297.     $f.f.source insert end "Magazine's CD-ROM (Name: xyz)"
  2298.     $f.f.source insert end "Local grocery"
  2299.     $f.f.source insert end "My Milkman deposited it here!"
  2300.  
  2301.     tixLabelEntry $f.f.system -label "Your system: " \
  2302.     -options {
  2303.         entry.width 50
  2304.         label.width 25
  2305.         label.anchor e
  2306.         entry.textVariable bugreport_system
  2307.     }
  2308.  
  2309.     set newval ""
  2310.     foreach i [array names tcl_platform] {
  2311.     append newval $tcl_platform($i) " "
  2312.     }
  2313.  
  2314.     uplevel #0 set bugreport_system \"$newval\"
  2315.  
  2316.     tixComboBox $f.f.install -label "Difficult to install ?: " -dropdown true \
  2317.     -editable true -variable bugreport_install \
  2318.     -options {
  2319.         listbox.height 5
  2320.         label.width 25
  2321.         label.anchor e
  2322.         entry.width 50
  2323.     }
  2324.  
  2325.     $f.f.install insert end "No, it was not difficult! (no major changes made)"
  2326.     $f.f.install insert end "Yes, it was difficult! (major changes made)"
  2327.     $f.f.install insert end "I used the binary version."
  2328.     $f.f.install insert end "Our sysadmin made the installation!"
  2329.     $f.f.install insert end "I didn't manage to get it work! (huh!)"
  2330.  
  2331.     tixComboBox $f.f.motivation -label "Overall opinion ?: " -dropdown true \
  2332.     -editable true -variable bugreport_motivation \
  2333.     -options {
  2334.         listbox.height 5
  2335.         label.width 25
  2336.         label.anchor e
  2337.         entry.width 50
  2338.     }
  2339.  
  2340.     $f.f.motivation insert end "Continue improving angela!"
  2341.     $f.f.motivation insert end "angela! will end in a dead-project!"
  2342.     $f.f.motivation insert end "I am enjoying using angela!"
  2343.     $f.f.motivation insert end "I cannot imagine working without angela! (really thanks)"
  2344.  
  2345.     label $f.f.contexttext -text "Describe the context as the bug occured:"
  2346.     tixScrolledText $f.f.context -height 60
  2347.  
  2348.     label $f.f.actiontext -text "Describe the action you were doing (or wanted to do):"
  2349.     tixScrolledText $f.f.action -height 60
  2350.  
  2351.     label $f.f.changetext -text "Describe the change you would like to see:"
  2352.     tixScrolledText $f.f.change -height 60
  2353.  
  2354.     pack \
  2355.     $f.f.name \
  2356.     $f.f.source \
  2357.         $f.f.system \
  2358.         $f.f.install \
  2359.         $f.f.motivation \
  2360.         $f.f.contexttext \
  2361.         $f.f.context \
  2362.         $f.f.actiontext \
  2363.         $f.f.action \
  2364.         $f.f.changetext \
  2365.         $f.f.change \
  2366.     -side top -fill x -expand yes
  2367.  
  2368.     # Create the common buttons
  2369.     angela:bug:CreateCommonButtons $w $f.common $f
  2370. }
  2371.  
  2372. proc angela:bug:CreateCommonButtons {w f realf} {
  2373.  
  2374.     button $f.ok -text "Save to bugreport.txt" \
  2375.     -command "angela:bug:okcmd $w $realf;\
  2376.                   angela:prefs:window:save $w BugReport"
  2377.     button $f.cancel -text Cancel -width 6 \
  2378.     -command "angela:prefs:window:save $w BugReport"
  2379.  
  2380.     pack $f.ok $f.cancel -side left -padx 2 -pady 2
  2381.  
  2382. }
  2383.  
  2384. proc angela:bug:okcmd {w f} {
  2385. global \
  2386.     bugreport_name \
  2387.     bugreport_source \
  2388.     bugreport_system \
  2389.     bugreport_install \
  2390.     bugreport_motivation
  2391.  
  2392.     if { [catch { set handle [open "bugreport.txt" w] }] } {
  2393.  
  2394.     angela:dlg "Cannot open bugreport.txt file!!! Aborting."
  2395.     return
  2396.  
  2397.     }
  2398.  
  2399.     puts $handle "Subject: \[angela! BR\]"
  2400.     puts $handle ""
  2401.     puts $handle "Bug report for angela! Send this file to angela@itm.uni-sb.de"
  2402.     puts $handle "using your conventional and preferred mail tool."
  2403.     puts $handle "Please make sure, that the subject line contains the content"
  2404.     puts $handle "of the first line (without the Subject: prefix, of course)."
  2405.     puts $handle ""
  2406.     puts $handle "-------------------------------------------------------------"
  2407.     puts $handle "     Name of user: $bugreport_name"
  2408.     puts $handle "Source of angela!: $bugreport_source"
  2409.     puts $handle "     Local system: $bugreport_system"
  2410.     puts $handle "Installation deg.: $bugreport_install"
  2411.     puts $handle "       Motivation: $bugreport_motivation"
  2412.     puts $handle ""
  2413.     puts $handle "-------------------------------------------------------------"
  2414.     puts $handle "Tcl/Tk infos:"
  2415.     puts $handle "     Command count: [info cmdcount]"
  2416.     puts $handle "  Loaded libraries: [info loaded]"
  2417.     puts $handle "    Called library: [info library]"
  2418.     puts $handle "        Executable: [info nameofexecutable]"
  2419.     puts $handle "        Patchlevel: [info patchlevel]"
  2420.     puts $handle ""
  2421.     puts $handle "-------------------------------------------------------------"
  2422.     puts $handle "Context of problem:"
  2423.     puts $handle "[$f.f.context subwidget text get 1.0 end]"
  2424.     puts $handle ""
  2425.     puts $handle "-------------------------------------------------------------"
  2426.     puts $handle "Action trigerring the problem:"
  2427.     puts $handle "[$f.f.action subwidget text get 1.0 end]"
  2428.     puts $handle ""
  2429.     puts $handle "-------------------------------------------------------------"
  2430.     puts $handle "Change requested:"
  2431.     puts $handle "[$f.f.change subwidget text get 1.0 end]"
  2432.     puts $handle ""
  2433.     puts $handle "-------------------------------------------------------------"
  2434.     puts $handle "End of bug report. Append your comments below this line."
  2435.  
  2436.     close $handle
  2437. }
  2438.  
  2439. ################################################################
  2440. #
  2441. # Load
  2442. #
  2443. ################################################################
  2444.  
  2445. proc angela:load { { filename "" } } {
  2446. global angela_mod_list angela_filename
  2447.  
  2448.     set defaultextension ""
  2449.  
  2450.     if { $filename == "" || ![file exists $filename]} {
  2451.  
  2452.     # Scan all filter_in modules to produce extension list.
  2453.     set extensions " { \"All files\" * } "
  2454.     set modules [angela:mod:scan $angela_mod_list type "filter_in"]
  2455.     
  2456.     foreach i $modules {
  2457.         set extensions "$extensions { \
  2458.                         \"[angela:mod:info:algorithm_name $i]\" \
  2459.                         \"[$i extension]\" }"
  2460.         set defaultextension [$i extension]
  2461.     }
  2462.     
  2463.     set initialdir [angela:prefs:read LoadPath]
  2464.     if { $initialdir == "" || ![file exists $initialdir] } { 
  2465.         set initialdir ./ 
  2466.     }
  2467.  
  2468.     set file [ tk_getOpenFile -filetypes $extensions -parent . \
  2469.                -initialdir $initialdir \
  2470.                -defaultextension $defaultextension ]
  2471.     
  2472.     if { $file != "" } {
  2473.         angela:prefs:write LoadPath [file dirname $file]
  2474.         angela:load $file
  2475.     }
  2476.  
  2477.     } else {
  2478.     
  2479.     set extension [file ext $filename]
  2480.     set modules [angela:mod:scan $angela_mod_list type "filter_in"]
  2481.     set module ""
  2482.     foreach i $modules {
  2483.         if { [$i extension]==$extension } {
  2484.         set module $i
  2485.         break
  2486.         }
  2487.     }
  2488.     if { $module == "" } {
  2489.         debug "Did not found any module for file $filename"
  2490.     }
  2491.     debug "Filetype according to extension is $module"
  2492.     angela:load:module $filename $module
  2493.  
  2494.     }
  2495. }
  2496.  
  2497. proc angela:load:module { filename module } {
  2498. global angela_filename
  2499.  
  2500.     # first delete the current graph
  2501.     angela:msg GRAPH:NEW
  2502.     # open the file and read the graph
  2503.     set handle [open $filename r]
  2504.     angela:load:module:do $handle $module
  2505.     close $handle
  2506.     # update file filename information in editor
  2507.     set angela_filename $filename
  2508.     angela:ws:title:init .
  2509.     angela:msg TOOL:EDIT
  2510. }
  2511.  
  2512. proc angela:load:module:do { handle module } {
  2513. global angela_nodes angela_edges
  2514.     $module load $handle angela:msg $angela_nodes $angela_edges
  2515. }
  2516.  
  2517. ################################################################
  2518. #
  2519. # Save
  2520. #
  2521. ################################################################
  2522.  
  2523. proc angela:save:as { { file "" } } {
  2524. global angela_mod_list
  2525.  
  2526.     if { $file != "" } {
  2527.     angela:save $file
  2528.     return
  2529.     }
  2530.  
  2531.     # Scan all filter_out modules to produce extension list.
  2532.     set extensions " { \"All files\" * } "
  2533.     set modules \
  2534.       [angela:mod:scan $angela_mod_list type "filter_out"]
  2535.  
  2536.     set defaultextension ""
  2537.     
  2538.     foreach i $modules {
  2539.     set extensions "$extensions { \
  2540.                         \"[angela:mod:info:algorithm_name $i]\" \
  2541.                         \"[$i extension]\" }"
  2542.     set defaultextension [$i extension]
  2543.     }
  2544.  
  2545.     set initialdir [angela:prefs:read SavePath]
  2546.     if { $initialdir == "" || ![file exists $initialdir] } {
  2547.     set initialdir [pwd]
  2548.     }
  2549.  
  2550.     set file [ tk_getSaveFile -filetypes $extensions -parent . \
  2551.           -initialfile Untitled -initialdir $initialdir \
  2552.           -defaultextension $defaultextension]
  2553.     
  2554.     if { $file != "" } {
  2555.     angela:prefs:write SavePath [file dirname $file]
  2556.     angela:save $file
  2557.     }
  2558.  
  2559. }
  2560.  
  2561. proc angela:save { filename } {
  2562. global angela_mod_list
  2563.  
  2564.     set extension [file ext $filename]
  2565.     set modules [angela:mod:scan $angela_mod_list type "filter_out"]
  2566.     set module ""
  2567.     foreach i $modules {
  2568.     if { [$i extension]==$extension } {
  2569.         set module $i
  2570.         break
  2571.     }
  2572.     }
  2573.     if { $module == "" } {
  2574.     debug "Did not found any module for file $filename"
  2575.     }
  2576.     debug "Filetype according to extension is $module"
  2577.     angela:save:module $filename $module
  2578. }
  2579.  
  2580. proc angela:save:module { filename module } {
  2581. global angela_filename
  2582.     # Must save graph using filename and module
  2583.  
  2584.     set handle [open $filename w]
  2585.     angela:save:module:do $handle $module
  2586.     close $handle
  2587.  
  2588.     set angela_filename $filename
  2589.     angela:ws:title:init .
  2590. }
  2591.  
  2592. proc angela:save:module:do { handle module } {
  2593. global angela_nodes angela_edges
  2594.     
  2595.     $module save $handle angela:msg $angela_nodes $angela_edges
  2596.     
  2597. }
  2598.  
  2599. ################################################################
  2600. #
  2601. # Niou
  2602. #
  2603. ################################################################
  2604.  
  2605. proc angela:new { } {
  2606. global angela_nodes angela_edges angela_canvas angela_filename
  2607.  
  2608.     foreach i $angela_edges {
  2609.     [$i line] delete $angela_canvas
  2610.     $i delete
  2611.     }
  2612.  
  2613.     foreach i $angela_nodes {
  2614.     [$i shape] delete $angela_canvas
  2615.     [$i text] delete $angela_canvas
  2616.     $i delete
  2617.     }
  2618.  
  2619.     set angela_nodes ""
  2620.     set angela_edges ""
  2621.     set angela_filename ""
  2622.  
  2623.     angela:ws:title:init .
  2624. }
  2625.  
  2626. ################################################################
  2627. #
  2628. # Clipboard Management
  2629. #
  2630. ################################################################
  2631.  
  2632. proc angela:clipboard:cut { } {
  2633. global angela_selected_nodes
  2634.  
  2635.     # Scan which nodes I have to cut...
  2636.     foreach node $angela_selected_nodes {
  2637.     angela:msg NODE:SWITCH $node
  2638.     angela:msg NODE:DELETE $node
  2639.     }
  2640.  
  2641.     set angela_selected_nodes ""
  2642.  
  2643. }
  2644.  
  2645. ################################################################
  2646. #
  2647. # Message Management
  2648. #
  2649. ################################################################
  2650.  
  2651. proc angela:msg \
  2652.     { \
  2653.       message \
  2654.       { arg1 "" } \
  2655.       { arg2 "" } \
  2656.       { arg3 "" } \
  2657.       { arg4 "" } \
  2658.       { arg5 "" } } {
  2659.  
  2660. global angela_canvas angela_state angela_option angela_edgemem \
  2661.     temp_cap temp_capvalue angela_filename
  2662.  
  2663.           #debug "msg:$message $arg1 $arg2 $arg3 $arg4 $arg5"
  2664.           
  2665.           switch $message {
  2666.  
  2667.           CANVAS
  2668.           {
  2669.               return $angela_canvas
  2670.           }
  2671.  
  2672.           VERSION
  2673.           {
  2674.               set Revision "\$Revision"
  2675.               set version "$Revision: 1.28 $"
  2676.               set version [split $version :]
  2677.               set version [string trim [lindex [lindex $version 1] 0] 0]
  2678.               return $version
  2679.           }
  2680.  
  2681.           BUG 
  2682.           {
  2683.               angela:bug
  2684.           }
  2685.  
  2686.           CUT
  2687.           {
  2688.               angela:clipboard:cut
  2689.           }
  2690.  
  2691.           MODULES
  2692.           {
  2693.               angela:mod:manager .modules
  2694.           }
  2695.           
  2696.           QUIT
  2697.           {
  2698.               angela:quit
  2699.           }
  2700.  
  2701.           TOOL:NODE
  2702.           { 
  2703.               angela:tool:node
  2704.           }
  2705.  
  2706.           TOOL:EDGE
  2707.           { 
  2708.               angela:tool:edge
  2709.           }
  2710.  
  2711.           TOOL:EDIT
  2712.           { 
  2713.               angela:tool:edit
  2714.           }
  2715.  
  2716.           TOOL:ADD:CASCADE
  2717.           {
  2718.               return [angela:tool:add:cascade .menubar.tools.m $arg1 $arg2]
  2719.           }
  2720.  
  2721.           NODE:INFO
  2722.           {
  2723.               return [$arg1 export $arg2]
  2724.           }
  2725.  
  2726.           NODE:MOTION
  2727.           {
  2728.               switch $angela_state {
  2729.               EDIT
  2730.               {
  2731.                   angela:node:drag $angela_canvas $arg1 \
  2732.                   [$angela_canvas canvasx $arg2 $angela_option(gui:grid:x)] \
  2733.                   [$angela_canvas canvasy $arg3 $angela_option(gui:grid:y)]
  2734.               }
  2735.               }
  2736.           }
  2737.  
  2738.           NODE:MOTION:END
  2739.           {
  2740.               switch $angela_state {              
  2741.               EDIT
  2742.               {
  2743.                   angela:node:drag:end $angela_canvas
  2744.               }
  2745.  
  2746.               
  2747.               EDGE2
  2748.               {
  2749.                   set angela_state EDGE
  2750.                   angela:msg EDGE:CREATE $angela_edgemem $arg1
  2751.               }
  2752.  
  2753.               EDGE
  2754.               {
  2755.                   set angela_edgemem $arg1
  2756.                   set angela_state EDGE2
  2757.               }
  2758.               }
  2759.           }
  2760.           
  2761.           NODE:CREATE
  2762.           {
  2763.               return [angela:node:create $angela_canvas $arg1 $arg2]
  2764.           }
  2765.  
  2766.           NODE:CREATE:DIRECT
  2767.           {
  2768.               return [angela:node:create:direct $angela_canvas $arg1 $arg2 \
  2769.                   $arg3 $arg4]
  2770.           }
  2771.  
  2772.           NODE:SWITCH
  2773.           {
  2774.               #if { $angela_state == "EDIT" } {
  2775.               angela:node:switch $angela_canvas $arg1
  2776.               #}
  2777.           }
  2778.  
  2779.           NODE:CREATE:DRAW
  2780.           {
  2781.               return [angela:node:create:draw \
  2782.                   $angela_canvas \
  2783.                   $arg1 $arg2 $arg3 $arg4 $arg5]
  2784.           }
  2785.  
  2786.           NODE:DELETE
  2787.           {
  2788.               angela:node:delete $angela_canvas $arg1
  2789.           }
  2790.  
  2791.           NODE:EDIT
  2792.           {
  2793.               switch $angela_state {
  2794.               EDIT
  2795.               {
  2796.                   angela:node:edit $angela_canvas $arg1
  2797.               }
  2798.               }
  2799.           }
  2800.  
  2801.           NODE:EDIT:GET
  2802.           {
  2803.               angela:capabilities:get:all $arg1 \
  2804.               " node $arg1 shape [$arg1 shape] text [$arg1 text] " \
  2805.               temp_cap temp_capvalue
  2806.  
  2807.               return "\{ [array get temp_cap] \} \{ [array get temp_capvalue] \}"
  2808.           }
  2809.  
  2810.           NODE:CONTEXT
  2811.           {
  2812.               angela:node:context $angela_canvas $arg1 \
  2813.               [$angela_canvas canvasx $arg2] \
  2814.               [$angela_canvas canvasy $arg3]
  2815.           }
  2816.  
  2817.           EDGE:INFO 
  2818.           {
  2819.               return [$arg1 export $arg2]
  2820.           }
  2821.  
  2822.           EDGE:EDIT
  2823.           {
  2824.               switch $angela_state {
  2825.               EDIT
  2826.               {
  2827.                   angela:edge:edit $angela_canvas $arg1
  2828.               }
  2829.               }
  2830.           }
  2831.  
  2832.           EDGE:EDIT:GET
  2833.           {
  2834.               angela:capabilities:get:all $arg1 \
  2835.               " edge $arg1 line [$arg1 line] " \
  2836.               temp_cap temp_capvalue
  2837.               
  2838.               return "\{ [array get temp_cap] \} \{ [array get temp_capvalue] \}"
  2839.           }
  2840.  
  2841.           EDGE:CREATE
  2842.           {
  2843.               angela:edge:create $angela_canvas $arg1 $arg2
  2844.           }
  2845.  
  2846.           EDGE:CREATE:DIRECT
  2847.           {
  2848.               angela:edge:create:direct $angela_canvas $arg1 $arg2 $arg3 $arg4
  2849.           }
  2850.  
  2851.           EDGE:CREATE:DRAW
  2852.           {
  2853.               angela:edge:create:draw \
  2854.               $angela_canvas \
  2855.               $arg1 $arg2 $arg3 $arg4 $arg5
  2856.           }
  2857.  
  2858.           EDGE:DELETE
  2859.           {
  2860.               angela:edge:delete $angela_canvas $arg1
  2861.           }
  2862.  
  2863.           EDGE:ENTER
  2864.           {
  2865.               angela:edge:highlight $angela_canvas $arg1
  2866.           }
  2867.  
  2868.           EDGE:SPLIT:NONE
  2869.           {
  2870.               angela:edge:lowlight $angela_canvas
  2871.           }
  2872.  
  2873.           EDGE:SPLIT
  2874.           {
  2875.               switch $angela_state {
  2876.               EDGE
  2877.               {
  2878.                   angela:edge:split:add $angela_canvas \
  2879.                   $arg1 \
  2880.                   [$angela_canvas canvasx $arg2] \
  2881.                   [$angela_canvas canvasy $arg3]
  2882.               }
  2883.               }              
  2884.           }
  2885.  
  2886.           EDGE:SPLIT:MOVE
  2887.           {
  2888.               switch $angela_state {
  2889.               EDIT
  2890.               {
  2891.                   angela:edge:split:move $angela_canvas $arg1 $arg2 $arg3 \
  2892.                   [$angela_canvas canvasx $arg4 $angela_option(gui:grid:x)] \
  2893.                   [$angela_canvas canvasy $arg5 $angela_option(gui:grid:y)]
  2894.               }
  2895.               }
  2896.           }
  2897.  
  2898.           EDGE:SPLIT:MOVE:END
  2899.           {
  2900.               switch $angela_state {
  2901.               EDIT
  2902.               {
  2903.                   angela:edge:split:move:end $angela_canvas $arg1
  2904.               }
  2905.               }
  2906.           }
  2907.  
  2908.           EDGE:CONTEXT
  2909.           {
  2910.               angela:edge:context $angela_canvas $arg1 \
  2911.               [$angela_canvas canvasx $arg2] \
  2912.               [$angela_canvas canvasy $arg3]
  2913.           }
  2914.  
  2915.           # Remove not needed hints such as edge bends to
  2916.           # prepare for print.
  2917.  
  2918.           GRAPH:CLEANUP
  2919.           {
  2920.               angela:edge:lowlight $angela_canvas
  2921.           }
  2922.  
  2923.           GRAPH:NEW
  2924.           {
  2925.               angela:new
  2926.           }
  2927.  
  2928.           GRAPH:PRINT
  2929.           {
  2930.               angela:print $angela_canvas
  2931.           }
  2932.  
  2933.           GRAPH:PROPERTIES
  2934.           {
  2935.               angela:properties
  2936.           }
  2937.  
  2938.           GRAPH:OPEN
  2939.           {
  2940.               angela:load $arg1
  2941.           }
  2942.  
  2943.           GRAPH:SAVE
  2944.           {
  2945.               set filename $angela_filename
  2946.               if { $arg1 != "" } {
  2947.               set filename $arg1
  2948.               }
  2949.               if { [file exists $filename] } {
  2950.               angela:save $filename
  2951.               } else {
  2952.               angela:msg GRAPH:SAVEAS $arg1
  2953.               }
  2954.           }
  2955.  
  2956.           GRAPH:SAVEAS
  2957.           {
  2958.               angela:save:as $arg1
  2959.           }
  2960.  
  2961.           default
  2962.           {
  2963.               tk_dialog .error \
  2964.               "Unknown message" \
  2965.               "The message server received an unknown\
  2966.                            message to process. Request will be\
  2967.                            ignored.\n\
  2968.                            $message $arg1 $arg2 $arg3\
  2969.                            $arg4 $arg5" \
  2970.               "" \
  2971.               0 \
  2972.               "Ok"
  2973.           }
  2974.           
  2975.           }
  2976.  
  2977. switch $angela_state {
  2978.     
  2979.     NORMAL
  2980.     {
  2981.     status "Press action button."
  2982.     }
  2983.  
  2984.     NODE
  2985.     {
  2986.     status "Left click to create node."
  2987.     }
  2988.  
  2989.     EDGE
  2990.     {
  2991.     status "Left click on first node for edge,\
  2992.                 Left click on existing edge to create bend."
  2993.     }
  2994.  
  2995.     EDGE2
  2996.     {
  2997.     status "Left click on second node to create edge."
  2998.     }
  2999.  
  3000.     EDIT
  3001.     {
  3002.     status "Left drag to move node(s) and edge bends.\
  3003.                 Ctrl Left click or middle click \
  3004.                 to switch node. Double Left to edit."
  3005.     }
  3006. }
  3007.  
  3008. }
  3009.           
  3010. ################################################################
  3011. #
  3012. # Fatal exit
  3013. #
  3014. ################################################################
  3015.  
  3016. proc fatal { text } {
  3017.  
  3018.     puts stderr ""
  3019.     puts stderr "I am sorry. Something was wrong and I cannot\
  3020.                  continue executing angela!."
  3021.     puts stderr "Reason: $text"
  3022.     puts stderr "For bug reports: angela@itm.uni-sb.de"
  3023.     puts stderr ""
  3024.  
  3025.     exit
  3026.  
  3027. }
  3028.  
  3029. ################################################################
  3030. #
  3031. # Quit
  3032. #
  3033. ################################################################
  3034.  
  3035. proc angela:dlg { text } {
  3036.     tk_dialog .error \
  3037.     "Warning" \
  3038.     "$text" \
  3039.     "" \
  3040.     0 \
  3041.     "Ok"
  3042. }
  3043.  
  3044. ################################################################
  3045. #
  3046. # Quit
  3047. #
  3048. ################################################################
  3049.  
  3050. proc angela:quit { } {
  3051.  
  3052.     angela:prefs:window:save . MainWindow
  3053.     exit
  3054.  
  3055. }
  3056.  
  3057. ################################################################
  3058. #
  3059. # Startup logo
  3060. #
  3061. ################################################################
  3062.  
  3063. proc angela:logo { } {
  3064.  
  3065.     catch { destroy .logo }
  3066.     toplevel .logo
  3067.     wm title .logo "Welcome to angela!"
  3068.     angela:prefs:window .logo Logo
  3069.  
  3070.     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=
  3071.  
  3072.     button .logo.logo \
  3073.     -command "angela:prefs:window:save .logo Logo" \
  3074.     -image angela_logo 
  3075.  
  3076.     pack .logo.logo
  3077.     update
  3078.  
  3079.     after 8000 { catch { angela:prefs:window:save .logo Logo } }
  3080. }
  3081.  
  3082. ################################################################
  3083. #
  3084. # Execute a Tcl command
  3085. #
  3086. ################################################################
  3087.  
  3088. proc angela:tcl:exec { path } {
  3089.  
  3090.     set command [$path get]
  3091.     debug "Executing $command"
  3092.     puts stderr [eval $command]
  3093.  
  3094. }
  3095.  
  3096. proc angela:tcl { } {
  3097.  
  3098.     catch { destroy .tcl }
  3099.     toplevel .tcl
  3100.     wm title .tcl "angela!:Tcl Command"
  3101.  
  3102.     frame .tcl.up -borderwidth 2 -relief ridge
  3103.     frame .tcl.down -borderwidth 2 -relief ridge
  3104.     pack .tcl.up .tcl.down -side top -fill both -expand yes
  3105.  
  3106.     button .tcl.down.exec -text "Execute..." \
  3107.     -command "angela:tcl:exec .tcl.up.entry"
  3108.  
  3109.     button .tcl.down.cancel -text "Cancel" \
  3110.     -command "destroy .tcl"
  3111.  
  3112.     label .tcl.up.label -text "Command:" -width 10
  3113.     entry .tcl.up.entry -background white -width 30
  3114.  
  3115.     bind .tcl.up.entry <Return> "angela:tcl:exec .tcl.up.entry"
  3116.     focus .tcl.up.entry
  3117.  
  3118.     pack .tcl.up.label .tcl.up.entry -side left -fill x \
  3119.     -expand yes
  3120.  
  3121.     pack .tcl.down.exec .tcl.down.cancel -side left -fill both \
  3122.     -expand yes
  3123. }
  3124.  
  3125. ################################################################
  3126. ################################################################
  3127. ################################################################
  3128. ##
  3129. ## Main part
  3130. ##
  3131. ################################################################
  3132. ################################################################
  3133. ################################################################
  3134.  
  3135. puts stderr "\n"
  3136. puts stderr "--"
  3137. puts -nonewline stderr "   angela! [angela:msg VERSION]"
  3138. foreach i [array names tcl_platform] {
  3139.     puts -nonewline stderr " $tcl_platform($i)"
  3140. }
  3141. puts stderr ""
  3142. puts stderr "   Copyright ⌐ 1997-98 by Oliver Pabst &"
  3143. puts stderr "                          Max Planck Institute for Computer Science."
  3144. puts stderr "   angela! comes with ABSOLUTELY NO WARRANTY; for details see the"
  3145. puts stderr "   provided LICENSE file."
  3146. puts stderr "--"
  3147. puts stderr "\n"
  3148.  
  3149. # The directory from which angela is called.
  3150. set angela_root [file dirname $argv0]
  3151.  
  3152. # Process command line
  3153.  
  3154. set lastused 0
  3155.  
  3156. for { set i 0 } { $i < $argc } { incr i } {
  3157.  
  3158.     switch -exact -- [lindex $argv $i] {
  3159.  
  3160.     --debug
  3161.     {
  3162.         set lastused [expr $i+1]
  3163.         set angela_debug 1
  3164.     }
  3165.  
  3166.     --help
  3167.     {
  3168.         puts stderr "Help:"
  3169.         puts stderr ""
  3170.         puts stderr "$argv0 \[options\] \[file\]"
  3171.         puts stderr ""
  3172.         puts stderr " where"
  3173.         puts stderr ""
  3174.         puts stderr "\[options\] is optional and in the following list:"
  3175.         puts stderr "  --debug            Activate debug mode."
  3176.         puts stderr "  --help             Shows this help message."
  3177.         puts stderr ""
  3178.         puts stderr "   -display display  Display (and screen) on which to display window."
  3179.         puts stderr ""
  3180.         puts stderr " and"
  3181.         puts stderr ""
  3182.         puts stderr "\[file\] is a optional file to load after startup."
  3183.         puts stderr ""
  3184.         puts stderr "Enjoy angela!"
  3185.         puts stderr ""
  3186.         exit
  3187.     }
  3188.     }
  3189. }
  3190.  
  3191. # Default filename
  3192. set angela_filename "Untitled"
  3193.  
  3194. angela:conf:setup
  3195. angela:ws:init
  3196. angela:mod:init
  3197. angela:logo
  3198. angela:capabilities:scan node object node
  3199. angela:capabilities:scan edge object edge
  3200. angela:capabilities:scan shape object shape
  3201. angela:capabilities:scan text object text
  3202. angela:capabilities:scan line object line
  3203. #angela:realtime:start
  3204.  
  3205. debug "Initialization done."
  3206.  
  3207. # Check if there are some unused arguments, and try to load them
  3208.  
  3209. if { $lastused < $argc && $argc > 0 } {
  3210.     angela:load [lindex $argv [expr $argc-1]]
  3211. }
  3212.