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_plingread.tcl < prev    next >
Text File  |  1998-05-05  |  5KB  |  204 lines
  1. # This is a module for PLING implementation
  2.  
  3. proc pling_in { command { arg1 "" } { arg2 "" } { arg3 "" } { arg4 "" } } {
  4.  
  5.     switch $command {
  6.  
  7.     long_info
  8.     {
  9.         return "{ Pling input }\
  10.                     { Pling input }\
  11.                     { Oliver Pabst }\
  12.                     { 1.0 }\
  13.                     { Pling input/Tcl } \
  14.                     { Pling input filter as Tcl module for angela! }\
  15.                     { Oliver Pabst }\
  16.                     { 1.0 }\
  17.                     { filter_in }\
  18.                     { pling }"
  19.     }
  20.  
  21.     extension
  22.     {
  23.         return ".pling"
  24.     }
  25.  
  26.     init
  27.     {
  28.     }
  29.  
  30.     load
  31.     {
  32.         pling_in:load $arg1 $arg2 $arg3 $arg4
  33.     }
  34.     }
  35.  
  36. }
  37.  
  38. proc pling_in:load_line { handle } {
  39.     
  40.     # Must load a line without comments and without meta breaks
  41.     
  42.     set line ""
  43.     set finished 0
  44.  
  45.     while { 1 } {
  46.  
  47.     if { [eof $handle] } { break }
  48.     set thisline [string trim [gets $handle]]
  49.  
  50.     # Get rid of comments
  51.     #set length [string length $thisline]
  52.     #for { set i 0 } { $i < $length } { incr i } {
  53.     #if { [string index $thisline $i] == "\#" } {
  54.     #if { [string index $thisline [expr $i-1]] != "\\" } {
  55.     #set thisline [string range $thisline 0 [expr $i-1]]
  56.     #break
  57.     #}
  58.     #}
  59.     #}
  60.  
  61.     set done 0
  62.     set start 0
  63.     set end end
  64.     while { !$done } {
  65.         #debug 7 "Start is at $start"
  66.         #debug 7 "End is at $end"
  67.         set pointer [ string first \# [string range $thisline $start $end] ]
  68.         #debug 7 "Portion is \"[string range $thisline $start $end]\""
  69.         #debug 7 "Pointer is at $pointer"
  70.         if { $pointer == -1 } {
  71.         set done 1;
  72.         break;
  73.         }
  74.         if { [string index $thisline [expr $pointer-1]] != "\\" } {
  75.         set thisline [string range $thisline 0 [expr $pointer-1]]
  76.         set done 1;
  77.         break;
  78.         }
  79.         set start [expr $pointer+1]
  80.     }
  81.  
  82.     # Check if meta-break
  83.     set thisline [string trim $thisline]
  84.     set length [string length $thisline]
  85.     if { [string index $thisline [expr $length-1]]=="\\" } {
  86.         set thisline [string range $thisline 0 [expr $length-2]]
  87.     } else { set finished 1 }
  88.     set line [string trim "$line $thisline"]
  89.     if { $finished } { 
  90.         if { $line==""} {
  91.         set finished 0
  92.         set line ""
  93.         } else { break }
  94.     }
  95.     }
  96.  
  97.     #debug 5 "Returned line is \"$line\""
  98.     return $line
  99. }
  100.  
  101. proc pling_in:load { handle msg nodes edges } {
  102.  
  103.     # Bypass graph info
  104.  
  105.     pling_in:load_line $handle
  106.     pling_in:load_line $handle
  107.  
  108.     # Read node count
  109.     
  110.     set nodecount [pling_in:load_line $handle]
  111.     
  112.     for { set i 0 } { $i < $nodecount } { incr i } {
  113.  
  114.     set node [pling_in:load_line $handle]
  115.  
  116.     # Example of PLING line for a node:
  117.     # 1 Node white 50  c "Arial 12" c ""  
  118.     # 250.0 225.0 0 250.000000 225.000000  steelblue 1 black ""  0 oval "50 50"
  119.  
  120.     foreach { nodeid node_text node_textcolor node_textwidth \
  121.               node_textanchor node_textfont node_textjust stipple text_x text_y \
  122.               node_type node_x node_y node_color node_width node_outline \
  123.               node_stipple shape_type node_dummy_node_shape node_shapeargs } $node {
  124.         
  125.         # build node capabilities and node values
  126.  
  127.         set nc(node)  "type"
  128.         set nc(text)  "text textcolor width anchor font coords"
  129.         set nc(shape) "x y color width outline shape shapeargs"
  130.         
  131.         set ncv(node:type)       $node_type
  132.         set ncv(text:text)       "$node_text"
  133.         set ncv(text:textcolor)  $node_textcolor
  134.         set ncv(text:width)      $node_textwidth
  135.         set ncv(text:anchor)     $node_textanchor
  136.         set ncv(text:font)       "$node_textfont"
  137.         set ncv(text:coords)     "$text_x $text_y"
  138.         set ncv(shape:x)         $node_x
  139.         set nvc(shape:y)         $node_y
  140.         set ncv(shape:color)     $node_color
  141.         set ncv(shape:width)     $node_width
  142.         set ncv(shape:outline)   $node_outline
  143.         set ncv(shape:shape)     $node_dummy_node_shape
  144.         set ncv(shape:shapeargs) "$node_shapeargs"
  145.  
  146.         set realnodeid [$msg NODE:CREATE:DIRECT $node_x $node_y [array get nc] [array get ncv]]
  147.         set hash($nodeid) $realnodeid
  148.  
  149.     }
  150.  
  151.     }
  152.  
  153.     # Read edge count
  154.     
  155.     set edgecount [pling_in:load_line $handle]
  156.     
  157.     for { set i 0 } { $i < $edgecount } { incr i } {
  158.  
  159.     set edge [pling_in:load_line $handle]
  160.  
  161.     # Example of PLING line for an edge:
  162.     # 0 9 10 0 black 2 both "" 0 0 0 <optional points>
  163.  
  164.     set optional [lrange $edge 11 end]
  165.     set done 0
  166.  
  167.     foreach { edgeid node1 node2 type color width arrow arrowshape \
  168.               bezier steps line_type } $edge {
  169.  
  170.         if { $done } break
  171.         set done 1
  172.         
  173.         # build edge capabilities and node values
  174.  
  175.         set ec(edge) "type"
  176.         set ec(line) "color width arrow arrowshape bezier"
  177.  
  178.         set ecv(edge:type) $type
  179.         
  180.         set ecv(line:color) $color
  181.         set ecv(line:width) $width
  182.         set ecv(line:arrow) $arrow
  183.         set ecv(line:arrowshape) "$arrowshape"
  184.         if { $bezier == 1 } {
  185.         set ecv(line:bezier) $steps
  186.         } else {
  187.         set ecv(line:bezier) 0
  188.         }
  189.  
  190.         if { $optional != "" } {
  191.  
  192.         set ecv(line:coords) "0 0 $optional"
  193.         set ec(line) "$ec(line) coords"
  194.  
  195.         }
  196.         
  197.         $msg EDGE:CREATE:DIRECT $hash($node1) $hash($node2) [array get ec] [array get ecv]
  198.  
  199.     }
  200.  
  201.     }
  202.  
  203. }
  204.