1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
|
package require BLT
set bg [blt::background create linear \
-jitter 3 \
-from w -to e \
-colorscale log \
-lowcolor "grey99"\
-highcolor "grey85"\
-repeat reversing \
-relativeto .controls]
blt::tk::frame .controls -bg $bg -borderwidth 4
option add *BltTkCheckbutton*background $bg
option add *BltTkLabel*background $bg
option add *HighlightThickness 0
set palette amwg_blueyellowred.rgb
set x [blt::vector create]
set y [blt::vector create]
$x linspace -2 2 50
$y linspace -2 2 50
set x2 [blt::vector create]
$x2 expr { $x* $x }
set y2 [blt::vector create]
$y2 expr { $y * $y}
set tmp [blt::vector create]
set z [blt::vector create]
foreach i [$y2 values] {
$tmp expr {($x * exp(-($i + $x2))) * 1000}
$z append $tmp
if 0 {
foreach j [$x2 values] k [$x values] {
set value [expr ($k * exp(-($i + $j))) * 1000]
lappend z $value
}
}
}
set mesh [blt::mesh create regular -y {0 100 50} -x {0 100 50}]
blt::contour .g -highlightthickness 0 -bg white
.g element create myContour -values $z -mesh $mesh
.g isoline steps 10 -element myContour
.g legend configure -hide yes
.g axis configure x -tickdirection in -scale linear
.g axis configure y -tickdirection in -scale linear
.g axis configure z \
-palette $palette \
-colorbarthickness 20 \
-tickdirection in \
-scale linear \
-margin right
proc UpdateColors {} {
global usePaletteColors
if { $usePaletteColors } {
.g element configure myContour -color palette -fill palette
} else {
.g element configure myContour -color black -fill red
}
}
proc FixPalette {} {
global palette
.g axis configure z -palette $palette
}
proc FixSymbols {} {
global show
if { $show(symbols) } {
.g pen configure activeIsoline -symbol circle
} else {
.g pen configure activeIsoline -symbol none
}
}
proc Decreasing {} {
global decreasing
.g axis configure z -decreasing $decreasing
}
proc Fix { what } {
global show
set bool $show($what)
.g element configure myContour -show$what $bool
}
proc Cutline {} {
update
blt::vector x
blt::vector y
set coords [.g transform 0 0 50 100]
eval .g element cutline myContour $coords x y
.g marker create line -coords { 0 0 50 100 } -linewidth 2 -outline red -under 0
.g marker create text -text A -coords { 0 0 } -anchor e
.g marker create text -text B -coords { 50 100 } -anchor w
x sort y
blt::graph .cutline -height 1i
.cutline element create cutline -x x -y y -symbol none -linewidth 1
blt::table . \
1,0 .cutline -fill x -cspan 2
}
array set show {
boundary 0
values 0
symbols 0
isolines 0
colormap 0
symbols 0
wireframe 0
}
blt::tk::checkbutton .controls.boundary -text "Boundary" -variable show(boundary) \
-command "Fix boundary"
blt::tk::checkbutton .controls.wireframe -text "Wireframe" -variable show(wireframe) \
-command "Fix wireframe"
blt::tk::checkbutton .controls.colormap -text "Colormap" \
-variable show(colormap) -command "Fix colormap"
blt::tk::checkbutton .controls.isolines -text "Isolines" \
-variable show(isolines) -command "Fix isolines"
blt::tk::checkbutton .controls.values -text "Values" \
-variable show(values) -command "Fix values"
blt::tk::checkbutton .controls.symbols -text "Symbols" \
-variable show(symbols) -command "FixSymbols"
blt::tk::checkbutton .controls.interp -text "Use palette colors" \
-variable usePaletteColors -command "UpdateColors"
blt::tk::checkbutton .controls.decreasing -text "Decreasing" \
-variable decreasing -command "Decreasing"
blt::combobutton .controls.palettes \
-textvariable palette \
-relief sunken \
-background white \
-arrowon yes \
-menu .controls.palettes.menu
blt::tk::label .controls.palettesl -text "Palettes"
blt::combomenu .controls.palettes.menu \
-background white \
-textvariable palette \
-height 200 \
-yscrollbar .controls.palettes.menu.ybar \
-xscrollbar .controls.palettes.menu.xbar
blt::tk::scrollbar .controls.palettes.menu.xbar
blt::tk::scrollbar .controls.palettes.menu.ybar
foreach pal [blt::palette names] {
set pal [string trim $pal ::]
lappend palettes $pal
}
.controls.palettes.menu listadd [lsort -dictionary $palettes] -command FixPalette
blt::table .controls \
0,0 .controls.boundary -anchor w -cspan 2 \
1,0 .controls.colormap -anchor w -cspan 2\
2,0 .controls.isolines -anchor w -cspan 2 \
3,0 .controls.wireframe -anchor w -cspan 2 \
4,0 .controls.symbols -anchor w -cspan 2 \
5,0 .controls.values -anchor w -cspan 2 \
6,0 .controls.interp -anchor w -cspan 2 \
7,0 .controls.decreasing -anchor w -cspan 2 \
8,0 .controls.palettesl -anchor w \
8,1 .controls.palettes -fill x
blt::table configure .controls r* c1 -resize none
blt::table configure .controls r9 -resize both
blt::table . \
0,0 .g -fill both \
0,1 .controls -fill both
foreach key [array names show] {
set show($key) [.g element cget myContour -show$key]
}
Blt_ZoomStack .g
.g isoline bind all <Enter> {
%W isoline deactivate all
%W isoline activate current
}
.g isoline bind all <Leave> {
%W isoline deactivate all
}
update
Cutline
|