util/X86LINUX64/lib/blt2.5/demos/scripts/clone.tcl

   1
   2 proc CopyOptions { cmd orig new } {
   3     set all [eval $orig $cmd]
   4     set configLine $new
   5     foreach arg $cmd {
   6         lappend configLine $arg
   7     }
   8     foreach option $all {
   9         if { [llength $option] != 5 } {
  10             continue
  11         }
  12         set switch [lindex $option 0]
  13         set initial [lindex $option 3]
  14         set current [lindex $option 4]
  15         if { [string compare $initial $current] == 0 } {
  16             continue
  17         }
  18         lappend configLine $switch $current
  19     }
  20     eval $configLine
  21 }
  22
  23 proc CopyBindings { oper orig new args } {
  24     set tags [$orig $oper bind]
  25     if { [llength $args] > 0 } {
  26         lappend tags [lindex $args 0]
  27     }
  28     foreach tag $tags {
  29         foreach binding [$orig $oper bind $tag] {
  30             set cmd [$orig $oper bind $tag $binding]
  31             $new $oper bind $tag $binding $cmd
  32         }
  33     }
  34 }
  35
  36 proc CloneGraph { orig new } {
  37     graph $new
  38     CopyOptions "configure" $orig $new
  39     # Axis component
  40     foreach axis [$orig axis names] {
  41         if { [$new axis name $axis] == "" } {
  42             $new axis create $axis
  43         }
  44         CopyOptions [list axis configure $axis] $orig $new
  45     }
  46     foreach axis { x y x2 y2 } {
  47         $new ${axis}axis use [$orig ${axis}axis use]
  48     }
  49     # Pen component
  50     foreach pen [$orig pen names] {
  51         if { [$new pen name $pen] == "" } {
  52             $new pen create $pen
  53         }
  54         CopyOptions [list pen configure $pen] $orig $new
  55     }
  56     # Marker component
  57     foreach marker [$orig marker names] {
  58         $new marker create [$orig marker type $marker] -name $marker
  59         CopyBindings marker $orig $new $marker
  60         CopyOptions [list marker configure $marker] $orig $new
  61     }
  62     # Element component
  63     foreach elem [$orig element names] {
  64         $new element create $elem
  65         CopyBindings element $orig $new $elem
  66         CopyOptions [list element configure $elem] $orig $new
  67     }
  68     # Fix element display list
  69     $new element show [$orig element show]
  70     # Legend component
  71     CopyOptions {legend configure} $orig $new
  72     CopyBindings legend $orig $new
  73     # Postscript component
  74     CopyOptions {postscript configure} $orig $new
  75     # Grid component
  76     CopyOptions {grid configure} $orig $new
  77     # Grid component
  78     CopyOptions {crosshairs configure} $orig $new
  79     # Graph bindings
  80     foreach binding [bind $orig] {
  81         set cmd [bind $orig $binding]
  82         bind $new $binding $cmd
  83     }
  84     return $new
  85 }
  86
  87 toplevel .top
  88 pack [CloneGraph $graph .top.graph]