|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
# (find-angg "TODO" "peter_russell_demo")
# (find-angg ".emacs" "dynkin-diags")
# Constants:
#
set dyncorner(...,-1,0) "-10 0"
set dyncorner(...,1,0) "10 0"
foreach {dir xness yness} {
-1,-1 -2.5 -2.5 0,-1 0 -3 1,-1 2.5 -2.5
-1,0 -3 0 1,0 3 0
-1,1 -2.5 2.5 0,1 0 3 1,1 2.5 2.5 } {
set dyncorner(O,$dir) "$xness $yness"
set dyncorner(X,$dir) "$xness $yness"
}
# Variables:
#
set pmcommands ""
set xmin ""; set xmax ""; set ymin ""; set ymax ""
set dynscale 2
set dynxorigin 0; set dynyorigin 0
proc origin {x y} {
global dynxorigin dynyorigin
set dynxorigin $x
set dynyorigin $y
}
proc dynpmcoords {tag {dir {}}} {
global XY dynxorigin dynyorigin dynscale dyntype dyncorner
foreach {x y} $XY($tag) {}
set x [expr ($x-$dynxorigin)*$dynscale]
set y [expr ($y-$dynyorigin)*-$dynscale]
if {$dir==""} {
return "$x $y"
} else {
foreach {dx dy} $dyncorner($dyntype($tag),$dir) {}
return "[expr $x+$dx] [expr $y+$dy]"
}
}
proc puts_pm {str} { global pmcommands; append pmcommands "$str\n" }
proc dynput_pm {tag stuff} {
foreach {x y} [dynpmcoords $tag] {}
puts_pm "\\put($x,$y){$stuff}"
}
proc dyntext_pm {tag text} { dynput_pm $tag "\\makebox(0,0){$text}" }
proc dyndots_pm {tag} { dyntext_pm $tag "\$\\cdots\$" }
proc dyno_pm {tag} { dynput_pm $tag "\\dyno" }
proc dynx_pm {tag} { dynput_pm $tag "\\dynx" }
proc sign {n} { expr {$n<0?-1:($n>0?1:0)} }
proc signtowards {tag1 tag2} {
global XY
foreach {x1 y1 x2 y2} "$XY($tag1) $XY($tag2)" {}
return "[sign [expr $x2-$x1]],[sign [expr $y1-$y2]]"
}
proc dynline {tag1 tag2 args} {
foreach {x1 y1} [dynpmcoords $tag1 [signtowards $tag1 $tag2]] {}
foreach {x2 y2} [dynpmcoords $tag2 [signtowards $tag2 $tag1]] {}
dynline_pm $x1 $y1 $x2 $y2
if {$args!=""} { eval dynline $tag2 $args }
}
proc dynline_pm {x1 y1 x2 y2} {
if {$x1>$x2} {
dynline_pm $x2 $y2 $x1 $y1
} elseif {$x1==$x2} {
if {$y1>$y2} {
puts_pm "\\put($x1,$y1){\\line(0,-1){[expr $y1-$y2]}}"
} else { # $y1<$y2
puts_pm "\\put($x1,$y1){\\line(0,1){[expr $y2-$y1]}}"
}
} else { # $x1<$x2
puts_pm "\\put($x1,$y1){\\line(1,[sign [expr $y2-$y1]]){[expr $x2-$x1]}}"
}
}
proc min {a b} { expr {$a<$b?$a:$b} }
proc max {a b} { expr {$a>$b?$a:$b} }
proc setXY {tag x y} {
global XY xmin xmax ymin ymax
set XY($tag) "$x $y"
if {$xmin==""} { # first time
set xmin $x; set xmax $x
set ymin $y; set ymax $y
} else {
set xmin [min $xmin $x]
set ymin [min $ymin $y]
set xmax [max $xmax $x]
set ymax [max $ymax $y]
}
}
proc dynnode {tag type x y args} {
global XY dyntype
setXY $tag $x $y
set dyntype($tag) $type
switch -exact $type {
O { dyno_pm $tag }
X { dynx_pm $tag }
... { dyndots_pm $tag }
default { error }
}
if {$args!=""} { eval dynnode $args }
}
proc dyntext {tag text x y args} {
global XY
setXY $tag $x $y
dyntext_pm $tag $text
if {$args!=""} { eval dyntext $args }
}
proc putsorigin {} {
global xmax xmin ymax ymin
puts "% origin $xmin $ymax"
}
proc putsbeginpicture {} {
global xmax xmin ymax ymin dynscale
set xsize [expr ($xmax-$xmin+10)*$dynscale]
set ysize [expr ($ymax-$ymin+10)*$dynscale]
puts "\\begin{picture}($xsize,$ysize)"
}