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_pling.tcl < prev    next >
Text File  |  1998-05-05  |  3KB  |  128 lines
  1. # This is a module for PLING implementation
  2.  
  3. proc pling_out { command { arg1 "" } { arg2 "" } { arg3 "" } { arg4 "" } } {
  4.  
  5.     switch $command {
  6.  
  7.     long_info
  8.     {
  9.         return "{ Pling output }\
  10.                     { Pling output }\
  11.                     { Oliver Pabst }\
  12.                     { 1.0 }\
  13.                     { Pling output/Tcl } \
  14.                     { Pling output filter as Tcl module for angela! }\
  15.                     { Oliver Pabst }\
  16.                     { 1.0 }\
  17.                     { filter_out }\
  18.                     { pling }"
  19.     }
  20.  
  21.     extension
  22.     {
  23.         return ".pling"
  24.     }
  25.  
  26.     init
  27.     {
  28.     }
  29.  
  30.     save
  31.     {
  32.         pling_out:save $arg1 $arg2 $arg3 $arg4
  33.     }
  34.     }
  35.  
  36. }
  37.  
  38. proc pling_out:save { handle msg nodes edges } {
  39. global tcl_platform
  40.  
  41.     set separator "# -----------------------------------------------------------------------"
  42.  
  43.     puts $handle $separator
  44.     puts $handle "# Generated by angela! version [$msg VERSION]. This is PLING format."
  45.     puts $handle "# For more informations on this format, see following URL:"
  46.     puts $handle "# http://www.mpi-sb.mpg.de/~schwartz/pling.ps"
  47.     puts $handle $separator
  48.     puts $handle "# Running on $tcl_platform(os) version\
  49.                     $tcl_platform(osVersion) ($tcl_platform(platform)) $tcl_platform(machine)."
  50.     puts $handle $separator
  51.     puts $handle "# For more informations about angela!, consult"
  52.     puts $handle "# http://www.mpi-sb.mpg.de/~pabst/angela"
  53.     puts $handle "# or contact pabst@mpi-sb.mpg.de"
  54.     puts $handle $separator
  55.     
  56.     puts $handle "1"
  57.     puts $handle "\"\" black 10c center \"\" left \"\" 0 0"
  58.     
  59.     puts $handle "[llength $nodes]"
  60.  
  61.     set index 0
  62.  
  63.     foreach node $nodes {
  64.  
  65.     puts $handle $separator
  66.     set info [$msg NODE:EDIT:GET $node]
  67.     array set nc [lindex $info 0]
  68.     array set ncv [lindex $info 1]
  69.  
  70.     set hash($node) $index
  71.  
  72.     puts $handle "# Node $node"
  73.     puts $handle "$index \"$ncv(text:text)\" $ncv(text:textcolor) $ncv(text:width) \
  74.                       $ncv(text:anchor) \"$ncv(text:font)\" $ncv(text:anchor) \"\" \
  75.                       $ncv(text:coords) $ncv(node:type) $ncv(shape:coords) \
  76.                       $ncv(shape:color) $ncv(shape:width) $ncv(shape:outline) \"\" \
  77.                       $ncv(node:type) $ncv(shape:shape) \"$ncv(shape:shapeargs)\""
  78.     
  79.     incr index
  80.  
  81.     }
  82.  
  83.     puts $handle "[llength $edges]"
  84.  
  85.     set index 0
  86.  
  87.     foreach edge $edges {
  88.  
  89.     puts $handle $separator
  90.     set info [$msg EDGE:EDIT:GET $edge]
  91.     array set ec [lindex $info 0]
  92.     array set ecv [lindex $info 1]
  93.  
  94.     puts $handle "# edge $edge"
  95.  
  96.     if { $ecv(line:bezier) == 0 } {
  97.         set smooth 0 
  98.     } else {
  99.         set smooth 1
  100.     }
  101.  
  102.     set node1 $hash($ecv(edge:node1))
  103.     set node2 $hash($ecv(edge:node2))
  104.  
  105.     set coords $ecv(line:coords)
  106.  
  107. #    set length [llength $coords]
  108. #    if { $length > 4 } {
  109. #        set coords [lrange $coords 2 [expr $length - 1] ]
  110. #    } else {
  111. #        set coords ""
  112. #    }
  113.  
  114.     puts $handle "$index $node1 $node2\
  115.                       $ecv(edge:type) $ecv(line:color) $ecv(line:width)\
  116.                       $ecv(line:arrow) \"$ecv(line:arrowshape)\"\
  117.                       $smooth $ecv(line:bezier) $ecv(edge:type)\
  118.                       $coords"
  119.  
  120.         incr index
  121.  
  122.     }
  123.     
  124.     puts $handle $separator
  125.     puts $handle "# angela! lives ;)"
  126.  
  127. }
  128.