[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[1442] | 2 | |
---|
| 3 | # ---------------------------------------------------------------------- |
---|
| 4 | # COMPONENT: flowhints - represents a uniform rectangular 2-D mesh. |
---|
| 5 | # |
---|
| 6 | # This object represents one field in an XML description of a device. |
---|
| 7 | # It simplifies the process of extracting data vectors that represent |
---|
| 8 | # the field. |
---|
| 9 | # ====================================================================== |
---|
| 10 | # AUTHOR: Michael McLennan, Purdue University |
---|
[3177] | 11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[1442] | 12 | # |
---|
| 13 | # See the file "license.terms" for information on usage and |
---|
| 14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 15 | # ====================================================================== |
---|
| 16 | |
---|
| 17 | package require Itcl |
---|
| 18 | package require BLT |
---|
| 19 | |
---|
| 20 | namespace eval Rappture { |
---|
| 21 | # empty |
---|
| 22 | } |
---|
| 23 | |
---|
| 24 | itcl::class Rappture::FlowHints { |
---|
| 25 | constructor {field cname units} { |
---|
[1929] | 26 | # defined below |
---|
[1442] | 27 | } |
---|
| 28 | destructor { |
---|
[1929] | 29 | # defined below |
---|
[1442] | 30 | } |
---|
| 31 | |
---|
| 32 | public method hints {} { return [array get _hints] } |
---|
| 33 | public method particles {} { return $_particles } |
---|
| 34 | public method boxes {} { return $_boxes } |
---|
| 35 | |
---|
| 36 | private method ConvertUnits { value } |
---|
[1448] | 37 | private method GetAxis { obj path varName } |
---|
[1498] | 38 | private method GetBoolean { obj path varName } |
---|
| 39 | private method GetCorner { obj path varName } |
---|
[1448] | 40 | private method GetPosition { obj path varName } |
---|
[1498] | 41 | private method GetSize { obj path varName } |
---|
[1442] | 42 | |
---|
[2744] | 43 | private variable _boxes ""; # List of boxes for the flow. |
---|
| 44 | private variable _particles ""; # List of particle injection planes. |
---|
| 45 | private variable _hints; # Array of settings for the flow. |
---|
[1448] | 46 | private variable _units "" |
---|
[1442] | 47 | } |
---|
| 48 | |
---|
| 49 | # ---------------------------------------------------------------------- |
---|
| 50 | # Constructor |
---|
| 51 | # ---------------------------------------------------------------------- |
---|
| 52 | itcl::body Rappture::FlowHints::constructor {field cname units} { |
---|
| 53 | if {[$field element $cname.flow] == ""} { |
---|
[1929] | 54 | puts stderr "no flow entry in $cname" |
---|
| 55 | return |
---|
[1442] | 56 | } |
---|
| 57 | array set _hints { |
---|
[2744] | 58 | "axis" "x" |
---|
[1929] | 59 | "description" "" |
---|
[2744] | 60 | "outline" "on" |
---|
| 61 | "position" "0.0%" |
---|
| 62 | "streams" "on" |
---|
| 63 | "arrows" "off" |
---|
| 64 | "volume" "on" |
---|
| 65 | "duration" "1:00" |
---|
| 66 | "speed" "1x" |
---|
[1442] | 67 | } |
---|
| 68 | set _units $units |
---|
[1448] | 69 | set f [$field element -as object $cname.flow] |
---|
[1442] | 70 | set _hints(name) [$field element -as id $cname.flow] |
---|
[1448] | 71 | foreach child [$f children] { |
---|
[1929] | 72 | set value [$f get $child] |
---|
| 73 | switch -glob -- $child { |
---|
| 74 | "label" { set _hints(label) $value } |
---|
| 75 | "description" { set _hints(description) $value } |
---|
| 76 | "outline" { GetBoolean $f $child _hints(outline) } |
---|
| 77 | "volume" { GetBoolean $f $child _hints(volume) } |
---|
| 78 | "streams" { GetBoolean $f $child _hints(streams) } |
---|
| 79 | "arrows" { GetBoolean $f $child _hints(arrows) } |
---|
| 80 | "axis" { GetAxis $f $child _hints(axis) } |
---|
| 81 | "speed" { set _hints(speed) $value } |
---|
| 82 | "duration" { set _hints(duration) $value } |
---|
| 83 | "position" { GetPosition $f $child _hints(position) } |
---|
| 84 | "particles*" { |
---|
| 85 | array unset data |
---|
| 86 | array set data { |
---|
[2744] | 87 | "axis" "x" |
---|
| 88 | "color" "blue" |
---|
[1929] | 89 | "description" "" |
---|
[2744] | 90 | "hide" "no" |
---|
[1929] | 91 | "label" "" |
---|
[2744] | 92 | "position" "0.0%" |
---|
| 93 | "size" "1.2" |
---|
[1929] | 94 | } |
---|
| 95 | set p [$f element -as object $child] |
---|
| 96 | set data(name) [$f element -as id $child] |
---|
| 97 | foreach child [$p children] { |
---|
| 98 | set value [$p get $child] |
---|
| 99 | switch -exact -- $child { |
---|
| 100 | "axis" { GetAxis $p axis data(axis) } |
---|
| 101 | "color" { set data(color) $value } |
---|
| 102 | "description" { set data(description) $value } |
---|
| 103 | "hide" { GetBoolean $p hide data(hide) } |
---|
| 104 | "label" { set data(label) $value } |
---|
| 105 | "position" { GetPosition $p position data(position)} |
---|
| 106 | "size" { GetSize $p size data(size)} |
---|
| 107 | } |
---|
| 108 | } |
---|
| 109 | if { $data(label) == "" } { |
---|
| 110 | set data(label) $data(name) |
---|
| 111 | } |
---|
| 112 | itcl::delete object $p |
---|
| 113 | lappend _particles [array get data] |
---|
| 114 | } |
---|
| 115 | "box*" { |
---|
| 116 | array unset data |
---|
| 117 | array set data { |
---|
[2744] | 118 | "color" "green" |
---|
[1929] | 119 | "description" "" |
---|
[2744] | 120 | "hide" "no" |
---|
| 121 | "label" "" |
---|
| 122 | "linewidth" "2" |
---|
[1929] | 123 | } |
---|
| 124 | set b [$f element -as object $child] |
---|
| 125 | set name [$f element -as id $child] |
---|
| 126 | set count 0 |
---|
| 127 | set data(name) $name |
---|
| 128 | set data(color) [$f get $child.color] |
---|
| 129 | foreach child [$b children] { |
---|
| 130 | set value [$b get $child] |
---|
| 131 | switch -glob -- $child { |
---|
| 132 | "color" { set data(color) $value } |
---|
| 133 | "description" { set data(description) $value } |
---|
| 134 | "hide" { GetBoolean $b hide data(hide) } |
---|
| 135 | "linewidth" { GetSize $b linewidth data(linewidth) } |
---|
| 136 | "label" { set data(label) $value } |
---|
| 137 | "corner*" { |
---|
| 138 | incr count |
---|
| 139 | GetCorner $b $child data(corner$count) |
---|
| 140 | } |
---|
| 141 | } |
---|
| 142 | } |
---|
| 143 | if { $data(label) == "" } { |
---|
| 144 | set data(label) $data(name) |
---|
| 145 | } |
---|
| 146 | itcl::delete object $b |
---|
| 147 | lappend _boxes [array get data] |
---|
| 148 | } |
---|
| 149 | } |
---|
[1442] | 150 | } |
---|
[1448] | 151 | itcl::delete object $f |
---|
[1442] | 152 | } |
---|
| 153 | |
---|
| 154 | itcl::body Rappture::FlowHints::ConvertUnits { value } { |
---|
| 155 | set cmd Rappture::Units::convert |
---|
| 156 | set n [scan $value "%g%s" number suffix] |
---|
| 157 | if { $n == 2 } { |
---|
[1929] | 158 | if { $suffix == "%" } { |
---|
| 159 | return $value |
---|
| 160 | } else { |
---|
| 161 | return [$cmd $number -context $suffix -to $_units -units off] |
---|
| 162 | } |
---|
[1442] | 163 | } elseif { [scan $value "%g" number] == 1 } { |
---|
[1929] | 164 | if { $_units == "" } { |
---|
| 165 | return $number |
---|
| 166 | } |
---|
| 167 | return [$cmd $number -context $_units -to $_units -units off] |
---|
[1442] | 168 | } |
---|
| 169 | return "" |
---|
| 170 | } |
---|
| 171 | |
---|
[1448] | 172 | itcl::body Rappture::FlowHints::GetPosition { obj path varName } { |
---|
| 173 | set value [$obj get $path] |
---|
[1442] | 174 | set pos [ConvertUnits $value] |
---|
| 175 | if { $pos == "" } { |
---|
[1929] | 176 | puts stderr "can't convert units \"$value\" of \"$path\"" |
---|
[1442] | 177 | } |
---|
| 178 | upvar $varName position |
---|
| 179 | set position $pos |
---|
| 180 | } |
---|
| 181 | |
---|
[1448] | 182 | itcl::body Rappture::FlowHints::GetAxis { obj path varName } { |
---|
| 183 | set value [$obj get $path] |
---|
[1442] | 184 | set value [string tolower $value] |
---|
| 185 | switch -- $value { |
---|
[1929] | 186 | "x" - "y" - "z" { |
---|
| 187 | upvar $varName axis |
---|
| 188 | set axis $value |
---|
| 189 | return |
---|
| 190 | } |
---|
[1442] | 191 | } |
---|
| 192 | puts stderr "invalid axis \"$value\" in \"$path\"" |
---|
| 193 | } |
---|
| 194 | |
---|
[1448] | 195 | itcl::body Rappture::FlowHints::GetCorner { obj path varName } { |
---|
| 196 | set value [$obj get $path] |
---|
[1442] | 197 | set coords "" |
---|
| 198 | if { [llength $value] != 3 } { |
---|
[1929] | 199 | puts stderr "wrong number of coordinates \"$value\" in \"$path\"" |
---|
| 200 | return "" |
---|
[1442] | 201 | } |
---|
| 202 | foreach coord $value { |
---|
[1929] | 203 | set v [ConvertUnits $coord] |
---|
| 204 | if { $v == "" } { |
---|
| 205 | puts stderr "can't convert units \"$value\" of \"$path\"" |
---|
| 206 | return "" |
---|
| 207 | } |
---|
| 208 | lappend coords $v |
---|
[1442] | 209 | } |
---|
| 210 | upvar $varName corner |
---|
| 211 | set corner $coords |
---|
| 212 | } |
---|
| 213 | |
---|
[1448] | 214 | itcl::body Rappture::FlowHints::GetBoolean { obj path varName } { |
---|
| 215 | set value [$obj get $path] |
---|
[1442] | 216 | if { [string is boolean $value] } { |
---|
[1929] | 217 | upvar $varName bool |
---|
| 218 | set bool [expr $value ? 1 : 0] |
---|
| 219 | return |
---|
[1442] | 220 | } |
---|
| 221 | puts stderr "invalid boolean \"$value\" in \"$path\"" |
---|
| 222 | } |
---|
| 223 | |
---|
[1498] | 224 | itcl::body Rappture::FlowHints::GetSize { obj path varName } { |
---|
| 225 | set string [$obj get $path] |
---|
| 226 | if { [scan $string "%d" value] != 1 || $value < 0 } { |
---|
[1929] | 227 | puts stderr "can't get size \"$string\" of \"$path\"" |
---|
| 228 | return |
---|
[1498] | 229 | } |
---|
| 230 | upvar $varName size |
---|
| 231 | set size $value |
---|
| 232 | } |
---|