Changeset 5104 for trunk/gui/scripts/mapviewer.tcl
- Timestamp:
- Mar 8, 2015, 11:52:46 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/mapviewer.tcl
r5031 r5104 79 79 private method BuildCameraTab {} 80 80 private method BuildDownloadPopup { widget command } 81 private method BuildHelpTab {} 81 82 private method BuildLayerTab {} 82 83 private method BuildMapTab {} … … 85 86 private method Connect {} 86 87 private method CurrentLayers {args} 88 private method DisablePanningMouseBindings {} 89 private method DisableRotationMouseBindings {} 90 private method DisableZoomMouseBindings {} 87 91 private method Disconnect {} 88 92 private method DoPan {} … … 91 95 private method DoSelect {} 92 96 private method EarthFile {} 97 private method EnablePanningMouseBindings {} 98 private method EnableRotationMouseBindings {} 99 private method EnableZoomMouseBindings {} 93 100 private method EventuallyHandleMotionEvent { x y } 94 101 private method EventuallyPan { dx dy } … … 104 111 private method Pin {option x y} 105 112 private method Rebuild {} 113 private method ReceiveImage { args } 114 private method ReceiveLegend { args } 106 115 private method ReceiveMapInfo { args } 107 116 private method ReceiveScreenInfo { args } 108 private method ReceiveImage { args }109 117 private method Rotate {option x y} 110 118 private method Select {option x y} … … 200 208 # 201 209 $_parser alias image [itcl::code $this ReceiveImage] 210 $_parser alias legend [itcl::code $this ReceiveLegend] 202 211 $_parser alias map [itcl::code $this ReceiveMapInfo] 203 212 $_parser alias camera [itcl::code $this camera] … … 205 214 206 215 # Millisecond delay before animated wait dialog appears 207 set _waitTimeout 500216 set _waitTimeout 900 208 217 209 218 # Settings for mouse motion events: these are required … … 334 343 BuildTerrainTab 335 344 BuildCameraTab 345 BuildHelpTab 336 346 337 347 # Legend … … 349 359 # size of the 3d view isn't set until an image is retrieved from 350 360 # the server. So the panewindow uses the tiny size. 351 set w 10000352 361 pack forget $itk_component(view) 353 362 blt::table $itk_component(plotarea) \ 354 0,0 $itk_component(view) -fill both -reqwidth $w363 0,0 $itk_component(view) -fill both -reqwidth 10000 355 364 blt::table configure $itk_component(plotarea) c1 -resize none 356 365 357 366 bind $itk_component(view) <Configure> \ 358 367 [itcl::code $this EventuallyResize %w %h] 368 369 EnablePanningMouseBindings 370 EnableRotationMouseBindings 371 EnableZoomMouseBindings 359 372 360 373 if {$_useServerManip} { … … 365 378 [itcl::code $this KeyRelease %N] 366 379 367 # Bindings for rotation via mouse 368 bind $itk_component(view) <ButtonPress-1> \ 369 [itcl::code $this MouseClick 1 %x %y] 380 # Zoom to point 370 381 bind $itk_component(view) <Double-1> \ 371 382 [itcl::code $this MouseDoubleClick 1 %x %y] 372 bind $itk_component(view) <B1-Motion> \ 373 [itcl::code $this MouseDrag 1 %x %y] 374 bind $itk_component(view) <ButtonRelease-1> \ 375 [itcl::code $this MouseRelease 1 %x %y] 376 377 # Bindings for panning via mouse 378 bind $itk_component(view) <ButtonPress-2> \ 379 [itcl::code $this MouseClick 2 %x %y] 383 bind $itk_component(view) <Double-3> \ 384 [itcl::code $this MouseDoubleClick 3 %x %y] 385 386 # Unused 380 387 bind $itk_component(view) <Double-2> \ 381 388 [itcl::code $this MouseDoubleClick 2 %x %y] 382 bind $itk_component(view) <B2-Motion> \383 [itcl::code $this MouseDrag 2 %x %y]384 bind $itk_component(view) <ButtonRelease-2> \385 [itcl::code $this MouseRelease 2 %x %y]386 387 bind $itk_component(view) <ButtonPress-3> \388 [itcl::code $this MouseClick 3 %x %y]389 bind $itk_component(view) <Double-3> \390 [itcl::code $this MouseDoubleClick 3 %x %y]391 bind $itk_component(view) <B3-Motion> \392 [itcl::code $this MouseDrag 3 %x %y]393 bind $itk_component(view) <ButtonRelease-3> \394 [itcl::code $this MouseRelease 3 %x %y]395 389 396 390 # Binding for mouse motion events … … 400 394 } 401 395 } else { 402 # Bindings for panning via mouse 403 bind $itk_component(view) <ButtonPress-1> \ 404 [itcl::code $this Pan click %x %y] 405 bind $itk_component(view) <B1-Motion> \ 406 [itcl::code $this Pan drag %x %y] 407 bind $itk_component(view) <ButtonRelease-1> \ 408 [itcl::code $this Pan release %x %y] 409 bind $itk_component(view) <ButtonPress-1> \ 410 +[itcl::code $this SendCmd "map setpos %x %y"] 396 # Zoom to point 411 397 bind $itk_component(view) <Double-1> \ 412 398 [itcl::code $this camera go %x %y 0.4] 399 # Travel to point (no zoom) 413 400 bind $itk_component(view) <Shift-Double-1> \ 414 401 [itcl::code $this camera go %x %y 1.0] 402 # Zoom out centered on point 403 bind $itk_component(view) <Double-3> \ 404 [itcl::code $this camera go %x %y 2.5] 415 405 416 406 # Pin placemark annotations 417 407 bind $itk_component(view) <Control-ButtonPress-1> \ 418 +[itcl::code $this Pin add %x %y]408 [itcl::code $this Pin add %x %y] 419 409 bind $itk_component(view) <Control-ButtonPress-3> \ 420 +[itcl::code $this Pin delete %x %y] 421 410 [itcl::code $this Pin delete %x %y] 411 412 # Draw selection rectangle 422 413 bind $itk_component(view) <Shift-ButtonPress-1> \ 423 414 [itcl::code $this Select click %x %y] … … 425 416 +[itcl::code $this Select drag %x %y] 426 417 bind $itk_component(view) <Shift-ButtonRelease-1> \ 427 +[itcl::code $this Select release %x %y] 428 429 if {1} { 430 # Bindings for rotation via mouse 431 bind $itk_component(view) <ButtonPress-2> \ 432 [itcl::code $this Rotate click %x %y] 433 bind $itk_component(view) <B2-Motion> \ 434 [itcl::code $this Rotate drag %x %y] 435 bind $itk_component(view) <ButtonRelease-2> \ 436 [itcl::code $this Rotate release %x %y] 437 } 438 439 # Bindings for zoom via mouse 440 bind $itk_component(view) <ButtonPress-3> \ 441 [itcl::code $this Zoom click %x %y] 442 bind $itk_component(view) <B3-Motion> \ 443 [itcl::code $this Zoom drag %x %y] 444 bind $itk_component(view) <ButtonRelease-3> \ 445 [itcl::code $this Zoom release %x %y] 446 bind $itk_component(view) <Double-3> \ 447 [itcl::code $this camera go %x %y 2.5] 418 [itcl::code $this Select release %x %y] 419 420 # Update coordinate readout 421 bind $itk_component(view) <ButtonPress-1> \ 422 +[itcl::code $this SendCmd "map setpos %x %y"] 448 423 bind $itk_component(view) <Double-3> \ 449 424 +[itcl::code $this SendCmd "map setpos %x %y"] … … 1045 1020 1046 1021 # 1022 # ReceiveLegend 1023 # 1024 # Invoked automatically whenever the "legend" command comes in from 1025 # the rendering server. Indicates that binary image data with the 1026 # specified <size> will follow. 1027 # 1028 itcl::body Rappture::MapViewer::ReceiveLegend { colormap min max size } { 1029 puts stderr "ReceiveLegend colormap=$colormap range=$min,$max size=$size" 1030 if { [IsConnected] } { 1031 set bytes [ReceiveBytes $size] 1032 if { ![info exists _image(legend)] } { 1033 set _image(legend) [image create photo] 1034 } 1035 $_image(legend) configure -data $bytes 1036 puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>" 1037 #if { [catch {DrawLegend} errs] != 0 } { 1038 # global errorInfo 1039 # puts stderr "errs=$errs errorInfo=$errorInfo" 1040 #} 1041 } 1042 } 1043 1044 # 1047 1045 # ReceiveMapInfo -- 1048 1046 # … … 1119 1117 set h [winfo height $itk_component(view)] 1120 1118 if { $w < 2 || $h < 2 } { 1119 update idletasks 1121 1120 $_dispatcher event -idle !rebuild 1122 1121 return … … 1147 1146 append _outbuf $bytes 1148 1147 } else { 1148 if { [info exists _mapsettings(style)] } { 1149 array set settings { 1150 -color white 1151 } 1152 array set settings $_mapsettings(style) 1153 } 1154 set bgcolor [Color2RGB $settings(-color)] 1149 1155 if { $_mapsettings(type) == "geocentric" } { 1150 1156 $itk_component(grid) configure -state normal 1151 1157 $itk_component(time_l) configure -state normal 1152 1158 $itk_component(time) configure -state normal 1153 SendCmd "map reset geocentric" 1159 $itk_component(pitch_slider_l) configure -state normal 1160 $itk_component(pitch_slider) configure -state normal 1161 EnableRotationMouseBindings 1162 SendCmd "map reset geocentric $bgcolor" 1154 1163 } else { 1155 1164 $itk_component(grid) configure -state disabled 1156 1165 $itk_component(time_l) configure -state disabled 1157 1166 $itk_component(time) configure -state disabled 1167 $itk_component(pitch_slider_l) configure -state disabled 1168 $itk_component(pitch_slider) configure -state disabled 1169 DisableRotationMouseBindings 1158 1170 set proj $_mapsettings(projection) 1171 SendCmd "screen bgcolor $bgcolor" 1159 1172 if { $proj == "" } { 1160 SendCmd "map reset projected global-mercator"1173 SendCmd "map reset projected $bgcolor global-mercator" 1161 1174 } elseif { ![info exists _mapsettings(extents)] || $_mapsettings(extents) == "" } { 1162 SendCmd [list map reset "projected" $proj]1175 SendCmd "map reset projected $bgcolor [list $proj]" 1163 1176 } else { 1164 1177 #foreach {x1 y1 x2 y2} $_mapsettings(extents) break … … 1166 1179 set $key $_mapsettings($key) 1167 1180 } 1168 SendCmd [list map reset "projected" $proj $x1 $y1 $x2 $y2]1181 SendCmd "map reset projected $bgcolor [list $proj] $x1 $y1 $x2 $y2" 1169 1182 } 1170 1183 } … … 1267 1280 } 1268 1281 1282 itcl::body Rappture::MapViewer::EnablePanningMouseBindings {} { 1283 if {$_useServerManip} { 1284 bind $itk_component(view) <ButtonPress-1> \ 1285 [itcl::code $this MouseClick 1 %x %y] 1286 bind $itk_component(view) <B1-Motion> \ 1287 [itcl::code $this MouseDrag 1 %x %y] 1288 bind $itk_component(view) <ButtonRelease-1> \ 1289 [itcl::code $this MouseRelease 1 %x %y] 1290 } else { 1291 bind $itk_component(view) <ButtonPress-1> \ 1292 [itcl::code $this Pan click %x %y] 1293 bind $itk_component(view) <B1-Motion> \ 1294 [itcl::code $this Pan drag %x %y] 1295 bind $itk_component(view) <ButtonRelease-1> \ 1296 [itcl::code $this Pan release %x %y] 1297 } 1298 } 1299 1300 itcl::body Rappture::MapViewer::DisablePanningMouseBindings {} { 1301 bind $itk_component(view) <ButtonPress-1> {} 1302 bind $itk_component(view) <B1-Motion> {} 1303 bind $itk_component(view) <ButtonRelease-1> {} 1304 } 1305 1306 itcl::body Rappture::MapViewer::EnableRotationMouseBindings {} { 1307 if {$_useServerManip} { 1308 bind $itk_component(view) <ButtonPress-2> \ 1309 [itcl::code $this Rotate click %x %y] 1310 bind $itk_component(view) <B2-Motion> \ 1311 [itcl::code $this Rotate drag %x %y] 1312 bind $itk_component(view) <ButtonRelease-2> \ 1313 [itcl::code $this Rotate release %x %y] 1314 } else { 1315 # Bindings for rotation via mouse 1316 bind $itk_component(view) <ButtonPress-2> \ 1317 [itcl::code $this MouseClick 2 %x %y] 1318 bind $itk_component(view) <B2-Motion> \ 1319 [itcl::code $this MouseDrag 2 %x %y] 1320 bind $itk_component(view) <ButtonRelease-2> \ 1321 [itcl::code $this MouseRelease 2 %x %y] 1322 } 1323 } 1324 1325 itcl::body Rappture::MapViewer::DisableRotationMouseBindings {} { 1326 bind $itk_component(view) <ButtonPress-2> {} 1327 bind $itk_component(view) <B2-Motion> {} 1328 bind $itk_component(view) <ButtonRelease-2> {} 1329 } 1330 1331 itcl::body Rappture::MapViewer::EnableZoomMouseBindings {} { 1332 if {$_useServerManip} { 1333 bind $itk_component(view) <ButtonPress-3> \ 1334 [itcl::code $this MouseClick 3 %x %y] 1335 bind $itk_component(view) <B3-Motion> \ 1336 [itcl::code $this MouseDrag 3 %x %y] 1337 bind $itk_component(view) <ButtonRelease-3> \ 1338 [itcl::code $this MouseRelease 3 %x %y] 1339 } else { 1340 bind $itk_component(view) <ButtonPress-3> \ 1341 [itcl::code $this Zoom click %x %y] 1342 bind $itk_component(view) <B3-Motion> \ 1343 [itcl::code $this Zoom drag %x %y] 1344 bind $itk_component(view) <ButtonRelease-3> \ 1345 [itcl::code $this Zoom release %x %y] 1346 } 1347 } 1348 1349 itcl::body Rappture::MapViewer::DisableZoomMouseBindings {} { 1350 bind $itk_component(view) <ButtonPress-3> {} 1351 bind $itk_component(view) <B3-Motion> {} 1352 bind $itk_component(view) <ButtonRelease-3> {} 1353 } 1269 1354 # ---------------------------------------------------------------------- 1270 1355 # USAGE: CurrentLayers ?-all -visible? ?dataobjs? … … 1690 1775 1691 1776 itcl::body Rappture::MapViewer::BuildMapTab {} { 1692 1693 1777 set fg [option get $itk_component(hull) font Font] 1694 1778 #set bfg [option get $itk_component(hull) boldFont Font] … … 1764 1848 1765 1849 itcl::body Rappture::MapViewer::BuildTerrainTab {} { 1766 1767 1850 set fg [option get $itk_component(hull) font Font] 1768 1851 #set bfg [option get $itk_component(hull) boldFont Font] … … 1920 2003 incr row 1921 2004 1922 label $inner.pitch_slider_l -text "Pitch" -font "Arial 9" 1923 ::scale $inner.pitch_slider -font "Arial 9" \ 1924 -from -10 -to -90 -orient horizontal \ 1925 -variable [itcl::scope _view(pitch)] \ 1926 -width 10 \ 1927 -showvalue on \ 1928 -command [itcl::code $this camera set pitch] 2005 itk_component add pitch_slider_l { 2006 label $inner.pitch_slider_l -text "Pitch" -font "Arial 9" 2007 } 2008 itk_component add pitch_slider { 2009 ::scale $inner.pitch_slider -font "Arial 9" \ 2010 -from -10 -to -90 -orient horizontal \ 2011 -variable [itcl::scope _view(pitch)] \ 2012 -width 10 \ 2013 -showvalue on \ 2014 -command [itcl::code $this camera set pitch] 2015 } 1929 2016 1930 2017 blt::table $inner \ … … 1938 2025 blt::table configure $inner c2 -resize expand 1939 2026 blt::table configure $inner r$row -resize expand 2027 } 2028 2029 itcl::body Rappture::MapViewer::BuildHelpTab {} { 2030 set fg [option get $itk_component(hull) font Font] 2031 #set bfg [option get $itk_component(hull) boldFont Font] 2032 2033 set inner [$itk_component(main) insert end \ 2034 -title "Help" \ 2035 -icon [Rappture::icon question_mark12]] 2036 $inner configure -borderwidth 4 2037 2038 set helptext {************************* 2039 Mouse bindings: 2040 ************************* 2041 Left - Panning 2042 Middle - Rotation 2043 Right - Zoom 2044 2045 Zoom/travel: 2046 Left double-click: 2047 Zoom to point 2048 Left shift-double: 2049 Travel to point 2050 Right double-click: 2051 Zoom out from point 2052 2053 Pins: 2054 Ctl-Left: Drop pin 2055 Ctl-Right: Delete pin 2056 2057 Select: 2058 Shift-Left click-drag 2059 2060 ************************* 2061 Keyboard bindings: 2062 ************************* 2063 g - Toggle graticule 2064 l - Toggle lighting 2065 n - Set North up 2066 p - Reset pitch 2067 w - Toggle wireframe 2068 arrows - panning 2069 Shift-arrows - fine pan 2070 Ctl-arrows - rotation 2071 Ctl-Shift-arrows: 2072 fine rotation 2073 PgUp/PgDown - zoom 2074 Home - Reset camera 2075 *************************} 2076 2077 text $inner.info -width 25 -bg white 2078 $inner.info insert end $helptext 2079 $inner.info configure -state disabled 2080 blt::table $inner \ 2081 0,0 $inner.info -fill both 1940 2082 } 1941 2083 … … 2110 2252 SendCmd "map terrain edges $settings(-edges)" 2111 2253 set _settings(terrain-edges) $settings(-edges) 2112 #SendCmd "map terrain color [Color2RGB $settings(-color)]"2254 SendCmd "map terrain color [Color2RGB $settings(-color)]" 2113 2255 #SendCmd "map terrain colormode constant" 2114 2256 SendCmd "map terrain lighting $settings(-lighting)" … … 2143 2285 if {!$_sendEarthFile} { 2144 2286 switch -- $info(driver) { 2287 "colorramp" { 2288 set cmapName $layer 2289 SendCmd [list colormap define $cmapName $info(colorramp.colormap)] 2290 SendCmd [list map layer add $layer image colorramp \ 2291 $info(colorramp.url) $info(cache) $info(profile) \ 2292 $cmapName] 2293 } 2145 2294 "debug" { 2146 SendCmd [list map layer add image debug $layer]2295 SendCmd [list map layer add $layer image debug] 2147 2296 } 2148 2297 "gdal" { 2149 SendCmd [list map layer add image gdal \2150 $info(gdal.url) $info(cache) $layer]2298 SendCmd [list map layer add $layer image gdal \ 2299 $info(gdal.url) $info(cache)] 2151 2300 } 2152 2301 "tms" { 2153 SendCmd [list map layer add image tms \2154 $info(tms.url) $info(cache) $layer]2302 SendCmd [list map layer add $layer image tms \ 2303 $info(tms.url) $info(cache)] 2155 2304 } 2156 2305 "wms" { 2157 SendCmd [list map layer add image wms \2158 $info(wms.url) $info(cache) \2306 SendCmd [list map layer add $layer image wms \ 2307 $info(wms.url) $info(cache) \ 2159 2308 $info(wms.layers) \ 2160 2309 $info(wms.format) \ 2161 $info(wms.transparent) \ 2162 $layer] 2310 $info(wms.transparent)] 2163 2311 } 2164 2312 "xyz" { 2165 SendCmd [list map layer add image xyz \ 2166 $info(xyz.url) $info(cache) \ 2167 $layer] 2313 SendCmd [list map layer add $layer image xyz \ 2314 $info(xyz.url) $info(cache)] 2168 2315 } 2169 2316 } … … 2173 2320 "elevation" { 2174 2321 array set settings { 2175 -min _level 02176 -max _level 232322 -minlevel 0 2323 -maxlevel 23 2177 2324 } 2178 2325 if { [info exists info(style)] } { … … 2182 2329 switch -- $info(driver) { 2183 2330 "gdal" { 2184 SendCmd [list map layer add elevation gdal \2185 $info(gdal.url) $layer]2331 SendCmd [list map layer add $layer elevation gdal \ 2332 $info(gdal.url)] 2186 2333 } 2187 2334 "tms" { 2188 SendCmd [list map layer add elevation tms \2189 $info(tms.url) $layer]2335 SendCmd [list map layer add $layer elevation tms \ 2336 $info(tms.url)] 2190 2337 } 2191 2338 } … … 2206 2353 } 2207 2354 set _opacity($layer) [expr $settings(-opacity) * 100] 2208 SendCmd [list map layer add line $info(ogr.url) $layer] 2355 foreach {r g b} [Color2RGB $settings(-color)] {} 2356 if {[info exists settings(-minrange)] && [info exists settings(-maxrange)]} { 2357 SendCmd [list map layer add $layer line $info(ogr.url) $r $g $b $settings(-width) $settings(-minrange) $settings(-maxrange)] 2358 } else { 2359 SendCmd [list map layer add $layer line $info(ogr.url) $r $g $b $settings(-width)] 2360 } 2361 SendCmd "map layer opacity $settings(-opacity) $layer" 2362 } 2363 "point" { 2364 array set settings { 2365 -color black 2366 -minbias 1000 2367 -opacity 1.0 2368 -size 1 2369 } 2370 if { [info exists info(style)] } { 2371 array set settings $info(style) 2372 } 2373 if { [info exists info(opacity)] } { 2374 set settings(-opacity) $info(opacity) 2375 } 2376 set _opacity($layer) [expr $settings(-opacity) * 100] 2377 foreach {r g b} [Color2RGB $settings(-color)] {} 2378 SendCmd [list map layer add $layer point $info(ogr.url) $r $g $b $settings(-size)] 2209 2379 SendCmd "map layer opacity $settings(-opacity) $layer" 2210 2380 } … … 2222 2392 } 2223 2393 set _opacity($layer) [expr $settings(-opacity) * 100] 2224 SendCmd [list map layer add polygon $info(ogr.url) $layer] 2394 foreach {r g b} [Color2RGB $settings(-color)] {} 2395 SendCmd [list map layer add $layer polygon $info(ogr.url) $r $g $b] 2225 2396 SendCmd "map layer opacity $settings(-opacity) $layer" 2226 2397 } … … 2234 2405 -halocolor white 2235 2406 -halowidth 2.0 2236 -layout "l tr"2407 -layout "left-to-right" 2237 2408 -minbias 1000 2238 2409 -opacity 1.0 2239 -removedupe 12410 -removedupes 1 2240 2411 } 2241 2412 if { [info exists info(style)] } { … … 2252 2423 set priorityExpr "" 2253 2424 } 2254 SendCmd [list map layer add text $info(ogr.url) $contentExpr $priorityExpr $layer] 2425 foreach {fgR fgG fgB} [Color2RGB $settings(-color)] {} 2426 foreach {bgR bgG bgB} [Color2RGB $settings(-halocolor)] {} 2427 if {[info exists settings(-minrange)] && [info exists settings(-maxrange)]} { 2428 SendCmd [list map layer add $layer text $info(ogr.url) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $settings(-halowidth) $settings(-fontsize) $settings(-removedupes) $settings(-declutter) $settings(-minrange) $settings(-maxrange)] 2429 } else { 2430 SendCmd [list map layer add $layer text $info(ogr.url) $contentExpr $priorityExpr $fgR $fgG $fgB $bgR $bgG $bgB $settings(-halowidth) $settings(-fontsize) $settings(-removedupes) $settings(-declutter)] 2431 } 2255 2432 SendCmd "map layer opacity $settings(-opacity) $layer" 2256 2433 } … … 2286 2463 set f $inner.layers 2287 2464 set attrib [list] 2465 set imgIdx 0 2288 2466 foreach dataobj [get -objects] { 2289 2467 foreach layer [$dataobj layers] { … … 2298 2476 blt::table $f $row,0 $f.${layer}_visible -anchor w -pady 2 -cspan 2 2299 2477 incr row 2300 if { $info(type) != "elevation" } { 2478 if { $info(type) == "image" } { 2479 incr imgIdx 2480 } 2481 if { $info(type) != "elevation" && ($info(type) != "image" || $imgIdx > 1) } { 2301 2482 label $f.${layer}_opacity_l -text "Opacity" -font "Arial 9" 2302 2483 ::scale $f.${layer}_opacity -from 0 -to 100 \
Note: See TracChangeset
for help on using the changeset viewer.