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
/
module_gmlout.tcl
< prev
next >
Wrap
Text File
|
1998-05-05
|
6KB
|
238 lines
# This is a module for GML implementation
# See the LICENSE file for licensing informations.
# If this file was not included with your distribution package, please
# contact pabst@mpi-sb.mpg.de for informations.
proc gml_out { command { arg1 "" } { arg2 "" } { arg3 "" } { arg4 "" } } {
switch $command {
long_info
{
return "{ GML output }\
{ GML output }\
{ Oliver Pabst }\
{ 1.0 }\
{ GML output/Tcl } \
{ GML output filter as Tcl module for angela! }\
{ Oliver Pabst }\
{ 1.0 }\
{ filter_out }\
{ gml }"
}
extension
{
return ".gml"
}
init
{
}
save
{
gml_out:save $arg1 $arg2 $arg3 $arg4
}
}
}
# This proc tests if string is not empty and then generates
# a string with depth tabs to handle with attribute string
# content
proc gml_out:gs { handle depth label string { check 1 } } {
if { $string != "" } {
for { set i 0 } { $i < $depth } { incr i } {
puts -nonewline $handle \t
}
if { $check } {
set string "\"$string\""
}
puts $handle "$label $string"
}
}
proc gml_out:save { handle msg nodes edges } {
global tcl_platform
# Save some informations, so that everybody knows what the generated
# file is.
set separator "# -----------------------------------------------------------------------"
puts $handle $separator
puts $handle "# Generated by angela! version [$msg VERSION]. This is GML format."
puts $handle "# For more informations on this format, see following URL:"
puts $handle "# http://www.fmi.uni-passau.de/~himsolt/Graphlet/GML/index.html"
puts $handle $separator
puts $handle "# Running on $tcl_platform(os) version\
$tcl_platform(osVersion) ($tcl_platform(platform)) $tcl_platform(machine)."
puts $handle $separator
puts $handle "# For more informations about angela!, consult"
puts $handle "# http://www.mpi-sb.mpg.de/~pabst/angela"
puts $handle "# or contact pabst@mpi-sb.mpg.de"
puts $handle $separator
# Generate file header
gml_out:gs $handle 0 graph \[ 0
gml_out:gs $handle 1 version 2 0
gml_out:gs $handle 1 creator "angela! [$msg VERSION]"
# Generate nodes
set index 0
foreach node $nodes {
puts $handle $separator
set info [$msg NODE:EDIT:GET $node]
array set nc [lindex $info 0]
array set ncv [lindex $info 1]
set hash($node) $index
# Begin node
gml_out:gs $handle 1 node \[ 0
# Generate node id
gml_out:gs $handle 2 id $index 0
# Generate node label
gml_out:gs $handle 2 label $ncv(text:text)
# Abstract types
gml_out:gs $handle 2 type $ncv(node:type) 0
gml_out:gs $handle 2 flag $ncv(node:flag) 0
# Generate graphics section
gml_out:gs $handle 2 graphics \[ 0
# Generate shape coordinates
gml_out:gs $handle 3 x $ncv(shape:x) 0
gml_out:gs $handle 3 y $ncv(shape:y) 0
gml_out:gs $handle 3 w [lindex $ncv(shape:shapeargs) 0] 0
gml_out:gs $handle 3 h [lindex $ncv(shape:shapeargs) 1] 0
# Other shape attributes
gml_out:gs $handle 3 type $ncv(shape:shape)
gml_out:gs $handle 3 fill $ncv(shape:color)
gml_out:gs $handle 3 outline $ncv(shape:outline)
gml_out:gs $handle 3 width $ncv(shape:width) 0
# End graphics section
puts $handle "\t\t\]"
# Generate LabelGraphics section
gml_out:gs $handle 2 labelgraphics \[ 0
# Generate LabelGraphics content
gml_out:gs $handle 3 type text
gml_out:gs $handle 3 fill $ncv(text:textcolor)
gml_out:gs $handle 3 width $ncv(text:width) 0
gml_out:gs $handle 3 anchor $ncv(text:anchor)
gml_out:gs $handle 3 coords $ncv(text:coords)
gml_out:gs $handle 3 pifont $ncv(text:font)
# End of LabelGraphics section
puts $handle "\t\t\]"
# Generate Physics section
gml_out:gs $handle 2 physics \[ 0
# Generate Physics content
gml_out:gs $handle 3 vx $ncv(node:vx) 0
gml_out:gs $handle 3 vy $ncv(node:vy) 0
gml_out:gs $handle 3 ax $ncv(node:ax) 0
gml_out:gs $handle 3 ay $ncv(node:ay) 0
gml_out:gs $handle 3 mass $ncv(node:mass) 0
# End of Physics section
puts $handle "\t\t\]"
# End node
puts $handle "\t\]"
incr index
}
# Now the edges
set index 0
foreach edge $edges {
puts $handle $separator
set info [$msg EDGE:EDIT:GET $edge]
array set ec [lindex $info 0]
array set ecv [lindex $info 1]
# Begin edge
gml_out:gs $handle 1 edge \[ 0
# Generate ends of edge
set node1 $hash($ecv(edge:node1))
set node2 $hash($ecv(edge:node2))
gml_out:gs $handle 2 source $node1 0
gml_out:gs $handle 2 target $node2 0
# Abstract types
gml_out:gs $handle 2 type $ecv(edge:type) 0
gml_out:gs $handle 2 flag $ecv(edge:flag) 0
# Generate graphics section
gml_out:gs $handle 2 graphics \[ 0
# Generate arrow ends
gml_out:gs $handle 3 arrow $ecv(line:arrow)
# Generate other attributes
gml_out:gs $handle 3 fill $ecv(line:color)
gml_out:gs $handle 3 width $ecv(line:width) 0
gml_out:gs $handle 3 arrowshape $ecv(line:arrowshape)
if { $ecv(line:bezier)==0 } {
gml_out:gs $handle 3 smooth 0 0
} else {
gml_out:gs $handle 3 smooth 1 0
gml_out:gs $handle 3 splinesteps $ecv(line:bezier) 0
}
# Generate line
if { [llength $ecv(line:coords)] > 4 } {
gml_out:gs $handle 3 line \[ 0
foreach { x y } $ecv(line:coords) {
gml_out:gs $handle 4 point \[ 0
gml_out:gs $handle 5 x $x 0
gml_out:gs $handle 5 y $y 0
puts $handle "\t\t\t\t\]"
}
puts $handle "\t\t\t\]"
}
# End graphics section
puts $handle "\t\t\]"
# Generate Physics section
gml_out:gs $handle 2 physics \[ 0
# Generate Physics content
gml_out:gs $handle 3 restlen $ecv(edge:restlen) 0
gml_out:gs $handle 3 ks $ecv(edge:ks) 0
gml_out:gs $handle 3 kd $ecv(edge:kd) 0
# End of Physics section
puts $handle "\t\t\]"
# End edge
puts $handle "\t\]"
}
puts $handle "\]"
puts $handle $separator
puts $handle "# angela! lives ;)"
}