Context Navigation

source: trunk/gui/scripts/mapviewer.tcl @ 4576

Last change on this file since 4576 was 4576, checked in by ldelgass, 10 years ago
Update client to handle new server protocol (map coords returns srs info, new screen coords reply). Also, in map XML parser, if profile is set to "geodetic" with no extents, convert to "global-geodetic" named profile.
File size: 67.8 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: mapviewer - Map object viewer
4	#
5	# It connects to the GeoVis server running on a rendering farm,
6	# transmits data, and displays the results.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15	package require BLT
16	#package require Img
17
18	option add *MapViewer.width 4i widgetDefault
19	option add MapViewercursor crosshair widgetDefault
20	option add *MapViewer.height 4i widgetDefault
21	option add *MapViewer.foreground black widgetDefault
22	option add *MapViewer.controlBackground gray widgetDefault
23	option add *MapViewer.controlDarkBackground #999999 widgetDefault
24	option add *MapViewer.plotBackground black widgetDefault
25	option add *MapViewer.plotForeground white widgetDefault
26	option add *MapViewer.font \
27	--helvetica-medium-r-normal--12-* widgetDefault
28
29	# must use this name -- plugs into Rappture::resources::load
30	proc MapViewer_init_resources {} {
31	Rappture::resources::register \
32	geovis_server Rappture::MapViewer::SetServerList
33	}
34
35	itcl::class Rappture::MapViewer {
36	inherit Rappture::VisViewer
37
38	itk_option define -plotforeground plotForeground Foreground ""
39	itk_option define -plotbackground plotBackground Background ""
40
41	private variable _layersFrame ""; # Name of layers frame widget
42	private variable _mapsettings; # Global map settings
43
44	constructor { hostlist args } {
45	Rappture::VisViewer::constructor $hostlist
46	} {
47	# defined below
48	}
49	destructor {
50	# defined below
51	}
52	public proc SetServerList { namelist } {
53	Rappture::VisViewer::SetServerList "geovis" $namelist
54	}
55	public method add {dataobj {settings ""}}
56	public method camera {option args}
57	public method delete {args}
58	public method disconnect {}
59	public method download {option args}
60	public method get {args}
61	public method isconnected {}
62	public method limits { colormap }
63	public method parameters {title args} {
64	# do nothing
65	}
66	public method scale {args}
67
68	protected method AdjustSetting {what {value ""}}
69	protected method Connect {}
70	protected method CurrentLayers {args}
71	protected method Disconnect {}
72	protected method DoResize {}
73	protected method DoRotate {}
74	protected method InitSettings { args }
75	protected method KeyPress { key }
76	protected method KeyRelease { key }
77	protected method MouseClick { button x y }
78	protected method MouseDoubleClick { button x y }
79	protected method MouseDrag { button x y }
80	protected method MouseMotion {}
81	protected method MouseRelease { button x y }
82	protected method MouseScroll { direction }
83	protected method Pan {option x y}
84	protected method Rebuild {}
85	protected method ReceiveMapInfo { args }
86	protected method ReceiveScreenInfo { args }
87	protected method ReceiveImage { args }
88	protected method Rotate {option x y}
89	protected method Zoom {option {x 0} {y 0}}
90
91	# The following methods are only used by this class.
92	private method BuildCameraTab {}
93	private method BuildDownloadPopup { widget command }
94	private method BuildLayerTab {}
95	private method BuildTerrainTab {}
96	private method ChangeLayerVisibility { dataobj layer }
97	private method EventuallyHandleMotionEvent { x y }
98	private method EventuallyResize { w h }
99	private method EventuallyRotate { dx dy }
100	private method GetImage { args }
101	private method GetNormalizedMouse { x y }
102	private method MapIsGeocentric {}
103	private method SetLayerStyle { dataobj layer }
104	private method SetTerrainStyle { style }
105	private method SetOpacity { dataset }
106	private method UpdateLayerControls {}
107	private method EarthFile {}
108
109	private variable _dlist ""; # list of data objects
110	private variable _obj2datasets
111	private variable _obj2ovride; # maps dataobj => style override
112	private variable _layers; # Contains the names of all the
113	# layer in the server.
114	private variable _click; # info used for rotate operations
115	private variable _view; # view params for 3D view
116	private variable _settings
117	private variable _visibility
118	private variable _style; # Array of current component styles.
119	private variable _initialStyle; # Array of initial component styles.
120	private variable _reset 1; # Indicates that server was reset and
121	# needs to be reinitialized.
122	private variable _initCamera 1;
123	private variable _haveTerrain 0
124
125	private variable _first "" ;# This is the topmost dataset.
126	private variable _start 0
127	private variable _title ""
128
129	common _downloadPopup ;# download options from popup
130	private common _hardcopy
131	private variable _width 0
132	private variable _height 0
133	private variable _resizePending 0
134	private variable _rotatePending 0
135	private variable _rotateDelay 150
136	private variable _motion
137	private variable _sendEarthFile 0
138	private variable _useServerManip 0
139	}
140
141	itk::usual MapViewer {
142	keep -background -foreground -cursor -font
143	keep -plotbackground -plotforeground
144	}
145
146	# ----------------------------------------------------------------------
147	# CONSTRUCTOR
148	# ----------------------------------------------------------------------
149	itcl::body Rappture::MapViewer::constructor {hostlist args} {
150	set _serverType "geovis"
151
152	if { [catch {
153
154	# Rebuild event
155	$_dispatcher register !rebuild
156	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
157
158	# Resize event
159	$_dispatcher register !resize
160	$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
161
162	# Rotate event
163	$_dispatcher register !rotate
164	$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
165
166	# <Motion> event
167	$_dispatcher register !motion
168	$_dispatcher dispatch $this !motion "[itcl::code $this MouseMotion]; list"
169
170	#
171	# Populate parser with commands handle incoming requests
172	#
173	$_parser alias image [itcl::code $this ReceiveImage]
174	$_parser alias map [itcl::code $this ReceiveMapInfo]
175	$_parser alias camera [itcl::code $this camera]
176	$_parser alias screen [itcl::code $this ReceiveScreenInfo]
177
178	# Settings for mouse motion events: these are required
179	# to update the Lat/Long coordinate display
180	array set _motion {
181	compress 0
182	delay 100
183	enable 0
184	pending 0
185	x 0
186	y 0
187	}
188	# This array holds the Viewpoint parameters that the
189	# server sends on "camera get".
190	array set _view {
191	distance 1.0
192	heading 0.0
193	pitch -89.9
194	srs ""
195	verticalDatum ""
196	x 0.0
197	y 0.0
198	z 0.0
199	}
200
201	# Note: grid types are "geodetic", "utm" and "mgrs"
202	# Currently only work in geocentric maps
203	array set _settings [subst {
204	camera-throw 0
205	coords-precision 5
206	coords-units "latlong_decimal_degrees"
207	coords-visible 1
208	grid 0
209	grid-type "geodetic"
210	legend 1
211	terrain-edges 0
212	terrain-lighting 0
213	terrain-vertscale 1.0
214	terrain-wireframe 0
215	}]
216	itk_component add view {
217	canvas $itk_component(plotarea).view \
218	-highlightthickness 0 -borderwidth 0
219	} {
220	usual
221	ignore -highlightthickness -borderwidth -background
222	}
223
224	set c $itk_component(view)
225	#bind $c <KeyPress-Left> [list %W xview scroll 10 units]
226	#bind $c <KeyPress-Right> [list %W xview scroll -10 units]
227	#bind $c <KeyPress-Up> [list %W yview scroll 10 units]
228	#bind $c <KeyPress-Down> [list %W yview scroll -10 units]
229	bind $c <Enter> "focus %W"
230	bind $c <Control-F1> [itcl::code $this ToggleConsole]
231
232	# Fix the scrollregion in case we go off screen
233	$c configure -scrollregion [$c bbox all]
234
235	set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
236	set _map(cwidth) -1
237	set _map(cheight) -1
238	set _map(zoom) 1.0
239	set _map(original) ""
240
241	set f [$itk_component(main) component controls]
242	itk_component add reset {
243	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
244	-highlightthickness 0 \
245	-image [Rappture::icon reset-view] \
246	-command [itcl::code $this camera reset]
247	} {
248	usual
249	ignore -highlightthickness
250	}
251	pack $itk_component(reset) -side top -padx 2 -pady 2
252	Rappture::Tooltip::for $itk_component(reset) \
253	"Reset the view to the default zoom level"
254
255	itk_component add zoomin {
256	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
257	-highlightthickness 0 \
258	-image [Rappture::icon zoom-in] \
259	-command [itcl::code $this Zoom in]
260	} {
261	usual
262	ignore -highlightthickness
263	}
264	pack $itk_component(zoomin) -side top -padx 2 -pady 2
265	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
266
267	itk_component add zoomout {
268	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
269	-highlightthickness 0 \
270	-image [Rappture::icon zoom-out] \
271	-command [itcl::code $this Zoom out]
272	} {
273	usual
274	ignore -highlightthickness
275	}
276	pack $itk_component(zoomout) -side top -padx 2 -pady 2
277	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
278
279	BuildLayerTab
280	BuildTerrainTab
281	BuildCameraTab
282
283	# Legend
284
285	set _image(legend) [image create photo]
286	itk_component add legend {
287	canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
288	} {
289	usual
290	ignore -highlightthickness
291	rename -background -plotbackground plotBackground Background
292	}
293
294	# Hack around the Tk panewindow. The problem is that the requested
295	# size of the 3d view isn't set until an image is retrieved from
296	# the server. So the panewindow uses the tiny size.
297	set w 10000
298	pack forget $itk_component(view)
299	blt::table $itk_component(plotarea) \
300	0,0 $itk_component(view) -fill both -reqwidth $w
301	blt::table configure $itk_component(plotarea) c1 -resize none
302
303	bind $itk_component(view) <Configure> \
304	[itcl::code $this EventuallyResize %w %h]
305
306	if {$_useServerManip} {
307	# Bindings for keyboard events
308	bind $itk_component(view) <KeyPress> \
309	[itcl::code $this KeyPress %N]
310	bind $itk_component(view) <KeyRelease> \
311	[itcl::code $this KeyRelease %N]
312
313	# Bindings for rotation via mouse
314	bind $itk_component(view) <ButtonPress-1> \
315	[itcl::code $this MouseClick 1 %x %y]
316	bind $itk_component(view) <Double-1> \
317	[itcl::code $this MouseDoubleClick 1 %x %y]
318	bind $itk_component(view) <B1-Motion> \
319	[itcl::code $this MouseDrag 1 %x %y]
320	bind $itk_component(view) <ButtonRelease-1> \
321	[itcl::code $this MouseRelease 1 %x %y]
322
323	# Bindings for panning via mouse
324	bind $itk_component(view) <ButtonPress-2> \
325	[itcl::code $this MouseClick 2 %x %y]
326	bind $itk_component(view) <Double-2> \
327	[itcl::code $this MouseDoubleClick 2 %x %y]
328	bind $itk_component(view) <B2-Motion> \
329	[itcl::code $this MouseDrag 2 %x %y]
330	bind $itk_component(view) <ButtonRelease-2> \
331	[itcl::code $this MouseRelease 2 %x %y]
332
333	bind $itk_component(view) <ButtonPress-3> \
334	[itcl::code $this MouseClick 3 %x %y]
335	bind $itk_component(view) <Double-3> \
336	[itcl::code $this MouseDoubleClick 3 %x %y]
337	bind $itk_component(view) <B3-Motion> \
338	[itcl::code $this MouseDrag 3 %x %y]
339	bind $itk_component(view) <ButtonRelease-3> \
340	[itcl::code $this MouseRelease 3 %x %y]
341
342	# Binding for mouse motion events
343	if {$_motion(enable)} {
344	bind $itk_component(view) <Motion> \
345	[itcl::code $this EventuallyHandleMotionEvent %x %y]
346	}
347	} else {
348	# Bindings for panning via mouse
349	bind $itk_component(view) <ButtonPress-1> \
350	[itcl::code $this Pan click %x %y]
351	bind $itk_component(view) <B1-Motion> \
352	[itcl::code $this Pan drag %x %y]
353	bind $itk_component(view) <ButtonRelease-1> \
354	[itcl::code $this Pan release %x %y]
355	bind $itk_component(view) <Button-1> \
356	+[itcl::code $this SendCmd "map setpos %x %y"]
357	bind $itk_component(view) <Double-1> \
358	[itcl::code $this camera go %x %y 0.4]
359
360	# Bindings for rotation via mouse
361	bind $itk_component(view) <ButtonPress-2> \
362	[itcl::code $this Rotate click %x %y]
363	bind $itk_component(view) <B2-Motion> \
364	[itcl::code $this Rotate drag %x %y]
365	bind $itk_component(view) <ButtonRelease-2> \
366	[itcl::code $this Rotate release %x %y]
367
368	# Bindings for zoom via mouse
369	bind $itk_component(view) <ButtonPress-3> \
370	[itcl::code $this Zoom click %x %y]
371	bind $itk_component(view) <B3-Motion> \
372	[itcl::code $this Zoom drag %x %y]
373	bind $itk_component(view) <ButtonRelease-3> \
374	[itcl::code $this Zoom release %x %y]
375	bind $itk_component(view) <Double-3> \
376	[itcl::code $this camera go %x %y 2.5]
377	bind $itk_component(view) <Double-3> \
378	+[itcl::code $this SendCmd "map setpos %x %y"]
379
380	# Bindings for panning via keyboard
381	bind $itk_component(view) <KeyPress-Left> \
382	[itcl::code $this Pan set 10 0]
383	bind $itk_component(view) <KeyPress-Right> \
384	[itcl::code $this Pan set -10 0]
385	bind $itk_component(view) <KeyPress-Up> \
386	[itcl::code $this Pan set 0 -10]
387	bind $itk_component(view) <KeyPress-Down> \
388	[itcl::code $this Pan set 0 10]
389
390	# Binding for mouse motion events
391	set _motion(compress) 1
392	if {$_motion(enable)} {
393	bind $itk_component(view) <Motion> \
394	[itcl::code $this EventuallyHandleMotionEvent %x %y]
395	}
396	}
397
398	bind $itk_component(view) <Shift-KeyPress-Left> \
399	[itcl::code $this Pan set 2 0]
400	bind $itk_component(view) <Shift-KeyPress-Right> \
401	[itcl::code $this Pan set -2 0]
402	bind $itk_component(view) <Shift-KeyPress-Up> \
403	[itcl::code $this Pan set 0 -2]
404	bind $itk_component(view) <Shift-KeyPress-Down> \
405	[itcl::code $this Pan set 0 2]
406
407	# Bindings for zoom via keyboard
408	bind $itk_component(view) <KeyPress-Prior> \
409	[itcl::code $this Zoom out]
410	bind $itk_component(view) <KeyPress-Next> \
411	[itcl::code $this Zoom in]
412
413	bind $itk_component(view) <Enter> "focus $itk_component(view)"
414
415	if {[string equal "x11" [tk windowingsystem]]} {
416	# Bindings for zoom via mouse
417	if {$_useServerManip} {
418	bind $itk_component(view) <4> [itcl::code $this MouseScroll up]
419	bind $itk_component(view) <5> [itcl::code $this MouseScroll down]
420	} else {
421	bind $itk_component(view) <4> [itcl::code $this Zoom out]
422	bind $itk_component(view) <5> [itcl::code $this Zoom in]
423	}
424	}
425
426	set _image(download) [image create photo]
427
428	eval itk_initialize $args
429	Connect
430	} errs] != 0 } {
431	puts stderr errs=$errs
432	}
433	}
434
435	# ----------------------------------------------------------------------
436	# DESTRUCTOR
437	# ----------------------------------------------------------------------
438	itcl::body Rappture::MapViewer::destructor {} {
439	Disconnect
440	$_dispatcher cancel !rebuild
441	$_dispatcher cancel !resize
442	$_dispatcher cancel !rotate
443	image delete $_image(plot)
444	image delete $_image(download)
445	}
446
447	itcl::body Rappture::MapViewer::DoResize {} {
448	set sendResize 1
449	if { $_width < 2 } {
450	set _width 500
451	set sendResize 0
452	}
453	if { $_height < 2 } {
454	set _height 500
455	set sendResize 0
456	}
457	set _start [clock clicks -milliseconds]
458	if {$sendResize} {
459	SendCmd "screen size $_width $_height"
460	}
461	set _resizePending 0
462	}
463
464	itcl::body Rappture::MapViewer::DoRotate {} {
465	SendCmd "camera rotate $_view(azimuth) $_view(elevation)"
466	set _rotatePending 0
467	}
468
469	itcl::body Rappture::MapViewer::EventuallyResize { w h } {
470	set _width $w
471	set _height $h
472	if { !$_resizePending } {
473	set _resizePending 1
474	$_dispatcher event -after 200 !resize
475	}
476	}
477
478	itcl::body Rappture::MapViewer::EventuallyRotate { dx dy } {
479	set _view(azimuth) $dx
480	set _view(elevation) $dy
481	if { !$_rotatePending } {
482	set _rotatePending 1
483	$_dispatcher event -after $_rotateDelay !rotate
484	}
485	}
486
487	# ----------------------------------------------------------------------
488	# USAGE: add <dataobj> ?<settings>?
489	#
490	# Clients use this to add a data object to the plot. The optional
491	# <settings> are used to configure the plot. Allowed settings are
492	# -color, -brightness, -width, -linestyle, and -raise.
493	# ----------------------------------------------------------------------
494	itcl::body Rappture::MapViewer::add {dataobj {settings ""}} {
495	array set params {
496	-color auto
497	-width 1
498	-linestyle solid
499	-brightness 0
500	-raise 0
501	-description ""
502	-param ""
503	-type ""
504	}
505	array set params $settings
506	set params(-description) ""
507	set params(-param) ""
508	array set params $settings
509
510	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
511	# can't handle -autocolors yet
512	set params(-color) black
513	}
514	set pos [lsearch -exact $_dlist $dataobj]
515	if {$pos < 0} {
516	#if {[llength $_dlist] > 0} {
517	# error "Can't add more than 1 map to mapviewer"
518	#}
519	lappend _dlist $dataobj
520	}
521	set _obj2ovride($dataobj-color) $params(-color)
522	set _obj2ovride($dataobj-width) $params(-width)
523	set _obj2ovride($dataobj-raise) $params(-raise)
524	$_dispatcher event -idle !rebuild
525	}
526
527	# ----------------------------------------------------------------------
528	# USAGE: delete ?<dataobj1> <dataobj2> ...?
529	#
530	# Clients use this to delete a dataobj from the plot. If no dataobjs
531	# are specified, then all dataobjs are deleted. No data objects are
532	# deleted. They are only removed from the display list.
533	#
534	# ----------------------------------------------------------------------
535	itcl::body Rappture::MapViewer::delete {args} {
536	if { [llength $args] == 0} {
537	set args $_dlist
538	}
539	# Delete all specified dataobjs
540	set changed 0
541	foreach dataobj $args {
542	set pos [lsearch -exact $_dlist $dataobj]
543	if { $pos < 0 } {
544	continue; # Don't know anything about it.
545	}
546	# When a map is marked deleted, we hide its layers.
547	foreach layer [$dataobj layers] {
548	SendCmd "map layer visible 0 $layer"
549	set _visibility($layer) 0
550	}
551	# Remove it from the dataobj list.
552	set _dlist [lreplace $_dlist $pos $pos]
553	array unset _obj2ovride $dataobj-*
554	array unset _settings $dataobj-*
555	set changed 1
556	}
557	# If anything changed, then rebuild the plot
558	if { $changed } {
559	$_dispatcher event -idle !rebuild
560	}
561	}
562
563	# ----------------------------------------------------------------------
564	# USAGE: get ?-objects?
565	# USAGE: get ?-visible?
566	# USAGE: get ?-image view?
567	#
568	# Clients use this to query the list of objects being plotted, in
569	# order from bottom to top of this result. The optional "-image"
570	# flag can also request the internal images being shown.
571	# ----------------------------------------------------------------------
572	itcl::body Rappture::MapViewer::get {args} {
573	if {[llength $args] == 0} {
574	set args "-objects"
575	}
576
577	set op [lindex $args 0]
578	switch -- $op {
579	"-objects" {
580	# put the dataobj list in order according to -raise options
581	set dlist {}
582	foreach dataobj $_dlist {
583	if { ![$dataobj isvalid] } {
584	continue
585	}
586	if {[info exists _obj2ovride($dataobj-raise)] &&
587	$_obj2ovride($dataobj-raise)} {
588	set dlist [linsert $dlist 0 $dataobj]
589	} else {
590	lappend dlist $dataobj
591	}
592	}
593	return $dlist
594	}
595	"-visible" {
596	set dlist {}
597	foreach dataobj $_dlist {
598	if { ![$dataobj isvalid] } {
599	continue
600	}
601	if { ![info exists _obj2ovride($dataobj-raise)] } {
602	# No setting indicates that the object isn't visible.
603	continue
604	}
605	# Otherwise use the -raise parameter to put the object to
606	# the front of the list.
607	if { $_obj2ovride($dataobj-raise) } {
608	set dlist [linsert $dlist 0 $dataobj]
609	} else {
610	lappend dlist $dataobj
611	}
612	}
613	return $dlist
614	}
615	-image {
616	if {[llength $args] != 2} {
617	error "wrong # args: should be \"get -image view\""
618	}
619	switch -- [lindex $args end] {
620	view {
621	return $_image(plot)
622	}
623	default {
624	error "bad image name \"[lindex $args end]\": should be view"
625	}
626	}
627	}
628	default {
629	error "bad option \"$op\": should be -objects or -image"
630	}
631	}
632	}
633
634	itcl::body Rappture::MapViewer::MapIsGeocentric {} {
635	if { [info exists _mapsettings(type)] } {
636	return [expr {$_mapsettings(type) eq "geocentric"}]
637	} else {
638	return 0
639	}
640	}
641
642	# ----------------------------------------------------------------------
643	# USAGE: scale ?<data1> <data2> ...?
644	#
645	# Sets the default limits for the overall plot according to the
646	# limits of the data for all of the given <data> objects. This
647	# accounts for all objects--even those not showing on the screen.
648	# Because of this, the limits are appropriate for all objects as
649	# the user scans through data in the ResultSet viewer.
650	# ----------------------------------------------------------------------
651	itcl::body Rappture::MapViewer::scale {args} {
652	array unset _mapsettings
653	set _haveTerrain 0
654
655	# Verify that all the maps have the same global settings. For example,
656	# you can't have one map type "geocentric" and the other "projected".
657
658	foreach dataobj $args {
659	if { ![$dataobj isvalid] } {
660	continue
661	}
662	array unset hints
663	array set hints [$dataobj hints]
664	if { ![info exists _mapsettings(label)] } {
665	set _mapsettings(label) $hints(label)
666	}
667	if { ![info exists _mapsettings(style)] } {
668	set _mapsettings(style) $hints(style)
669	}
670	if { ![info exists _mapsettings(type)] } {
671	set _mapsettings(type) $hints(type)
672	} elseif { $hints(type) != $_mapsettings(type) } {
673	error "maps \"$hints(label)\" have differing types"
674	}
675	if { ![info exists _mapsettings(projection)] } {
676	set _mapsettings(projection) $hints(projection)
677	} elseif { $hints(projection) != $_mapsettings(projection) } {
678	error "maps \"$hints(label)\" have differing projections"
679	}
680	if { $hints(extents) != "" } {
681	if { ![info exists _mapsettings(extents)] } {
682	set _mapsettings(extents) $hints(extents)
683	}
684	foreach {x1 y1 x2 y2} $hints(extents) break
685	if { ![info exists _mapsettings(x1)] \|\| $x1 < $_mapsettings(x1) } {
686	set _mapsettings(x1) $x1
687	}
688	if { ![info exists _mapsettings(y1)] \|\| $y1 < $_mapsettings(y1) } {
689	set _mapsettings(y1) $y1
690	}
691	if { ![info exists _mapsettings(x2)] \|\| $x2 > $_mapsettings(x2) } {
692	set _mapsettings(x2) $x2
693	}
694	if { ![info exists _mapsettings(y2)] \|\| $y2 > $_mapsettings(y2) } {
695	set _mapsettings(y2) $y2
696	}
697	}
698	foreach layer [$dataobj layers] {
699	if { [$dataobj type $layer] == "elevation" } {
700	set _haveTerrain 1
701	break
702	}
703	}
704	}
705	if { $_haveTerrain } {
706	if { [$itk_component(main) exists "Terrain Settings"] } {
707	# TODO: Enable controls like vertical scale that only have
708	# an effect when terrain is present
709	}
710	}
711	}
712
713	# ----------------------------------------------------------------------
714	# USAGE: download coming
715	# USAGE: download controls <downloadCommand>
716	# USAGE: download now
717	#
718	# Clients use this method to create a downloadable representation
719	# of the plot. Returns a list of the form {ext string}, where
720	# "ext" is the file extension (indicating the type of data) and
721	# "string" is the data itself.
722	# ----------------------------------------------------------------------
723	itcl::body Rappture::MapViewer::download {option args} {
724	switch $option {
725	coming {
726	if {[catch {
727	blt::winop snap $itk_component(plotarea) $_image(download)
728	}]} {
729	$_image(download) configure -width 1 -height 1
730	$_image(download) put #000000
731	}
732	}
733	controls {
734	set popup .mapviewerdownload
735	if { ![winfo exists .mapviewerdownload] } {
736	set inner [BuildDownloadPopup $popup [lindex $args 0]]
737	} else {
738	set inner [$popup component inner]
739	}
740	set _downloadPopup(image_controls) $inner.image_frame
741	set num [llength [get]]
742	set num [expr {($num == 1) ? "1 result" : "$num results"}]
743	set word [Rappture::filexfer::label downloadWord]
744	$inner.summary configure -text "$word $num in the following format:"
745	update idletasks ;# Fix initial sizes
746	return $popup
747	}
748	now {
749	set popup .mapviewerdownload
750	if {[winfo exists .mapviewerdownload]} {
751	$popup deactivate
752	}
753	switch -- $_downloadPopup(format) {
754	"image" {
755	return [$this GetImage [lindex $args 0]]
756	}
757	}
758	return ""
759	}
760	default {
761	error "bad option \"$option\": should be coming, controls, now"
762	}
763	}
764	}
765
766	# ----------------------------------------------------------------------
767	# USAGE: Connect ?<host:port>,<host:port>...?
768	#
769	# Clients use this method to establish a connection to a new
770	# server, or to reestablish a connection to the previous server.
771	# Any existing connection is automatically closed.
772	# ----------------------------------------------------------------------
773	itcl::body Rappture::MapViewer::Connect {} {
774	global readyForNextFrame
775	set readyForNextFrame 1
776	set _reset 1
777	set _hosts [GetServerList "geovis"]
778	if { "" == $_hosts } {
779	return 0
780	}
781	set result [VisViewer::Connect $_hosts]
782	if { $result } {
783	if { $_reportClientInfo } {
784	# Tell the server the viewer, hub, user and session.
785	# Do this immediately on connect before buffering any commands
786	global env
787
788	set info {}
789	set user "???"
790	if { [info exists env(USER)] } {
791	set user $env(USER)
792	}
793	set session "???"
794	if { [info exists env(SESSION)] } {
795	set session $env(SESSION)
796	}
797	lappend info "hub" [exec hostname]
798	lappend info "client" "mapviewer"
799	lappend info "user" $user
800	lappend info "session" $session
801	SendCmd "clientinfo [list $info]"
802	}
803
804	set w [winfo width $itk_component(view)]
805	set h [winfo height $itk_component(view)]
806	EventuallyResize $w $h
807	}
808	return $result
809	}
810
811	#
812	# isconnected --
813	#
814	# Indicates if we are currently connected to the visualization server.
815	#
816	itcl::body Rappture::MapViewer::isconnected {} {
817	return [VisViewer::IsConnected]
818	}
819
820	#
821	# disconnect --
822	#
823	itcl::body Rappture::MapViewer::disconnect {} {
824	Disconnect
825	set _reset 1
826	}
827
828	#
829	# Disconnect --
830	#
831	# Clients use this method to disconnect from the current rendering
832	# server.
833	#
834	itcl::body Rappture::MapViewer::Disconnect {} {
835	VisViewer::Disconnect
836
837	$_dispatcher cancel !rebuild
838	$_dispatcher cancel !resize
839	$_dispatcher cancel !rotate
840	$_dispatcher cancel !motion
841	# disconnected -- no more data sitting on server
842	array unset _layers
843	array unset _layersFrame
844	global readyForNextFrame
845	set readyForNextFrame 1
846	}
847
848	# ----------------------------------------------------------------------
849	# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
850	#
851	# Invoked automatically whenever the "image" command comes in from
852	# the rendering server. Indicates that binary image data with the
853	# specified <size> will follow.
854	# ----------------------------------------------------------------------
855	itcl::body Rappture::MapViewer::ReceiveImage { args } {
856	global readyForNextFrame
857	set readyForNextFrame 1
858	array set info {
859	-token "???"
860	-bytes 0
861	-type image
862	}
863	array set info $args
864	set bytes [ReceiveBytes $info(-bytes)]
865	if { $info(-type) == "image" } {
866	$_image(plot) configure -data $bytes
867	} elseif { $info(type) == "print" } {
868	set tag $this-print-$info(-token)
869	set _hardcopy($tag) $bytes
870	}
871	}
872
873	#
874	# ReceiveMapInfo --
875	#
876	itcl::body Rappture::MapViewer::ReceiveMapInfo { args } {
877	if { ![isconnected] } {
878	return
879	}
880	set option [lindex $args 0]
881	switch -- $option {
882	"coords" {
883	set len [llength $args]
884	if {$len < 4} {
885	puts stderr "Coords out of range"
886	} elseif {$len < 6} {
887	foreach { x y z } [lrange $args 1 end] break
888	puts stderr "Coords: $x $y $z"
889	} elseif {$len < 7} {
890	foreach { x y z screenX screenY } [lrange $args 1 end] break
891	puts stderr "Coords($screenX,$screenY): $x $y $z"
892	} else {
893	foreach { x y z screenX screenY srs vert } [lrange $args 1 end] break
894	puts stderr "Coords($screenX,$screenY): $x $y $z {$srs} {$vert}"
895	}
896	}
897	"names" {
898	foreach { name } [lindex $args 1] {
899	puts stderr "layer: $name"
900	}
901	}
902	default {
903	error "unknown map option \"$option\" from server"
904	}
905	}
906	}
907
908	#
909	# ReceiveScreenInfo --
910	#
911	itcl::body Rappture::MapViewer::ReceiveScreenInfo { args } {
912	if { ![isconnected] } {
913	return
914	}
915	set option [lindex $args 0]
916	switch -- $option {
917	"coords" {
918	set len [llength $args]
919	if {$len == 5} {
920	puts stderr "Screen Coords out of range"
921	} else {
922	foreach { x y z worldX worldY worldZ } [lrange $args 1 end] break
923	puts stderr "Coords($worldX,$worldY,$worldZ): $x $y $z"
924	}
925	}
926	default {
927	error "unknown screen option \"$option\" from server"
928	}
929	}
930	}
931
932	# ----------------------------------------------------------------------
933	# USAGE: Rebuild
934	#
935	# Called automatically whenever something changes that affects the
936	# data in the widget. Clears any existing data and rebuilds the
937	# widget to display new data.
938	# ----------------------------------------------------------------------
939	itcl::body Rappture::MapViewer::Rebuild {} {
940	set w [winfo width $itk_component(view)]
941	set h [winfo height $itk_component(view)]
942	if { $w < 2 \|\| $h < 2 } {
943	$_dispatcher event -idle !rebuild
944	return
945	}
946
947	# Turn on buffering of commands to the server. We don't want to be
948	# preempted by a server disconnect/reconnect (which automatically
949	# generates a new call to Rebuild).
950	StartBufferingCommands
951
952	if { $_reset } {
953	set _width $w
954	set _height $h
955	DoResize
956
957	if { [info exists _mapsettings(type)] } {
958	# The map must be reset once before any layers are added This
959	# should not be done more than once as it is very expensive.
960	if {$_sendEarthFile} {
961	set bytes [EarthFile]
962	if {0} {
963	set f [open "/tmp/map.earth" "w"]
964	puts $f $bytes
965	close $f
966	}
967	set length [string length $bytes]
968	SendCmd "map load data follows $length"
969	append _outbuf $bytes
970	} else {
971	if { $_mapsettings(type) == "geocentric" } {
972	SendCmd "map reset geocentric"
973	} else {
974	set proj $_mapsettings(projection)
975	if { $proj == "" } {
976	SendCmd "map reset projected global-mercator"
977	} elseif { ![info exists _mapsettings(extents)] \|\| $_mapsettings(extents) == "" } {
978	SendCmd [list map reset "projected" $proj]
979	} else {
980	#foreach {x1 y1 x2 y2} $_mapsettings(extents) break
981	foreach key "x1 y1 x2 y2" {
982	set $key $_mapsettings($key)
983	}
984	SendCmd [list map reset "projected" $proj $x1 $y1 $x2 $y2]
985	}
986	}
987	# XXX: Remove these after implementing batch load of layers with reset
988	SendCmd "map layer delete base"
989	}
990
991	# Most terrain settings are global to the map and apply even
992	# if there is no elevation layer. The exception is the
993	# vertical scale, which only applies if there is an elevation
994	# layer
995	if { [info exists _mapsettings(style)] } {
996	SetTerrainStyle $_mapsettings(style)
997	} else {
998	InitSettings terrain-edges terrain-lighting \
999	terrain-vertscale terrain-wireframe
1000	}
1001	InitSettings coords-visible
1002	} else {
1003	error "No map settings on reset"
1004	}
1005	}
1006
1007	set _first ""
1008	set count 0
1009
1010	foreach dataobj [get -objects] {
1011	set _obj2datasets($dataobj) ""
1012	foreach layer [$dataobj layers] {
1013	array unset info
1014	array set info [$dataobj layer $layer]
1015	if { ![info exists _layers($layer)] } {
1016	if { $_reportClientInfo } {
1017	set cinfo {}
1018	lappend cinfo "tool_id" [$dataobj hints toolId]
1019	lappend cinfo "tool_name" [$dataobj hints toolName]
1020	lappend cinfo "tool_version" [$dataobj hints toolRevision]
1021	lappend cinfo "tool_title" [$dataobj hints toolTitle]
1022	lappend cinfo "dataset_label" [$dataobj hints label]
1023	lappend cinfo "dataset_tag" $layer
1024	SendCmd [list "clientinfo" $cinfo]
1025	}
1026	set _layers($layer) 1
1027	SetLayerStyle $dataobj $layer
1028	}
1029	lappend _obj2datasets($dataobj) $layer
1030	# FIXME: This is overriding all layers' initial visibility setting
1031	if { [info exists _obj2ovride($dataobj-raise)] } {
1032	SendCmd "map layer visible 1 $layer"
1033	set _visibility($layer) 1
1034	#SetLayerOpacity $layer
1035	}
1036	}
1037	}
1038
1039	if {$_reset} {
1040	if {$_initCamera} {
1041	# If this is the first Rebuild, we need to
1042	# set up the initial view settings if there
1043	# are any
1044	if { [info exists _mapsettings(camera)] } {
1045	set location $_mapsettings(camera)
1046	if { $location != "" } {
1047	array set _view $location
1048	camera set all
1049	}
1050	}
1051	set _initCamera 0
1052	} else {
1053	# Restore view from before reconnect
1054	camera set all
1055	}
1056	}
1057
1058	UpdateLayerControls
1059	set _reset 0
1060	global readyForNextFrame
1061	set readyForNextFrame 0; # Don't advance to the next frame
1062	# until we get an image.
1063
1064	# Actually write the commands to the server socket. If it fails, we
1065	# don't care. We're finished here.
1066	blt::busy hold $itk_component(hull)
1067	StopBufferingCommands
1068	blt::busy release $itk_component(hull)
1069	}
1070
1071	# ----------------------------------------------------------------------
1072	# USAGE: CurrentLayers ?-all -visible? ?dataobjs?
1073	#
1074	# Returns a list of server IDs for the current datasets being displayed.
1075	# This is normally a single ID, but it might be a list of IDs if the
1076	# current data object has multiple components.
1077	# ----------------------------------------------------------------------
1078	itcl::body Rappture::MapViewer::CurrentLayers {args} {
1079	set flag [lindex $args 0]
1080	switch -- $flag {
1081	"-all" {
1082	if { [llength $args] > 1 } {
1083	error "CurrentLayers: can't specify dataobj after \"-all\""
1084	}
1085	set dlist [get -objects]
1086	}
1087	"-visible" {
1088	if { [llength $args] > 1 } {
1089	set dlist {}
1090	set args [lrange $args 1 end]
1091	foreach dataobj $args {
1092	if { [info exists _obj2ovride($dataobj-raise)] } {
1093	lappend dlist $dataobj
1094	}
1095	}
1096	} else {
1097	set dlist [get -visible]
1098	}
1099	}
1100	default {
1101	set dlist $args
1102	}
1103	}
1104	set rlist ""
1105	foreach dataobj $dlist {
1106	foreach layer [$dataobj layers] {
1107	if { [info exists _layers($layer)] && $_layers($layer) } {
1108	lappend rlist $layer
1109	}
1110	}
1111	}
1112	return $rlist
1113	}
1114
1115	itcl::body Rappture::MapViewer::KeyPress {k} {
1116	SendCmd "key press $k"
1117	}
1118
1119	itcl::body Rappture::MapViewer::KeyRelease {k} {
1120	SendCmd "key release $k"
1121	}
1122
1123	itcl::body Rappture::MapViewer::GetNormalizedMouse {x y} {
1124	set w [winfo width $itk_component(view)]
1125	set h [winfo height $itk_component(view)]
1126	set x [expr {(2.0 * double($x)/$w) - 1.0}]
1127	set y [expr {(2.0 * double($y)/$h) - 1.0}]
1128	return [list $x $y]
1129	}
1130
1131	itcl::body Rappture::MapViewer::MouseClick {button x y} {
1132	SendCmd "mouse click $button $x $y"
1133	}
1134
1135	itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1136	SendCmd "mouse dblclick $button $x $y"
1137	}
1138
1139	itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1140	SendCmd "mouse drag $button $x $y"
1141	}
1142
1143	itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1144	SendCmd "mouse release $button $x $y"
1145	}
1146
1147	itcl::body Rappture::MapViewer::MouseMotion {} {
1148	SendCmd "mouse motion $_motion(x) $_motion(y)"
1149	set _motion(pending) 0
1150	}
1151
1152	itcl::body Rappture::MapViewer::MouseScroll {direction} {
1153	switch -- $direction {
1154	"up" {
1155	SendCmd "mouse scroll 1"
1156	}
1157	"down" {
1158	SendCmd "mouse scroll -1"
1159	}
1160	}
1161	}
1162
1163	#
1164	# EventuallyHandleMotionEvent --
1165	#
1166	# This routine compresses (no button press) motion events. It
1167	# delivers a server mouse command once every 100 milliseconds (if a
1168	# motion event is pending).
1169	#
1170	itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1171	set _motion(x) $x
1172	set _motion(y) $y
1173	if { !$_motion(compress) } {
1174	MouseMotion
1175	return
1176	}
1177	if { !$_motion(pending) } {
1178	set _motion(pending) 1
1179	$_dispatcher event -after $_motion(delay) !motion
1180	}
1181	}
1182
1183	# ----------------------------------------------------------------------
1184	# USAGE: Zoom in
1185	# USAGE: Zoom out
1186	# USAGE: Zoom reset
1187	# $this Zoom click x y
1188	# $this Zoom drag x y
1189	# $this Zoom release x y
1190	#
1191	# Called automatically when the user clicks on one of the zoom
1192	# controls for this widget. Changes the zoom for the current view.
1193	# Also implements mouse zoom.
1194	# ----------------------------------------------------------------------
1195	itcl::body Rappture::MapViewer::Zoom {option {x 0} {y 0}} {
1196	switch -- $option {
1197	"in" {
1198	# z here is normalized mouse Y delta
1199	set z -0.25
1200	SendCmd "camera zoom $z"
1201	}
1202	"out" {
1203	# z here is normalized mouse Y delta
1204	set z 0.25
1205	SendCmd "camera zoom $z"
1206	}
1207	"reset" {
1208	SendCmd "camera dist $_view(distance)"
1209	}
1210	"click" {
1211	set _click(x) $x
1212	set _click(y) $y
1213	$itk_component(view) configure -cursor hand1
1214	}
1215	"drag" {
1216	if { ![info exists _click(x)] } {
1217	set _click(x) $x
1218	}
1219	if { ![info exists _click(y)] } {
1220	set _click(y) $y
1221	}
1222	set h [winfo height $itk_component(view)]
1223	set dy [expr ($_click(y) - $y)/double($h)]
1224	set _click(x) $x
1225	set _click(y) $y
1226	if {[expr (abs($dy) > 0.0)]} {
1227	SendCmd "camera zoom $dy"
1228	}
1229	}
1230	"release" {
1231	Zoom drag $x $y
1232	$itk_component(view) configure -cursor ""
1233	}
1234	}
1235	}
1236
1237	# ----------------------------------------------------------------------
1238	# USAGE: Rotate click <x> <y>
1239	# USAGE: Rotate drag <x> <y>
1240	# USAGE: Rotate release <x> <y>
1241	#
1242	# Called automatically when the user clicks/drags/releases in the
1243	# plot area. Moves the plot according to the user's actions.
1244	# ----------------------------------------------------------------------
1245	itcl::body Rappture::MapViewer::Rotate {option x y} {
1246	switch -- $option {
1247	"click" {
1248	$itk_component(view) configure -cursor fleur
1249	set _click(x) $x
1250	set _click(y) $y
1251	}
1252	"drag" {
1253	if {[array size _click] == 0} {
1254	Rotate click $x $y
1255	} else {
1256	set w [winfo width $itk_component(view)]
1257	set h [winfo height $itk_component(view)]
1258	if {$w <= 0 \|\| $h <= 0} {
1259	return
1260	}
1261	set dx [expr ($x - $_click(x))/double($w)]
1262	set dy [expr ($_click(y) - $y)/double($h)]
1263	set _click(x) $x
1264	set _click(y) $y
1265	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1266	SendCmd "camera rotate $dx $dy"
1267	#EventuallyRotate $dx $dy
1268	}
1269	}
1270	}
1271	"release" {
1272	Rotate drag $x $y
1273	$itk_component(view) configure -cursor ""
1274	catch {unset _click}
1275	}
1276	default {
1277	error "bad option \"$option\": should be click, drag, release"
1278	}
1279	}
1280	}
1281
1282	# ----------------------------------------------------------------------
1283	# USAGE: $this Pan set x y
1284	# $this Pan click x y
1285	# $this Pan drag x y
1286	# $this Pan release x y
1287	#
1288	# Called automatically when the user clicks on one of the zoom
1289	# controls for this widget. Changes the zoom for the current view.
1290	# ----------------------------------------------------------------------
1291	itcl::body Rappture::MapViewer::Pan {option x y} {
1292	switch -- $option {
1293	"set" {
1294	set w [winfo width $itk_component(view)]
1295	set h [winfo height $itk_component(view)]
1296	set x [expr $x / double($w)]
1297	set y [expr $y / double($h)]
1298	if {[expr (abs($x) > 0.0 \|\| abs($y) > 0.0)]} {
1299	SendCmd "camera pan $x $y"
1300	}
1301	return
1302	}
1303	"click" {
1304	set _click(x) $x
1305	set _click(y) $y
1306	$itk_component(view) configure -cursor hand1
1307	}
1308	"drag" {
1309	if { ![info exists _click(x)] } {
1310	set _click(x) $x
1311	}
1312	if { ![info exists _click(y)] } {
1313	set _click(y) $y
1314	}
1315	set w [winfo width $itk_component(view)]
1316	set h [winfo height $itk_component(view)]
1317	set dx [expr ($x - $_click(x))/double($w)]
1318	set dy [expr ($_click(y) - $y)/double($h)]
1319	set _click(x) $x
1320	set _click(y) $y
1321	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1322	SendCmd "camera pan $dx $dy"
1323	}
1324	}
1325	"release" {
1326	Pan drag $x $y
1327	$itk_component(view) configure -cursor ""
1328	}
1329	default {
1330	error "unknown option \"$option\": should set, click, drag, or release"
1331	}
1332	}
1333	}
1334
1335	# ----------------------------------------------------------------------
1336	# USAGE: InitSettings <what> ?<value>?
1337	#
1338	# Used internally to update rendering settings whenever parameters
1339	# change in the popup settings panel. Sends the new settings off
1340	# to the back end.
1341	# ----------------------------------------------------------------------
1342	itcl::body Rappture::MapViewer::InitSettings { args } {
1343	foreach setting $args {
1344	AdjustSetting $setting
1345	}
1346	}
1347
1348	#
1349	# AdjustSetting --
1350	#
1351	# Changes/updates a specific setting in the widget. There are
1352	# usually user-setable option. Commands are sent to the render
1353	# server.
1354	#
1355	itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1356	if { ![isconnected] } {
1357	return
1358	}
1359	switch -- $what {
1360	"coords-visible" - "coords-precision" - "coords-units" {
1361	set bool $_settings(coords-visible)
1362	set units $_settings(coords-units)
1363	set precision $_settings(coords-precision)
1364	SendCmd "map posdisp $bool $units $precision"
1365	}
1366	"grid" - "grid-type" {
1367	set bool $_settings(grid)
1368	set gridType $_settings(grid-type)
1369	SendCmd "map grid $bool $gridType"
1370	}
1371	"camera-throw" {
1372	set bool $_settings($what)
1373	SendCmd "camera throw $bool"
1374	}
1375	"terrain-edges" {
1376	set bool $_settings($what)
1377	SendCmd "map terrain edges $bool"
1378	}
1379	"terrain-lighting" {
1380	set bool $_settings($what)
1381	SendCmd "map terrain lighting $bool"
1382	}
1383	"terrain-palette" {
1384	set cmap [$itk_component(terrainpalette) value]
1385	#SendCmd "map terrain colormap $cmap"
1386	}
1387	"terrain-vertscale" {
1388	set val $_settings($what)
1389	SendCmd "map terrain vertscale $val"
1390	}
1391	"terrain-wireframe" {
1392	set bool $_settings($what)
1393	SendCmd "map terrain wireframe $bool"
1394	}
1395	default {
1396	error "don't know how to fix $what"
1397	}
1398	}
1399	}
1400
1401	# ----------------------------------------------------------------------
1402	# CONFIGURATION OPTION: -plotbackground
1403	# ----------------------------------------------------------------------
1404	itcl::configbody Rappture::MapViewer::plotbackground {
1405	if { [isconnected] } {
1406	foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1407	SendCmd "screen bgcolor $r $g $b"
1408	}
1409	}
1410
1411	# ----------------------------------------------------------------------
1412	# CONFIGURATION OPTION: -plotforeground
1413	# ----------------------------------------------------------------------
1414	itcl::configbody Rappture::MapViewer::plotforeground {
1415	if { [isconnected] } {
1416	foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1417	#fix this!
1418	#SendCmd "color background $r $g $b"
1419	}
1420	}
1421
1422	itcl::body Rappture::MapViewer::limits { dataobj } {
1423	error "no limits"
1424	}
1425
1426	itcl::body Rappture::MapViewer::BuildTerrainTab {} {
1427
1428	set fg [option get $itk_component(hull) font Font]
1429	#set bfg [option get $itk_component(hull) boldFont Font]
1430
1431	set inner [$itk_component(main) insert end \
1432	-title "Terrain Settings" \
1433	-icon [Rappture::icon surface]]
1434	$inner configure -borderwidth 4
1435
1436	checkbutton $inner.posdisp \
1437	-text "Show Coordinate Readout" \
1438	-variable [itcl::scope _settings(coords-visible)] \
1439	-command [itcl::code $this AdjustSetting coords-visible] \
1440	-font "Arial 9" -anchor w
1441
1442	checkbutton $inner.grid \
1443	-text "Show Graticule" \
1444	-variable [itcl::scope _settings(grid)] \
1445	-command [itcl::code $this AdjustSetting grid] \
1446	-font "Arial 9" -anchor w
1447
1448	checkbutton $inner.wireframe \
1449	-text "Show Wireframe" \
1450	-variable [itcl::scope _settings(terrain-wireframe)] \
1451	-command [itcl::code $this AdjustSetting terrain-wireframe] \
1452	-font "Arial 9" -anchor w
1453
1454	checkbutton $inner.lighting \
1455	-text "Enable Lighting" \
1456	-variable [itcl::scope _settings(terrain-lighting)] \
1457	-command [itcl::code $this AdjustSetting terrain-lighting] \
1458	-font "Arial 9" -anchor w
1459
1460	checkbutton $inner.edges \
1461	-text "Show Edges" \
1462	-variable [itcl::scope _settings(terrain-edges)] \
1463	-command [itcl::code $this AdjustSetting terrain-edges] \
1464	-font "Arial 9" -anchor w
1465
1466	label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
1467	itk_component add terrainpalette {
1468	Rappture::Combobox $inner.palette -width 10 -editable no
1469	}
1470	$inner.palette choices insert end [GetColormapList]
1471
1472	$itk_component(terrainpalette) value "BCGYR"
1473	bind $inner.palette <<Value>> \
1474	[itcl::code $this AdjustSetting terrain-palette]
1475
1476	label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
1477	::scale $inner.vscale -from 0 -to 10 -orient horizontal \
1478	-variable [itcl::scope _settings(terrain-vertscale)] \
1479	-width 10 \
1480	-resolution 0.1 \
1481	-showvalue on \
1482	-command [itcl::code $this AdjustSetting terrain-vertscale]
1483	$inner.vscale set $_settings(terrain-vertscale)
1484
1485	blt::table $inner \
1486	0,0 $inner.posdisp -cspan 2 -anchor w -pady 2 \
1487	1,0 $inner.grid -cspan 2 -anchor w -pady 2 \
1488	2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
1489	3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \
1490	4,0 $inner.edges -cspan 2 -anchor w -pady 2 \
1491	5,0 $inner.vscale_l -anchor w -pady 2 \
1492	5,1 $inner.vscale -fill x -pady 2 \
1493	6,0 $inner.palette_l -anchor w -pady 2 \
1494	6,1 $inner.palette -fill x -pady 2
1495
1496	blt::table configure $inner r* c* -resize none
1497	blt::table configure $inner r8 c1 -resize expand
1498	}
1499
1500	itcl::body Rappture::MapViewer::BuildLayerTab {} {
1501
1502	set fg [option get $itk_component(hull) font Font]
1503	#set bfg [option get $itk_component(hull) boldFont Font]
1504
1505	set inner [$itk_component(main) insert end \
1506	-title "Layers" \
1507	-icon [Rappture::icon layers]]
1508	$inner configure -borderwidth 4
1509	set f [frame $inner.layers]
1510	blt::table $inner \
1511	0,0 $f -fill both
1512	set _layersFrame $inner
1513	}
1514
1515	itcl::body Rappture::MapViewer::BuildCameraTab {} {
1516	set inner [$itk_component(main) insert end \
1517	-title "Camera Settings" \
1518	-icon [Rappture::icon camera]]
1519	$inner configure -borderwidth 4
1520
1521	set row 0
1522
1523	set labels { x y z heading pitch distance }
1524	foreach tag $labels {
1525	label $inner.${tag}label -text $tag -font "Arial 9"
1526	entry $inner.${tag} -font "Arial 9" -bg white \
1527	-textvariable [itcl::scope _view($tag)]
1528	bind $inner.${tag} <KeyPress-Return> \
1529	[itcl::code $this camera set ${tag}]
1530	bind $inner.${tag} <KP_Enter> \
1531	[itcl::code $this camera set ${tag}]
1532	blt::table $inner \
1533	$row,0 $inner.${tag}label -anchor e -pady 2 \
1534	$row,1 $inner.${tag} -anchor w -pady 2
1535	blt::table configure $inner r$row -resize none
1536	incr row
1537	}
1538	set labels { srs verticalDatum }
1539	foreach tag $labels {
1540	label $inner.${tag}label -text $tag -font "Arial 9"
1541	entry $inner.${tag} -font "Arial 9" -bg white \
1542	-textvariable [itcl::scope _view($tag)]
1543	bind $inner.${tag} <KeyPress-Return> \
1544	[itcl::code $this camera set ${tag}]
1545	bind $inner.${tag} <KP_Enter> \
1546	[itcl::code $this camera set ${tag}]
1547	blt::table $inner \
1548	$row,0 $inner.${tag}label -anchor e -pady 2 \
1549	$row,1 $inner.${tag} -anchor w -pady 2
1550	blt::table configure $inner r$row -resize none
1551	incr row
1552	}
1553
1554	if {0} {
1555	button $inner.get \
1556	-text "Get Camera Settings" \
1557	-font "Arial 9" \
1558	-command [itcl::code $this SendCmd "camera get"]
1559	blt::table $inner \
1560	$row,0 $inner.get -anchor w -pady 2 -cspan 2
1561	blt::table configure $inner r$row -resize none
1562	incr row
1563
1564	button $inner.set \
1565	-text "Apply Camera Settings" \
1566	-font "Arial 9" \
1567	-command [itcl::code $this camera set all]
1568	blt::table $inner \
1569	$row,0 $inner.set -anchor w -pady 2 -cspan 2
1570	blt::table configure $inner r$row -resize none
1571	incr row
1572	}
1573
1574	if {$_useServerManip} {
1575	checkbutton $inner.throw \
1576	-text "Enable Throw" \
1577	-font "Arial 9" \
1578	-variable [itcl::scope _settings(camera-throw)] \
1579	-command [itcl::code $this AdjustSetting camera-throw]
1580	blt::table $inner \
1581	$row,0 $inner.throw -anchor w -pady 2 -cspan 2
1582	blt::table configure $inner r$row -resize none
1583	incr row
1584	}
1585
1586	blt::table configure $inner c* r* -resize none
1587	blt::table configure $inner c2 -resize expand
1588	blt::table configure $inner r$row -resize expand
1589	}
1590
1591	#
1592	# camera --
1593	#
1594	# USAGE: camera get
1595	# This is called by the server to transfer the
1596	# current Viewpoint settings
1597	# USAGE: camera reset
1598	# Reset the camera to the default view
1599	#
1600	itcl::body Rappture::MapViewer::camera {option args} {
1601	switch -- $option {
1602	"get" {
1603	# We got the camera settings from the server
1604	foreach name {x y z heading pitch distance srs verticalDatum} value $args {
1605	set _view($name) $value
1606	}
1607	puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
1608	}
1609	"go" {
1610	SendCmd "camera go $args"
1611	}
1612	"reset" {
1613	array set _view {
1614	x 0.0
1615	y 0.0
1616	z 0.0
1617	heading 0.0
1618	pitch -89.9
1619	distance 1.0
1620	srs ""
1621	verticalDatum ""
1622	}
1623	if { [info exists _mapsettings(camera)] } {
1624	# Check if the tool specified a default
1625	set location $_mapsettings(camera)
1626	if { $location != "" } {
1627	array set _view $location
1628	set duration 0.0
1629	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
1630	} else {
1631	SendCmd "camera reset"
1632	# Retrieve the settings
1633	#SendCmd "camera get"
1634	}
1635	} else {
1636	SendCmd "camera reset"
1637	# Retrieve the settings
1638	# SendCmd "camera get"
1639	}
1640	}
1641	"set" {
1642	set who [lindex $args 0]
1643	if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
1644	set val $_view($who)
1645	set code [catch { string is double $val } result]
1646	if { $code != 0 \|\| !$result } {
1647	return
1648	}
1649	}
1650	switch -- $who {
1651	"distance" {
1652	SendCmd [list camera dist $_view(distance)]
1653	}
1654	"all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
1655	set duration 0.0
1656	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
1657	}
1658	}
1659	}
1660	}
1661	}
1662
1663	itcl::body Rappture::MapViewer::GetImage { args } {
1664	if { [image width $_image(download)] > 0 &&
1665	[image height $_image(download)] > 0 } {
1666	set bytes [$_image(download) data -format "jpeg -quality 100"]
1667	set bytes [Rappture::encoding::decode -as b64 $bytes]
1668	return [list .jpg $bytes]
1669	}
1670	return ""
1671	}
1672
1673	itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
1674	Rappture::Balloon $popup \
1675	-title "[Rappture::filexfer::label downloadWord] as..."
1676	set inner [$popup component inner]
1677	label $inner.summary -text "" -anchor w
1678
1679	radiobutton $inner.image_button -text "Image File" \
1680	-variable [itcl::scope _downloadPopup(format)] \
1681	-value image
1682	Rappture::Tooltip::for $inner.image_button \
1683	"Save as digital image."
1684
1685	button $inner.ok -text "Save" \
1686	-highlightthickness 0 -pady 2 -padx 3 \
1687	-command $command \
1688	-compound left \
1689	-image [Rappture::icon download]
1690
1691	button $inner.cancel -text "Cancel" \
1692	-highlightthickness 0 -pady 2 -padx 3 \
1693	-command [list $popup deactivate] \
1694	-compound left \
1695	-image [Rappture::icon cancel]
1696
1697	blt::table $inner \
1698	0,0 $inner.summary -cspan 2 \
1699	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1700	4,1 $inner.cancel -width .9i -fill y \
1701	4,0 $inner.ok -padx 2 -width .9i -fill y
1702	blt::table configure $inner r3 -height 4
1703	blt::table configure $inner r4 -pady 4
1704	raise $inner.image_button
1705	$inner.image_button invoke
1706	return $inner
1707	}
1708
1709	itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
1710	array set settings {
1711	-color white
1712	-edgecolor black
1713	-edges 0
1714	-lighting 0
1715	-linewidth 1.0
1716	-vertscale 1.0
1717	-wireframe 0
1718	}
1719	array set settings $style
1720
1721	SendCmd "map terrain edges $settings(-edges)"
1722	set _settings(terrain-edges) $settings(-edges)
1723	#SendCmd "map terrain color [Color2RGB $settings(-color)]"
1724	#SendCmd "map terrain colormode constant"
1725	SendCmd "map terrain lighting $settings(-lighting)"
1726	set _settings(terrain-lighting) $settings(-lighting)
1727	SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
1728	#SendCmd "map terrain linewidth $settings(-linewidth)"
1729	SendCmd "map terrain vertscale $settings(-vertscale)"
1730	set _settings(terrain-vertscale) $settings(-vertscale)
1731	SendCmd "map terrain wireframe $settings(-wireframe)"
1732	set _settings(terrain-wireframe) $settings(-wireframe)
1733	}
1734
1735	itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
1736	array set info [$dataobj layer $layer]
1737	set _visibility($layer) 1
1738
1739	switch -- $info(type) {
1740	"image" {
1741	array set settings {
1742	-min_level 0
1743	-max_level 23
1744	-opacity 1.0
1745	}
1746	if { [info exists info(style)] } {
1747	array set settings $info(style)
1748	}
1749	if { [info exists info(opacity)] } {
1750	set settings(-opacity) $info(opacity)
1751	}
1752	if {!$_sendEarthFile} {
1753	switch -- $info(driver) {
1754	"debug" {
1755	SendCmd [list map layer add image debug $layer]
1756	}
1757	"gdal" {
1758	SendCmd [list map layer add image gdal \
1759	$info(gdal.url) $layer]
1760	}
1761	"tms" {
1762	SendCmd [list map layer add image tms \
1763	$info(tms.url) $layer]
1764	}
1765	"wms" {
1766	SendCmd [list map layer add image wms \
1767	$info(wms.url) \
1768	$info(wms.layers) \
1769	$info(wms.format) \
1770	$info(wms.transparent) \
1771	$layer]
1772	}
1773	"xyz" {
1774	SendCmd [list map layer add image xyz \
1775	$info(xyz.url) \
1776	$layer]
1777	}
1778	}
1779	}
1780	SendCmd "map layer opacity $settings(-opacity) $layer"
1781	}
1782	"elevation" {
1783	array set settings {
1784	-min_level 0
1785	-max_level 23
1786	}
1787	if { [info exists info(style)] } {
1788	array set settings $info(style)
1789	}
1790	if {!$_sendEarthFile} {
1791	switch -- $info(driver) {
1792	"gdal" {
1793	SendCmd [list map layer add elevation gdal \
1794	$info(gdal.url) $layer]
1795	}
1796	"tms" {
1797	SendCmd [list map layer add elevation tms \
1798	$info(tms.url) $layer]
1799	}
1800	}
1801	}
1802	}
1803	"line" {
1804	array set settings {
1805	-color black
1806	-minbias 1000
1807	-opacity 1.0
1808	-width 1
1809	}
1810	if { [info exists info(style)] } {
1811	array set settings $info(style)
1812	}
1813	if { [info exists info(opacity)] } {
1814	set settings(-opacity) $info(opacity)
1815	}
1816	SendCmd [list map layer add line $info(ogr.url) $layer]
1817	SendCmd "map layer opacity $settings(-opacity) $layer"
1818	}
1819	"polygon" {
1820	array set settings {
1821	-color white
1822	-minbias 1000
1823	-opacity 1.0
1824	}
1825	if { [info exists info(style)] } {
1826	array set settings $info(style)
1827	}
1828	if { [info exists info(opacity)] } {
1829	set settings(-opacity) $info(opacity)
1830	}
1831	SendCmd [list map layer add polygon $info(ogr.url) $layer]
1832	SendCmd "map layer opacity $settings(-opacity) $layer"
1833	}
1834	"label" {
1835	array set settings {
1836	-align "center-center"
1837	-color black
1838	-declutter 1
1839	-font Arial
1840	-fontsize 16.0
1841	-halocolor white
1842	-halowidth 2.0
1843	-layout "ltr"
1844	-minbias 1000
1845	-opacity 1.0
1846	-removedupe 1
1847	}
1848	if { [info exists info(style)] } {
1849	array set settings $info(style)
1850	}
1851	if { [info exists info(opacity)] } {
1852	set settings(-opacity) $info(opacity)
1853	}
1854	set contentExpr $info(content)
1855	if {[info exists info(priority)]} {
1856	set priorityExpr $info(priority)
1857	} else {
1858	set priorityExpr ""
1859	}
1860	SendCmd [list map layer add text $info(ogr.url) $contentExpr $priorityExpr $layer]
1861	SendCmd "map layer opacity $settings(-opacity) $layer"
1862	}
1863	}
1864
1865	if { [info exists info(visible)] } {
1866	if { !$info(visible) } {
1867	set _visibility($layer) 0
1868	SendCmd "map layer visible 0 $layer"
1869	}
1870	}
1871	}
1872
1873	itcl::body Rappture::MapViewer::SetOpacity { dataset } {
1874	foreach {dataobj layer} [split $dataset -] break
1875	set type [$dataobj type $layer]
1876	set val $_settings(-opacity)
1877	set sval [expr { 0.01 * double($val) }]
1878	if { !$_obj2ovride($dataobj-raise) } {
1879	# This is wrong. Need to figure out why raise isn't set with 1
1880	#set sval [expr $sval * .6]
1881	}
1882	SendCmd "$type opacity $sval $dataset"
1883	}
1884
1885	itcl::body Rappture::MapViewer::ChangeLayerVisibility { dataobj layer } {
1886	set bool $_visibility($layer)
1887	SendCmd "map layer visible $bool $layer"
1888	}
1889
1890	itcl::body Rappture::MapViewer::UpdateLayerControls {} {
1891	set row 0
1892	set inner $_layersFrame
1893	if { [winfo exists $inner.layers] } {
1894	foreach w [winfo children $inner.layers] {
1895	destroy $w
1896	}
1897	}
1898	set f $inner.layers
1899	foreach dataobj [get -objects] {
1900	foreach layer [$dataobj layers] {
1901	array unset info
1902	array set info [$dataobj layer $layer]
1903	checkbutton $f.$layer \
1904	-text $info(label) \
1905	-variable [itcl::scope _visibility($layer)] \
1906	-command [itcl::code $this \
1907	ChangeLayerVisibility $dataobj $layer] \
1908	-font "Arial 9" -anchor w
1909	blt::table $f $row,0 $f.$layer -anchor w -pady 2
1910	Rappture::Tooltip::for $f.$layer $info(description)
1911	incr row
1912	}
1913	}
1914	if { $row > 0 } {
1915	blt::table configure $f r* c* -resize none
1916	blt::table configure $f r$row c1 -resize expand
1917	}
1918	}
1919
1920	#
1921	# Generate an OSG Earth file to send to server. This is inteneded
1922	# as a stopgap and testing tool until the protocol is fleshed out.
1923	#
1924	# Note that the lighting settings are required to be "hard-coded"
1925	# as below for the runtime control to work. Don't make those user
1926	# configurable.
1927	#
1928	# Also note: Use "true"/"false" for boolean settings. Not sure if
1929	# the parser in OSG Earth accepts all of Tcl's forms of boolean vals.
1930	#
1931	itcl::body Rappture::MapViewer::EarthFile {} {
1932	append out "<map"
1933	append out " name=\"$_mapsettings(label)\""
1934	append out " type=\"$_mapsettings(type)\""
1935	append out " version=\"2\""
1936	append out ">\n"
1937	append out " <options lighting=\"true\">\n"
1938	# FIXME: convert color setting to hex
1939	# array set style $_mapsettings(style)
1940	# if {[info exists style(-color)]} {
1941	# set color "?"
1942	# }
1943	set color "#ffffffff"
1944	append out " <terrain lighting=\"false\" color=\"$color\"/>\n"
1945	if { [info exists _mapsettings(projection)] } {
1946	append out " <profile"
1947	append out " srs=\"$_mapsettings(projection)\""
1948	if { [info exists _mapsettings(extents)] } {
1949	append out " xmin=\"$_mapsettings(x1)\""
1950	append out " ymin=\"$_mapsettings(y1)\""
1951	append out " xmax=\"$_mapsettings(x2)\""
1952	append out " ymax=\"$_mapsettings(y2)\""
1953	}
1954	append out "/>\n"
1955	}
1956	append out " </options>\n"
1957
1958	foreach dataobj [get -objects] {
1959	foreach layer [$dataobj layers] {
1960	set _layers($layer) 1
1961	array unset info
1962	array set info [$dataobj layer $layer]
1963	switch -- $info(type) {
1964	"image" {
1965	append out " <image"
1966	append out " name=\"$layer\""
1967	append out " driver=\"gdal\""
1968	if { [info exists info(opacity)] } {
1969	append out " opacity=\"$info(opacity)\""
1970	}
1971	if { $info(visible) } {
1972	append out " visible=\"true\""
1973	} else {
1974	append out " visible=\"false\""
1975	}
1976	append out ">\n"
1977	append out " <url>$info(url)</url>\n"
1978	append out " </image>\n"
1979	}
1980	"elevation" {
1981	append out " <elevation"
1982	append out " name=\"$layer\""
1983	append out " driver=\"gdal\""
1984	if { $info(visible) } {
1985	append out " visible=\"true\""
1986	} else {
1987	append out " visible=\"false\""
1988	}
1989	append out ">\n"
1990	append out " <url>$info(url)</url>\n"
1991	append out " </elevation>\n"
1992	}
1993	default {
1994	puts stderr "Type $info(type) not implemented in MapViewer::EarthFile"
1995	}
1996	}
1997	}
1998	}
1999	append out "</map>\n"
2000	return $out
2001	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: