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_tclout.tcl < prev    next >
Text File  |  1998-05-05  |  4KB  |  116 lines
  1. # This is a module for TCL code generation
  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 tcl_out { command { arg1 "" } { arg2 "" } { arg3 "" } { arg4 "" } } {
  7.  
  8.     switch $command {
  9.  
  10.     long_info
  11.     {
  12.         return "{ TCL output }\
  13.                     { TCL output }\
  14.                     { Oliver Pabst }\
  15.                     { 1.0 }\
  16.                     { TCL output/Tcl } \
  17.                     { TCL output filter as Tcl module for angela! }\
  18.                     { Oliver Pabst }\
  19.                     { 1.0 }\
  20.                     { filter_out }\
  21.                     { tcl }"
  22.     }
  23.  
  24.     extension
  25.     {
  26.         return ".tcl"
  27.     }
  28.  
  29.     init
  30.     {
  31.     }
  32.  
  33.     save
  34.     {
  35.         tcl_out:save $arg1 $arg2 $arg3 $arg4
  36.     }
  37.     }
  38.  
  39. }
  40.  
  41.  
  42. proc tcl_out:save { handle msg nodes edges } {
  43. global tcl_platform
  44.  
  45.     # Save some informations, so that everybody knows what the generated
  46.     # file is.
  47.  
  48.     set separator "# -----------------------------------------------------------------------"
  49.  
  50.     puts $handle "#!/bin/sh"
  51.     puts $handle "# Please leave the first two lines intact \\"
  52.     puts $handle "exec wish -f \"\$0\" \$\{1+\"\$@\"\}"
  53.     puts $handle $separator
  54.     puts $handle "# This is a generated Tcl script, generated with angela! [$msg VERSION]"
  55.     puts $handle "# Running on $tcl_platform(os) version\
  56.                     $tcl_platform(osVersion) ($tcl_platform(platform)) $tcl_platform(machine)."
  57.     puts $handle $separator
  58.     puts $handle "# For more informations about angela!, consult"
  59.     puts $handle "# http://www.mpi-sb.mpg.de/~pabst/angela"
  60.     puts $handle "# or contact pabst@mpi-sb.mpg.de"
  61.     puts $handle $separator
  62.     puts $handle "# On Windows platforms, run this script using wish.exe"
  63.     puts $handle $separator
  64.     puts $handle "# This script could also be run with the tcl plugin for browsers."
  65.     puts $handle $separator
  66.  
  67.     set canvas [$msg CANVAS]
  68.  
  69.     puts $handle "# Creating canvas to display items"
  70.     puts $handle "frame .canvas"
  71.     puts $handle "pack .canvas -fill both -expand yes"
  72.     puts $handle "canvas .canvas.c -background white\\"
  73.     puts $handle "\t-scrollregion \{[$canvas bbox all]\}\\"
  74.     puts $handle "\t-xscrollcommand \[list .canvas.xscroll set\]\\"
  75.     puts $handle "\t-yscrollcommand \[list .canvas.yscroll set\]\\"
  76.     puts $handle "\t-highlightthickness 0\\"
  77.     puts $handle "\t-borderwidth 0"
  78.     puts $handle "scrollbar .canvas.xscroll -orient horizontal\\"
  79.     puts $handle "\t-command \[list .canvas.c xview]"
  80.     puts $handle "scrollbar .canvas.yscroll -orient vertical\\"
  81.     puts $handle "\t-command \[list .canvas.c yview]"
  82.     puts $handle "grid .canvas.c .canvas.yscroll -sticky news"
  83.     puts $handle "grid .canvas.xscroll -sticky ew"
  84.     puts $handle "grid rowconfigure .canvas 0 -weight 1"
  85.     puts $handle "grid columnconfigure .canvas 0 -weight 1"
  86.     puts $handle $separator
  87.     puts $handle "# Generate items"
  88.  
  89.     $msg GRAPH:CLEANUP
  90.  
  91.     foreach i [$canvas find all] {
  92.     set type [$canvas type $i]
  93.     set config [$canvas itemconfigure $i]
  94.     set coords [$canvas coords $i]
  95.     puts $handle $separator
  96.     puts -nonewline $handle ".canvas.c create $type $coords"
  97.  
  98.     foreach configitem $config {
  99.         set value [string trim [lindex $configitem 4]]
  100.         puts -nonewline $handle "\\\n\t[lindex $configitem 0] "
  101.         if { $value == "" } {
  102.         set value "{}"
  103.         }
  104.         if { [llength $value] > 1 } {
  105.         puts -nonewline $handle \"$value\"
  106.         } else {
  107.         puts -nonewline $handle $value
  108.         }
  109.     }
  110.     puts $handle ""
  111.     }
  112.     
  113.     puts $handle $separator
  114.     puts $handle "# angela! lives ;)"
  115. }
  116.