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 >
Text File  |  1998-05-05  |  6KB  |  238 lines
  1. # This is a module for GML implementation
  2. # See the LICENSE file for licensing informations.
  3. # If this file was not included with your distribution package, please
  4. # contact pabst@mpi-sb.mpg.de for informations.
  5.  
  6. proc gml_out { command { arg1 "" } { arg2 "" } { arg3 "" } { arg4 "" } } {
  7.  
  8.     switch $command {
  9.  
  10.     long_info
  11.     {
  12.         return "{ GML output }\
  13.                     { GML output }\
  14.                     { Oliver Pabst }\
  15.                     { 1.0 }\
  16.                     { GML output/Tcl } \
  17.                     { GML output filter as Tcl module for angela! }\
  18.                     { Oliver Pabst }\
  19.                     { 1.0 }\
  20.                     { filter_out }\
  21.                     { gml }"
  22.     }
  23.  
  24.     extension
  25.     {
  26.         return ".gml"
  27.     }
  28.  
  29.     init
  30.     {
  31.     }
  32.  
  33.     save
  34.     {
  35.         gml_out:save $arg1 $arg2 $arg3 $arg4
  36.     }
  37.     }
  38.  
  39. }
  40.  
  41.  
  42. # This proc tests if string is not empty and then generates
  43. # a string with depth tabs to handle with attribute string
  44. # content
  45. proc gml_out:gs { handle depth label string { check 1 } } {
  46.     if { $string != "" } {
  47.     for { set i 0 } { $i < $depth } { incr i } {
  48.         puts -nonewline $handle \t
  49.     }
  50.     if { $check } {
  51.         set string "\"$string\""
  52.     }
  53.     puts $handle "$label $string"
  54.     }
  55. }
  56.  
  57. proc gml_out:save { handle msg nodes edges } {
  58. global tcl_platform
  59.  
  60.     # Save some informations, so that everybody knows what the generated
  61.     # file is.
  62.  
  63.     set separator "# -----------------------------------------------------------------------"
  64.  
  65.     puts $handle $separator
  66.     puts $handle "# Generated by angela! version [$msg VERSION]. This is GML format."
  67.     puts $handle "# For more informations on this format, see following URL:"
  68.     puts $handle "# http://www.fmi.uni-passau.de/~himsolt/Graphlet/GML/index.html"
  69.     puts $handle $separator
  70.     puts $handle "# Running on $tcl_platform(os) version\
  71.                     $tcl_platform(osVersion) ($tcl_platform(platform)) $tcl_platform(machine)."
  72.     puts $handle $separator
  73.     puts $handle "# For more informations about angela!, consult"
  74.     puts $handle "# http://www.mpi-sb.mpg.de/~pabst/angela"
  75.     puts $handle "# or contact pabst@mpi-sb.mpg.de"
  76.     puts $handle $separator
  77.     
  78.     # Generate file header
  79.  
  80.     gml_out:gs $handle 0 graph \[ 0
  81.     gml_out:gs $handle 1 version 2 0
  82.     gml_out:gs $handle 1 creator "angela! [$msg VERSION]"
  83.  
  84.     # Generate nodes
  85.     
  86.     set index 0
  87.     foreach node $nodes {
  88.  
  89.     puts $handle $separator
  90.  
  91.     set info [$msg NODE:EDIT:GET $node]
  92.     array set nc [lindex $info 0]
  93.     array set ncv [lindex $info 1]
  94.  
  95.     set hash($node) $index
  96.  
  97.     # Begin node
  98.     gml_out:gs $handle 1 node \[ 0
  99.  
  100.     # Generate node id
  101.     gml_out:gs $handle 2 id $index 0
  102.  
  103.     # Generate node label
  104.     gml_out:gs $handle 2 label $ncv(text:text)
  105.  
  106.     # Abstract types
  107.     gml_out:gs $handle 2 type  $ncv(node:type) 0
  108.     gml_out:gs $handle 2 flag  $ncv(node:flag) 0
  109.     
  110.     # Generate graphics section
  111.     gml_out:gs $handle 2 graphics \[ 0
  112.  
  113.     # Generate shape coordinates
  114.     gml_out:gs $handle 3 x $ncv(shape:x) 0
  115.     gml_out:gs $handle 3 y $ncv(shape:y) 0
  116.     gml_out:gs $handle 3 w [lindex $ncv(shape:shapeargs) 0] 0
  117.     gml_out:gs $handle 3 h [lindex $ncv(shape:shapeargs) 1] 0
  118.  
  119.     # Other shape attributes
  120.     gml_out:gs $handle 3 type    $ncv(shape:shape)
  121.     gml_out:gs $handle 3 fill    $ncv(shape:color)
  122.     gml_out:gs $handle 3 outline $ncv(shape:outline)
  123.     gml_out:gs $handle 3 width   $ncv(shape:width) 0
  124.     
  125.     # End graphics section
  126.     puts $handle "\t\t\]"
  127.  
  128.      # Generate LabelGraphics section
  129.      gml_out:gs $handle 2 labelgraphics \[ 0
  130.  
  131.      # Generate LabelGraphics content
  132.      gml_out:gs $handle 3 type   text
  133.     gml_out:gs $handle 3 fill   $ncv(text:textcolor)
  134.     gml_out:gs $handle 3 width  $ncv(text:width) 0
  135.     gml_out:gs $handle 3 anchor $ncv(text:anchor)
  136.     gml_out:gs $handle 3 coords $ncv(text:coords)
  137.     gml_out:gs $handle 3 pifont $ncv(text:font)
  138.  
  139.      # End of LabelGraphics section
  140.      puts $handle "\t\t\]"
  141.  
  142.     # Generate Physics section
  143.     gml_out:gs $handle 2 physics \[ 0
  144.  
  145.     # Generate Physics content
  146.     gml_out:gs $handle 3 vx   $ncv(node:vx) 0
  147.     gml_out:gs $handle 3 vy   $ncv(node:vy) 0
  148.     gml_out:gs $handle 3 ax   $ncv(node:ax) 0
  149.     gml_out:gs $handle 3 ay   $ncv(node:ay) 0
  150.     gml_out:gs $handle 3 mass $ncv(node:mass) 0
  151.  
  152.     # End of Physics section
  153.     puts $handle "\t\t\]"
  154.  
  155.     # End node
  156.     puts $handle "\t\]"
  157.     
  158.     incr index
  159.     }
  160.  
  161.     # Now the edges
  162.  
  163.     set index 0
  164.  
  165.     foreach edge $edges {
  166.  
  167.     puts $handle $separator
  168.     set info [$msg EDGE:EDIT:GET $edge]
  169.     array set ec [lindex $info 0]
  170.     array set ecv [lindex $info 1]
  171.  
  172.     # Begin edge
  173.     gml_out:gs $handle 1 edge \[ 0
  174.     
  175.     # Generate ends of edge
  176.     set node1 $hash($ecv(edge:node1))
  177.     set node2 $hash($ecv(edge:node2))
  178.  
  179.     gml_out:gs $handle 2 source $node1 0
  180.     gml_out:gs $handle 2 target $node2 0
  181.  
  182.     # Abstract types
  183.     gml_out:gs $handle 2 type  $ecv(edge:type) 0
  184.     gml_out:gs $handle 2 flag  $ecv(edge:flag) 0
  185.  
  186.     # Generate graphics section
  187.     gml_out:gs $handle 2 graphics \[ 0
  188.  
  189.     # Generate arrow ends
  190.     gml_out:gs $handle 3 arrow $ecv(line:arrow)
  191.  
  192.     # Generate other attributes
  193.     gml_out:gs $handle 3 fill       $ecv(line:color)
  194.     gml_out:gs $handle 3 width      $ecv(line:width) 0
  195.     gml_out:gs $handle 3 arrowshape $ecv(line:arrowshape)
  196.     
  197.     if { $ecv(line:bezier)==0 } {
  198.         gml_out:gs $handle 3 smooth 0 0
  199.     } else {
  200.         gml_out:gs $handle 3 smooth 1 0
  201.         gml_out:gs $handle 3 splinesteps $ecv(line:bezier) 0
  202.     }
  203.  
  204.     # Generate line
  205.     if { [llength $ecv(line:coords)] > 4 } {
  206.         gml_out:gs $handle 3 line \[ 0        
  207.         foreach { x y } $ecv(line:coords) {
  208.         gml_out:gs $handle 4 point \[ 0
  209.         gml_out:gs $handle 5 x $x 0
  210.         gml_out:gs $handle 5 y $y 0
  211.         puts $handle "\t\t\t\t\]"
  212.         }
  213.         puts $handle "\t\t\t\]"
  214.     }
  215.  
  216.     # End graphics section
  217.     puts $handle "\t\t\]"
  218.  
  219.     # Generate Physics section
  220.     gml_out:gs $handle 2 physics \[ 0
  221.  
  222.     # Generate Physics content
  223.     gml_out:gs $handle 3 restlen $ecv(edge:restlen) 0
  224.     gml_out:gs $handle 3 ks      $ecv(edge:ks) 0
  225.     gml_out:gs $handle 3 kd      $ecv(edge:kd) 0
  226.  
  227.     # End of Physics section
  228.     puts $handle "\t\t\]"
  229.  
  230.     # End edge
  231.     puts $handle "\t\]"
  232.     }
  233.     
  234.     puts $handle "\]"
  235.     puts $handle $separator
  236.     puts $handle "# angela! lives ;)"
  237. }
  238.