Context Navigation

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

Last change on this file since 5520 was 5347, checked in by ldelgass, 10 years ago
set _downloadPopup to private access
File size: 91.2 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 _viewpointsFrame ""; # Name of viewpoints frame widget
43	private variable _mapsettings; # Global map settings
44
45	constructor { hostlist args } {
46	Rappture::VisViewer::constructor $hostlist
47	} {
48	# defined below
49	}
50	destructor {
51	# defined below
52	}
53	public proc SetServerList { namelist } {
54	Rappture::VisViewer::SetServerList "geovis" $namelist
55	}
56	public method add {dataobj {settings ""}}
57	public method camera {option args}
58	public method delete {args}
59	public method disconnect {}
60	public method download {option args}
61	public method get {args}
62	public method isconnected {}
63	public method parameters {title args} {
64	# do nothing
65	}
66	public method scale {args}
67
68	private method KeyPress { key }
69	private method KeyRelease { key }
70	private method MouseClick { button x y }
71	private method MouseDoubleClick { button x y }
72	private method MouseDrag { button x y }
73	private method MouseMotion {}
74	private method MouseRelease { button x y }
75	private method MouseScroll { direction }
76
77	# The following methods are only used by this class.
78	private method AdjustSetting {what {value ""}}
79	private method BuildCameraTab {}
80	private method BuildDownloadPopup { widget command }
81	private method BuildHelpTab {}
82	private method BuildLayerTab {}
83	private method BuildMapTab {}
84	private method BuildTerrainTab {}
85	private method BuildViewpointsTab {}
86	private method Connect {}
87	private method CurrentLayers {args}
88	private method DisablePanningMouseBindings {}
89	private method DisableRotationMouseBindings {}
90	private method DisableZoomMouseBindings {}
91	private method Disconnect {}
92	private method DoPan {}
93	private method DoResize {}
94	private method DoRotate {}
95	private method DoSelect {}
96	private method DrawLegend { colormap min max }
97	private method EarthFile {}
98	private method EnablePanningMouseBindings {}
99	private method EnableRotationMouseBindings {}
100	private method EnableZoomMouseBindings {}
101	private method EventuallyHandleMotionEvent { x y }
102	private method EventuallyPan { dx dy }
103	private method EventuallyResize { w h }
104	private method EventuallyRotate { dx dy }
105	private method EventuallySelect { x y }
106	private method GetImage { args }
107	private method GetNormalizedMouse { x y }
108	private method GoToViewpoint { dataobj viewpoint }
109	private method InitSettings { args }
110	private method MapIsGeocentric {}
111	private method Pan {option x y}
112	private method Pin {option x y}
113	private method Rebuild {}
114	private method ReceiveImage { args }
115	private method ReceiveLegend { args }
116	private method ReceiveMapInfo { args }
117	private method ReceiveScreenInfo { args }
118	private method RequestLegend { colormap w h }
119	private method Rotate {option x y}
120	private method Select {option x y}
121	private method SetHeading { {value 0} }
122	private method SetLayerOpacity { dataobj layer {value 100} }
123	private method SetLayerStyle { dataobj layer }
124	private method SetLayerVisibility { dataobj layer }
125	private method SetPitch { {value -89.999} }
126	private method SetTerrainStyle { style }
127	private method ToggleGrid {}
128	private method ToggleLighting {}
129	private method ToggleWireframe {}
130	private method UpdateLayerControls {}
131	private method UpdateViewpointControls {}
132	private method Zoom {option {x 0} {y 0}}
133
134	private variable _dlist ""; # list of data objects
135	private variable _obj2ovride; # maps dataobj => style override
136	private variable _layers; # Contains the names of all the
137	# layer in the server.
138	private variable _viewpoints;
139	private variable _click; # info used for rotate operations
140	private variable _view; # view params for 3D view
141	private variable _pan;
142	private variable _rotate;
143	private variable _select;
144	private variable _motion;
145	private variable _settings
146	private variable _opacity
147	private variable _visibility
148	private variable _reset 1; # Indicates that server was reset and
149	# needs to be reinitialized.
150	private variable _initCamera 1;
151	private variable _haveTerrain 0;
152
153	private variable _first ""; # This is the topmost dataset.
154	private variable _start 0
155	private variable _title ""
156
157	private common _downloadPopup; # download options from popup
158	private common _hardcopy
159	private variable _width 0
160	private variable _height 0
161	private variable _resizePending 0
162	private variable _sendEarthFile 0
163	private variable _useServerManip 0
164	private variable _labelCount 0
165	private variable _b1mode "pan"
166	}
167
168	itk::usual MapViewer {
169	keep -background -foreground -cursor -font
170	keep -plotbackground -plotforeground
171	}
172
173	# ----------------------------------------------------------------------
174	# CONSTRUCTOR
175	# ----------------------------------------------------------------------
176	itcl::body Rappture::MapViewer::constructor {hostlist args} {
177	set _serverType "geovis"
178
179	if { [catch {
180
181	# Rebuild event
182	$_dispatcher register !rebuild
183	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
184
185	# Resize event
186	$_dispatcher register !resize
187	$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
188
189	# Pan event
190	$_dispatcher register !pan
191	$_dispatcher dispatch $this !pan "[itcl::code $this DoPan]; list"
192
193	# Rotate event
194	$_dispatcher register !rotate
195	$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
196
197	# Select event
198	$_dispatcher register !select
199	$_dispatcher dispatch $this !select "[itcl::code $this DoSelect]; list"
200
201	# <Motion> event
202	$_dispatcher register !motion
203	$_dispatcher dispatch $this !motion "[itcl::code $this MouseMotion]; list"
204
205	#
206	# Populate parser with commands handle incoming requests
207	#
208	$_parser alias image [itcl::code $this ReceiveImage]
209	$_parser alias legend [itcl::code $this ReceiveLegend]
210	$_parser alias map [itcl::code $this ReceiveMapInfo]
211	$_parser alias camera [itcl::code $this camera]
212	$_parser alias screen [itcl::code $this ReceiveScreenInfo]
213
214	# Millisecond delay before animated wait dialog appears
215	set _waitTimeout 900
216
217	# Settings for mouse motion events: these are required
218	# to update the Lat/Long coordinate display
219	array set _motion {
220	compress 1
221	delay 100
222	enable 1
223	pending 0
224	x 0
225	y 0
226	}
227	array set _pan {
228	compress 1
229	delay 100
230	pending 0
231	x 0
232	y 0
233	}
234	array set _rotate {
235	azimuth 0
236	compress 1
237	delay 100
238	elevation 0
239	pending 0
240	}
241	array set _select {
242	compress 1
243	delay 100
244	pending 0
245	x 0
246	y 0
247	}
248	# This array holds the Viewpoint parameters that the
249	# server sends on "camera get".
250	array set _view {
251	distance 1.0
252	heading 0.0
253	pitch -89.9
254	srs ""
255	verticalDatum ""
256	x 0.0
257	y 0.0
258	z 0.0
259	}
260
261	# Note: grid types are "geodetic", "utm" and "mgrs"
262	# Currently only work in geocentric maps
263	array set _settings [subst {
264	camera-throw 0
265	coords-precision 5
266	coords-units "latlong_decimal_degrees"
267	coords-visible 1
268	grid 0
269	grid-type "geodetic"
270	legend 1
271	terrain-edges 0
272	terrain-lighting 0
273	terrain-vertscale 1.0
274	terrain-wireframe 0
275	time 12
276	}]
277
278	set _settings(time) [clock format [clock seconds] -format %k -gmt 1]
279
280	itk_component add view {
281	canvas $itk_component(plotarea).view \
282	-highlightthickness 0 -borderwidth 0
283	} {
284	usual
285	ignore -highlightthickness -borderwidth -background
286	}
287
288	set c $itk_component(view)
289	bind $c <Enter> "focus %W"
290	bind $c <Control-F1> [itcl::code $this ToggleConsole]
291
292	# Fix the scrollregion in case we go off screen
293	$c configure -scrollregion [$c bbox all]
294
295	set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
296	set _map(cwidth) -1
297	set _map(cheight) -1
298	set _map(zoom) 1.0
299	set _map(original) ""
300
301	set f [$itk_component(main) component controls]
302	itk_component add reset {
303	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
304	-highlightthickness 0 \
305	-image [Rappture::icon reset-view] \
306	-command [itcl::code $this camera reset]
307	} {
308	usual
309	ignore -highlightthickness
310	}
311	pack $itk_component(reset) -side top -padx 2 -pady 2
312	Rappture::Tooltip::for $itk_component(reset) \
313	"Reset the view to the default zoom level"
314
315	itk_component add zoomin {
316	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
317	-highlightthickness 0 \
318	-image [Rappture::icon zoom-in] \
319	-command [itcl::code $this Zoom in]
320	} {
321	usual
322	ignore -highlightthickness
323	}
324	pack $itk_component(zoomin) -side top -padx 2 -pady 2
325	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
326
327	itk_component add zoomout {
328	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
329	-highlightthickness 0 \
330	-image [Rappture::icon zoom-out] \
331	-command [itcl::code $this Zoom out]
332	} {
333	usual
334	ignore -highlightthickness
335	}
336	pack $itk_component(zoomout) -side top -padx 2 -pady 2
337	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
338
339	BuildLayerTab
340	BuildViewpointsTab
341	BuildMapTab
342	BuildTerrainTab
343	BuildCameraTab
344	BuildHelpTab
345
346	# Legend
347
348	set _image(legend) [image create photo]
349	itk_component add legend {
350	canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
351	} {
352	usual
353	ignore -highlightthickness
354	rename -background -plotbackground plotBackground Background
355	}
356
357	# Hack around the Tk panewindow. The problem is that the requested
358	# size of the 3d view isn't set until an image is retrieved from
359	# the server. So the panewindow uses the tiny size.
360	pack forget $itk_component(view)
361	blt::table $itk_component(plotarea) \
362	0,0 $itk_component(view) -fill both -reqwidth 10000
363	blt::table configure $itk_component(plotarea) c1 -resize none
364
365	bind $itk_component(view) <Configure> \
366	[itcl::code $this EventuallyResize %w %h]
367
368	EnablePanningMouseBindings
369	EnableRotationMouseBindings
370	EnableZoomMouseBindings
371
372	if {$_useServerManip} {
373	# Bindings for keyboard events
374	bind $itk_component(view) <KeyPress> \
375	[itcl::code $this KeyPress %N]
376	bind $itk_component(view) <KeyRelease> \
377	[itcl::code $this KeyRelease %N]
378
379	# Zoom to point
380	bind $itk_component(view) <Double-1> \
381	[itcl::code $this MouseDoubleClick 1 %x %y]
382	bind $itk_component(view) <Double-3> \
383	[itcl::code $this MouseDoubleClick 3 %x %y]
384
385	# Unused
386	bind $itk_component(view) <Double-2> \
387	[itcl::code $this MouseDoubleClick 2 %x %y]
388
389	# Binding for mouse motion events
390	if {$_motion(enable)} {
391	bind $itk_component(view) <Motion> \
392	[itcl::code $this EventuallyHandleMotionEvent %x %y]
393	}
394	} else {
395	# Zoom to point
396	bind $itk_component(view) <Double-1> \
397	[itcl::code $this camera go %x %y 0.4]
398	# Travel to point (no zoom)
399	bind $itk_component(view) <Shift-Double-1> \
400	[itcl::code $this camera go %x %y 1.0]
401	# Zoom out centered on point
402	bind $itk_component(view) <Double-3> \
403	[itcl::code $this camera go %x %y 2.5]
404
405	# Pin placemark annotations
406	bind $itk_component(view) <Control-ButtonPress-1> \
407	[itcl::code $this Pin add %x %y]
408	bind $itk_component(view) <Control-ButtonPress-3> \
409	[itcl::code $this Pin delete %x %y]
410
411	# Draw selection rectangle
412	bind $itk_component(view) <Shift-ButtonPress-1> \
413	[itcl::code $this Select click %x %y]
414	bind $itk_component(view) <B1-Motion> \
415	+[itcl::code $this Select drag %x %y]
416	bind $itk_component(view) <Shift-ButtonRelease-1> \
417	[itcl::code $this Select release %x %y]
418
419	# Update coordinate readout
420	bind $itk_component(view) <ButtonPress-1> \
421	+[itcl::code $this SendCmd "map setpos %x %y"]
422	bind $itk_component(view) <Double-3> \
423	+[itcl::code $this SendCmd "map setpos %x %y"]
424
425	# Bindings for panning via keyboard
426	bind $itk_component(view) <KeyPress-Left> \
427	[itcl::code $this Pan set 10 0]
428	bind $itk_component(view) <KeyPress-Right> \
429	[itcl::code $this Pan set -10 0]
430	bind $itk_component(view) <KeyPress-Up> \
431	[itcl::code $this Pan set 0 -10]
432	bind $itk_component(view) <KeyPress-Down> \
433	[itcl::code $this Pan set 0 10]
434
435	bind $itk_component(view) <Shift-KeyPress-Left> \
436	[itcl::code $this Pan set 2 0]
437	bind $itk_component(view) <Shift-KeyPress-Right> \
438	[itcl::code $this Pan set -2 0]
439	bind $itk_component(view) <Shift-KeyPress-Up> \
440	[itcl::code $this Pan set 0 -2]
441	bind $itk_component(view) <Shift-KeyPress-Down> \
442	[itcl::code $this Pan set 0 2]
443
444	# Bindings for rotation via keyboard
445	bind $itk_component(view) <Control-Left> \
446	[itcl::code $this Rotate set 10 0]
447	bind $itk_component(view) <Control-Right> \
448	[itcl::code $this Rotate set -10 0]
449	bind $itk_component(view) <Control-Up> \
450	[itcl::code $this Rotate set 0 -10]
451	bind $itk_component(view) <Control-Down> \
452	[itcl::code $this Rotate set 0 10]
453
454	bind $itk_component(view) <Control-Shift-Left> \
455	[itcl::code $this Rotate set 2 0]
456	bind $itk_component(view) <Control-Shift-Right> \
457	[itcl::code $this Rotate set -2 0]
458	bind $itk_component(view) <Control-Shift-Up> \
459	[itcl::code $this Rotate set 0 -2]
460	bind $itk_component(view) <Control-Shift-Down> \
461	[itcl::code $this Rotate set 0 2]
462
463	# Bindings for zoom via keyboard
464	bind $itk_component(view) <KeyPress-Prior> \
465	[itcl::code $this Zoom out]
466	bind $itk_component(view) <KeyPress-Next> \
467	[itcl::code $this Zoom in]
468	bind $itk_component(view) <KeyPress-Home> \
469	[itcl::code $this camera reset]
470
471	# Keyboard shortcuts
472	# Reset heading to North
473	bind $itk_component(view) <n> \
474	[itcl::code $this SetHeading]
475	# Reset pitch to top-down (2D) view
476	bind $itk_component(view) <p> \
477	[itcl::code $this SetPitch]
478	bind $itk_component(view) <g> \
479	[itcl::code $this ToggleGrid]
480	bind $itk_component(view) <l> \
481	[itcl::code $this ToggleLighting]
482	bind $itk_component(view) <w> \
483	[itcl::code $this ToggleWireframe]
484
485	# Binding for mouse motion events
486	set _motion(compress) 1
487	if {$_motion(enable)} {
488	bind $itk_component(view) <Motion> \
489	[itcl::code $this EventuallyHandleMotionEvent %x %y]
490	}
491	#bind $itk_component(view) <Motion> \
492	# +[itcl::code $this SendCmd "map pin hover %x %y"]
493	}
494
495	bind $itk_component(view) <Enter> "focus $itk_component(view)"
496
497	if {[string equal "x11" [tk windowingsystem]]} {
498	# Bindings for zoom via mouse
499	if {$_useServerManip} {
500	bind $itk_component(view) <4> [itcl::code $this MouseScroll up]
501	bind $itk_component(view) <5> [itcl::code $this MouseScroll down]
502	} else {
503	bind $itk_component(view) <4> [itcl::code $this Zoom out]
504	bind $itk_component(view) <5> [itcl::code $this Zoom in]
505	}
506	}
507
508	set _image(download) [image create photo]
509
510	eval itk_initialize $args
511	Connect
512	} errs] != 0 } {
513	puts stderr errs=$errs
514	}
515	}
516
517	# ----------------------------------------------------------------------
518	# DESTRUCTOR
519	# ----------------------------------------------------------------------
520	itcl::body Rappture::MapViewer::destructor {} {
521	Disconnect
522	$_dispatcher cancel !rebuild
523	$_dispatcher cancel !resize
524	$_dispatcher cancel !rotate
525	image delete $_image(plot)
526	image delete $_image(download)
527	}
528
529	itcl::body Rappture::MapViewer::DoResize {} {
530	set sendResize 1
531	if { $_width < 2 } {
532	set _width 500
533	set sendResize 0
534	}
535	if { $_height < 2 } {
536	set _height 500
537	set sendResize 0
538	}
539	#set _start [clock clicks -milliseconds]
540	if {$sendResize} {
541	SendCmd "screen size $_width $_height"
542	}
543	set _resizePending 0
544	}
545
546	itcl::body Rappture::MapViewer::DoRotate {} {
547	SendCmd "camera rotate $_rotate(azimuth) $_rotate(elevation)"
548	set _rotate(azimuth) 0
549	set _rotate(elevation) 0
550	set _rotate(pending) 0
551	}
552
553	itcl::body Rappture::MapViewer::DoSelect {} {
554	SendCmd "map box update $_select(x) $_select(y)"
555	set _select(x) 0
556	set _select(y) 0
557	set _select(pending) 0
558	}
559
560	itcl::body Rappture::MapViewer::EventuallyResize { w h } {
561	set _width $w
562	set _height $h
563	if { !$_resizePending } {
564	set _resizePending 1
565	$_dispatcher event -after 200 !resize
566	}
567	}
568
569	itcl::body Rappture::MapViewer::DoPan {} {
570	SendCmd "camera pan $_pan(x) $_pan(y)"
571	set _pan(x) 0
572	set _pan(y) 0
573	set _pan(pending) 0
574	}
575
576	itcl::body Rappture::MapViewer::EventuallyPan { dx dy } {
577	set _pan(x) [expr $_pan(x) + $dx]
578	set _pan(y) [expr $_pan(y) + $dy]
579	if { !$_pan(compress) } {
580	DoPan
581	return
582	}
583	if { !$_pan(pending) } {
584	set _pan(pending) 1
585	$_dispatcher event -after $_pan(delay) !pan
586	}
587	}
588
589	itcl::body Rappture::MapViewer::EventuallyRotate { dx dy } {
590	set _rotate(azimuth) [expr $_rotate(azimuth) + $dx]
591	set _rotate(elevation) [expr $_rotate(elevation) + $dy]
592	if { !$_rotate(compress) } {
593	DoRotate
594	return
595	}
596	if { !$_rotate(pending) } {
597	set _rotate(pending) 1
598	$_dispatcher event -after $_rotate(delay) !rotate
599	}
600	}
601
602	itcl::body Rappture::MapViewer::EventuallySelect { x y } {
603	set _select(x) $x
604	set _select(y) $y
605	if { !$_select(compress) } {
606	DoSelect
607	return
608	}
609	if { !$_select(pending) } {
610	set _select(pending) 1
611	$_dispatcher event -after $_select(delay) !select
612	}
613	}
614
615	itcl::body Rappture::MapViewer::DrawLegend { colormap min max } {
616	if { [info exists itk_component(legend-$colormap) ] } {
617	$itk_component(legend-$colormap-min) configure -text $min
618	$itk_component(legend-$colormap-max) configure -text $max
619	$itk_component(legend-$colormap) configure -image $_image(legend-$colormap)
620	}
621	}
622
623	itcl::body Rappture::MapViewer::RequestLegend { colormap w h } {
624	SendCmd "legend $colormap $w $h 0 [Color2RGB #d9d9d9]"
625	}
626
627	# ----------------------------------------------------------------------
628	# USAGE: add <dataobj> ?<settings>?
629	#
630	# Clients use this to add a data object to the plot. The optional
631	# <settings> are used to configure the plot. Allowed settings are
632	# -color, -brightness, -width, -linestyle, and -raise.
633	# ----------------------------------------------------------------------
634	itcl::body Rappture::MapViewer::add {dataobj {settings ""}} {
635	array set params {
636	-color auto
637	-width 1
638	-linestyle solid
639	-brightness 0
640	-raise 0
641	-description ""
642	-param ""
643	-type ""
644	}
645	array set params $settings
646	set params(-description) ""
647	set params(-param) ""
648	array set params $settings
649
650	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
651	# can't handle -autocolors yet
652	set params(-color) black
653	}
654	set pos [lsearch -exact $_dlist $dataobj]
655	if {$pos < 0} {
656	#if {[llength $_dlist] > 0} {
657	# error "Can't add more than 1 map to mapviewer"
658	#}
659	lappend _dlist $dataobj
660	}
661	set _obj2ovride($dataobj-color) $params(-color)
662	set _obj2ovride($dataobj-width) $params(-width)
663	set _obj2ovride($dataobj-raise) $params(-raise)
664	$_dispatcher event -idle !rebuild
665	}
666
667	# ----------------------------------------------------------------------
668	# USAGE: delete ?<dataobj1> <dataobj2> ...?
669	#
670	# Clients use this to delete a dataobj from the plot. If no dataobjs
671	# are specified, then all dataobjs are deleted. No data objects are
672	# deleted. They are only removed from the display list.
673	# ----------------------------------------------------------------------
674	itcl::body Rappture::MapViewer::delete {args} {
675	if { [llength $args] == 0} {
676	set args $_dlist
677	}
678	# Delete all specified dataobjs
679	set changed 0
680	foreach dataobj $args {
681	set pos [lsearch -exact $_dlist $dataobj]
682	if { $pos < 0 } {
683	continue; # Don't know anything about it.
684	}
685	# When a map is marked deleted, we hide its layers.
686	foreach layer [$dataobj layers] {
687	SendCmd "map layer visible 0 $layer"
688	set _visibility($layer) 0
689	}
690	# Remove it from the dataobj list.
691	set _dlist [lreplace $_dlist $pos $pos]
692	array unset _obj2ovride $dataobj-*
693	array unset _settings $dataobj-*
694	set changed 1
695	}
696	# If anything changed, then rebuild the plot
697	if { $changed } {
698	$_dispatcher event -idle !rebuild
699	}
700	}
701
702	# ----------------------------------------------------------------------
703	# USAGE: get ?-objects?
704	# USAGE: get ?-visible?
705	# USAGE: get ?-image view?
706	#
707	# Clients use this to query the list of objects being plotted, in
708	# order from bottom to top of this result. The optional "-image"
709	# flag can also request the internal images being shown.
710	# ----------------------------------------------------------------------
711	itcl::body Rappture::MapViewer::get {args} {
712	if {[llength $args] == 0} {
713	set args "-objects"
714	}
715
716	set op [lindex $args 0]
717	switch -- $op {
718	"-objects" {
719	# put the dataobj list in order according to -raise options
720	set dlist {}
721	foreach dataobj $_dlist {
722	if { ![$dataobj isvalid] } {
723	continue
724	}
725	if {[info exists _obj2ovride($dataobj-raise)] &&
726	$_obj2ovride($dataobj-raise)} {
727	set dlist [linsert $dlist 0 $dataobj]
728	} else {
729	lappend dlist $dataobj
730	}
731	}
732	return $dlist
733	}
734	"-visible" {
735	set dlist {}
736	foreach dataobj $_dlist {
737	if { ![$dataobj isvalid] } {
738	continue
739	}
740	if { ![info exists _obj2ovride($dataobj-raise)] } {
741	# No setting indicates that the object isn't visible.
742	continue
743	}
744	# Otherwise use the -raise parameter to put the object to
745	# the front of the list.
746	if { $_obj2ovride($dataobj-raise) } {
747	set dlist [linsert $dlist 0 $dataobj]
748	} else {
749	lappend dlist $dataobj
750	}
751	}
752	return $dlist
753	}
754	-image {
755	if {[llength $args] != 2} {
756	error "wrong # args: should be \"get -image view\""
757	}
758	switch -- [lindex $args end] {
759	view {
760	return $_image(plot)
761	}
762	default {
763	error "bad image name \"[lindex $args end]\": should be view"
764	}
765	}
766	}
767	default {
768	error "bad option \"$op\": should be -objects or -image"
769	}
770	}
771	}
772
773	itcl::body Rappture::MapViewer::MapIsGeocentric {} {
774	if { [info exists _mapsettings(type)] } {
775	return [expr {$_mapsettings(type) eq "geocentric"}]
776	} else {
777	return 0
778	}
779	}
780
781	# ----------------------------------------------------------------------
782	# USAGE: scale ?<data1> <data2> ...?
783	#
784	# Sets the default limits for the overall plot according to the
785	# limits of the data for all of the given <data> objects. This
786	# accounts for all objects--even those not showing on the screen.
787	# Because of this, the limits are appropriate for all objects as
788	# the user scans through data in the ResultSet viewer.
789	# ----------------------------------------------------------------------
790	itcl::body Rappture::MapViewer::scale {args} {
791	array unset _mapsettings
792	set _haveTerrain 0
793
794	# Verify that all the maps have the same global settings. For example,
795	# you can't have one map type "geocentric" and the other "projected".
796
797	foreach dataobj $args {
798	if { ![$dataobj isvalid] } {
799	continue
800	}
801	array unset hints
802	array set hints [$dataobj hints]
803	if { ![info exists _mapsettings(label)] } {
804	set _mapsettings(label) $hints(label)
805	}
806	if { ![info exists _mapsettings(style)] } {
807	set _mapsettings(style) $hints(style)
808	}
809	if { ![info exists _mapsettings(type)] } {
810	set _mapsettings(type) $hints(type)
811	} elseif { $hints(type) != $_mapsettings(type) } {
812	error "maps \"$hints(label)\" have differing types"
813	}
814	if { ![info exists _mapsettings(projection)] } {
815	set _mapsettings(projection) $hints(projection)
816	} elseif { $hints(projection) != $_mapsettings(projection) } {
817	error "maps \"$hints(label)\" have differing projections"
818	}
819	if { $hints(extents) != "" } {
820	if { ![info exists _mapsettings(extents)] } {
821	set _mapsettings(extents) $hints(extents)
822	}
823	foreach {x1 y1 x2 y2} $hints(extents) break
824	if { ![info exists _mapsettings(x1)] \|\| $x1 < $_mapsettings(x1) } {
825	set _mapsettings(x1) $x1
826	}
827	if { ![info exists _mapsettings(y1)] \|\| $y1 < $_mapsettings(y1) } {
828	set _mapsettings(y1) $y1
829	}
830	if { ![info exists _mapsettings(x2)] \|\| $x2 > $_mapsettings(x2) } {
831	set _mapsettings(x2) $x2
832	}
833	if { ![info exists _mapsettings(y2)] \|\| $y2 > $_mapsettings(y2) } {
834	set _mapsettings(y2) $y2
835	}
836	}
837	if { [info exists hints(camera)] } {
838	if { ![info exists _mapsettings(camera)] } {
839	set _mapsettings(camera) $hints(camera)
840	}
841	}
842	foreach layer [$dataobj layers] {
843	if { [$dataobj type $layer] == "elevation" } {
844	set _haveTerrain 1
845	break
846	}
847	}
848	foreach viewpoint [$dataobj viewpoints] {
849	set _viewpoints($viewpoint) [$dataobj viewpoint $viewpoint]
850	if 0 {
851	array set vp $_viewpoints($viewpoint)
852	foreach key { label description x y z distance heading pitch srs verticalDatum } {
853	if { [info exists vp($key)] } {
854	puts stderr "$viewpoint $key $vp($key)"
855	}
856	}
857	}
858	}
859	}
860	if { $_haveTerrain } {
861	if { [$itk_component(main) exists "Terrain Settings"] } {
862	# TODO: Enable controls like vertical scale that only have
863	# an effect when terrain is present
864	}
865	}
866	}
867
868	# ----------------------------------------------------------------------
869	# USAGE: download coming
870	# USAGE: download controls <downloadCommand>
871	# USAGE: download now
872	#
873	# Clients use this method to create a downloadable representation
874	# of the plot. Returns a list of the form {ext string}, where
875	# "ext" is the file extension (indicating the type of data) and
876	# "string" is the data itself.
877	# ----------------------------------------------------------------------
878	itcl::body Rappture::MapViewer::download {option args} {
879	switch $option {
880	coming {
881	if {[catch {
882	blt::winop snap $itk_component(plotarea) $_image(download)
883	}]} {
884	$_image(download) configure -width 1 -height 1
885	$_image(download) put #000000
886	}
887	}
888	controls {
889	set popup .mapviewerdownload
890	if { ![winfo exists .mapviewerdownload] } {
891	set inner [BuildDownloadPopup $popup [lindex $args 0]]
892	} else {
893	set inner [$popup component inner]
894	}
895	set _downloadPopup(image_controls) $inner.image_frame
896	set num [llength [get]]
897	set num [expr {($num == 1) ? "1 result" : "$num results"}]
898	set word [Rappture::filexfer::label downloadWord]
899	$inner.summary configure -text "$word $num in the following format:"
900	update idletasks ;# Fix initial sizes
901	return $popup
902	}
903	now {
904	set popup .mapviewerdownload
905	if {[winfo exists .mapviewerdownload]} {
906	$popup deactivate
907	}
908	switch -- $_downloadPopup(format) {
909	"image" {
910	return [$this GetImage [lindex $args 0]]
911	}
912	}
913	return ""
914	}
915	default {
916	error "bad option \"$option\": should be coming, controls, now"
917	}
918	}
919	}
920
921	# ----------------------------------------------------------------------
922	# USAGE: Connect ?<host:port>,<host:port>...?
923	#
924	# Clients use this method to establish a connection to a new
925	# server, or to reestablish a connection to the previous server.
926	# Any existing connection is automatically closed.
927	# ----------------------------------------------------------------------
928	itcl::body Rappture::MapViewer::Connect {} {
929	global readyForNextFrame
930	set readyForNextFrame 1
931	set _reset 1
932	set _hosts [GetServerList "geovis"]
933	if { "" == $_hosts } {
934	return 0
935	}
936	set result [VisViewer::Connect $_hosts]
937	if { $result } {
938	if { $_reportClientInfo } {
939	# Tell the server the viewer, hub, user and session.
940	# Do this immediately on connect before buffering any commands
941	global env
942
943	set info {}
944	set user "???"
945	if { [info exists env(USER)] } {
946	set user $env(USER)
947	}
948	set session "???"
949	if { [info exists env(SESSION)] } {
950	set session $env(SESSION)
951	}
952	lappend info "version" "$Rappture::version"
953	lappend info "build" "$Rappture::build"
954	lappend info "svnurl" "$Rappture::svnurl"
955	lappend info "installdir" "$Rappture::installdir"
956	lappend info "hub" [exec hostname]
957	lappend info "client" "mapviewer"
958	lappend info "user" $user
959	lappend info "session" $session
960	SendCmd "clientinfo [list $info]"
961	}
962
963	set w [winfo width $itk_component(view)]
964	set h [winfo height $itk_component(view)]
965	EventuallyResize $w $h
966	}
967	return $result
968	}
969
970	#
971	# isconnected --
972	#
973	# Indicates if we are currently connected to the visualization server.
974	#
975	itcl::body Rappture::MapViewer::isconnected {} {
976	return [VisViewer::IsConnected]
977	}
978
979	#
980	# disconnect --
981	#
982	itcl::body Rappture::MapViewer::disconnect {} {
983	Disconnect
984	set _reset 1
985	}
986
987	#
988	# Disconnect --
989	#
990	# Clients use this method to disconnect from the current rendering
991	# server.
992	#
993	itcl::body Rappture::MapViewer::Disconnect {} {
994	VisViewer::Disconnect
995
996	$_dispatcher cancel !pan
997	$_dispatcher cancel !motion
998	$_dispatcher cancel !rebuild
999	$_dispatcher cancel !resize
1000	$_dispatcher cancel !rotate
1001	# disconnected -- no more data sitting on server
1002	array unset _layers
1003	array unset _layersFrame
1004	global readyForNextFrame
1005	set readyForNextFrame 1
1006	}
1007
1008	# ----------------------------------------------------------------------
1009	# USAGE: ReceiveImage -type <type> -token <token> -bytes <size>
1010	#
1011	# Invoked automatically whenever the "image" command comes in from
1012	# the rendering server. Indicates that binary image data with the
1013	# specified <size> will follow.
1014	# ----------------------------------------------------------------------
1015	itcl::body Rappture::MapViewer::ReceiveImage { args } {
1016	global readyForNextFrame
1017	set readyForNextFrame 1
1018	array set info {
1019	-bytes 0
1020	-token "???"
1021	-type image
1022	}
1023	array set info $args
1024	set bytes [ReceiveBytes $info(-bytes)]
1025	if { $info(-type) == "image" } {
1026	$_image(plot) configure -data $bytes
1027	} elseif { $info(type) == "print" } {
1028	set tag $this-print-$info(-token)
1029	set _hardcopy($tag) $bytes
1030	}
1031	set _waitTimeout 0
1032	}
1033
1034	#
1035	# ReceiveLegend
1036	#
1037	# Invoked automatically whenever the "legend" command comes in from
1038	# the rendering server. Indicates that binary image data with the
1039	# specified <size> will follow.
1040	#
1041	itcl::body Rappture::MapViewer::ReceiveLegend { colormap min max size } {
1042	#puts stderr "ReceiveLegend colormap=$colormap range=$min,$max size=$size"
1043	if { [IsConnected] } {
1044	set bytes [ReceiveBytes $size]
1045	if { ![info exists _image(legend)] } {
1046	set _image(legend-$colormap) [image create photo]
1047	}
1048	if 0 {
1049	set f [open "/tmp/legend-${colormap}.ppm" "w"]
1050	fconfigure $f -translation binary -encoding binary
1051	puts $f $bytes
1052	close $f
1053	}
1054	$_image(legend-$colormap) configure -data $bytes
1055	#puts stderr "read $size bytes for [image width $_image(legend-$colormap)]x[image height $_image(legend-$colormap)] legend>"
1056	if { [catch {DrawLegend $colormap $min $max} errs] != 0 } {
1057	global errorInfo
1058	puts stderr "errs=$errs errorInfo=$errorInfo"
1059	}
1060	}
1061	}
1062
1063	#
1064	# ReceiveMapInfo --
1065	#
1066	itcl::body Rappture::MapViewer::ReceiveMapInfo { args } {
1067	if { ![isconnected] } {
1068	return
1069	}
1070	set timeReceived [clock clicks -milliseconds]
1071	set elapsed [expr $timeReceived - $_start]
1072	set option [lindex $args 0]
1073	switch -- $option {
1074	"coords" {
1075	set len [llength $args]
1076	if {$len < 3} {
1077	error "Bad map coords response"
1078	} else {
1079	set token [lindex $args 1]
1080	}
1081	foreach { x y z } [lindex $args 2] {
1082	puts stderr "\[$token\] Map coords: $x $y $z"
1083	}
1084	if {$len > 3} {
1085	set srs [lindex $args 3]
1086	set vert [lindex $args 4]
1087	puts stderr "\[$token\] {$srs} {$vert}"
1088	}
1089	}
1090	"names" {
1091	foreach { name } [lindex $args 1] {
1092	puts stderr "layer: $name"
1093	}
1094	}
1095	default {
1096	error "unknown map option \"$option\" from server"
1097	}
1098	}
1099	}
1100
1101	#
1102	# ReceiveScreenInfo --
1103	#
1104	itcl::body Rappture::MapViewer::ReceiveScreenInfo { args } {
1105	if { ![isconnected] } {
1106	return
1107	}
1108	set option [lindex $args 0]
1109	switch -- $option {
1110	"coords" {
1111	set len [llength $args]
1112	if {$len < 3} {
1113	error "Bad screen coords response"
1114	} else {
1115	set token [lindex $args 1]
1116	}
1117	foreach { x y z } [lindex $args 2] {
1118	puts stderr "\[$token\] Screen coords: $x $y $z"
1119	}
1120	}
1121	default {
1122	error "unknown screen option \"$option\" from server"
1123	}
1124	}
1125	}
1126
1127	# ----------------------------------------------------------------------
1128	# USAGE: Rebuild
1129	#
1130	# Called automatically whenever something changes that affects the
1131	# data in the widget. Clears any existing data and rebuilds the
1132	# widget to display new data.
1133	# ----------------------------------------------------------------------
1134	itcl::body Rappture::MapViewer::Rebuild {} {
1135	set w [winfo width $itk_component(view)]
1136	set h [winfo height $itk_component(view)]
1137	if { $w < 2 \|\| $h < 2 } {
1138	update idletasks
1139	$_dispatcher event -idle !rebuild
1140	return
1141	}
1142
1143	# Turn on buffering of commands to the server. We don't want to be
1144	# preempted by a server disconnect/reconnect (which automatically
1145	# generates a new call to Rebuild).
1146	StartBufferingCommands
1147
1148	if { $_reset } {
1149	set _width $w
1150	set _height $h
1151	DoResize
1152
1153	if { [info exists _mapsettings(type)] } {
1154	# The map must be reset once before any layers are added This
1155	# should not be done more than once as it is very expensive.
1156	if {$_sendEarthFile} {
1157	set bytes [EarthFile]
1158	if {0} {
1159	set f [open "/tmp/map.earth" "w"]
1160	puts $f $bytes
1161	close $f
1162	}
1163	set length [string length $bytes]
1164	SendCmd "map load data follows $length"
1165	SendData $bytes
1166	} else {
1167	if { [info exists _mapsettings(style)] } {
1168	array set settings {
1169	-color white
1170	}
1171	array set settings $_mapsettings(style)
1172	}
1173	set bgcolor [Color2RGB $settings(-color)]
1174	if { $_mapsettings(type) == "geocentric" } {
1175	$itk_component(grid) configure -state normal
1176	$itk_component(time_l) configure -state normal
1177	$itk_component(time) configure -state normal
1178	$itk_component(pitch_slider_l) configure -state normal
1179	$itk_component(pitch_slider) configure -state normal
1180	EnableRotationMouseBindings
1181	SendCmd "map reset geocentric $bgcolor"
1182	} else {
1183	$itk_component(grid) configure -state disabled
1184	$itk_component(time_l) configure -state disabled
1185	$itk_component(time) configure -state disabled
1186	$itk_component(pitch_slider_l) configure -state disabled
1187	$itk_component(pitch_slider) configure -state disabled
1188	DisableRotationMouseBindings
1189	set proj $_mapsettings(projection)
1190	SendCmd "screen bgcolor $bgcolor"
1191	if { $proj == "" } {
1192	SendCmd "map reset projected $bgcolor global-mercator"
1193	} elseif { ![info exists _mapsettings(extents)] \|\| $_mapsettings(extents) == "" } {
1194	SendCmd "map reset projected $bgcolor [list $proj]"
1195	} else {
1196	#foreach {x1 y1 x2 y2} $_mapsettings(extents) break
1197	foreach key "x1 y1 x2 y2" {
1198	set $key $_mapsettings($key)
1199	}
1200	SendCmd "map reset projected $bgcolor [list $proj] $x1 $y1 $x2 $y2"
1201	}
1202	}
1203	# XXX: Remove these after implementing batch load of layers with reset
1204	SendCmd "map layer delete base"
1205	}
1206
1207	# Most terrain settings are global to the map and apply even
1208	# if there is no elevation layer. The exception is the
1209	# vertical scale, which only applies if there is an elevation
1210	# layer
1211	if { [info exists _mapsettings(style)] } {
1212	SetTerrainStyle $_mapsettings(style)
1213	} else {
1214	InitSettings terrain-edges terrain-lighting \
1215	terrain-vertscale terrain-wireframe
1216	}
1217	InitSettings coords-visible
1218	} else {
1219	error "No map settings on reset"
1220	}
1221	}
1222
1223	set _first ""
1224	set haveTerrain 0
1225	foreach dataobj [get -objects] {
1226	foreach layer [$dataobj layers] {
1227	array unset info
1228	array set info [$dataobj layer $layer]
1229	if { ![info exists _layers($layer)] } {
1230	if { $_reportClientInfo } {
1231	set cinfo {}
1232	lappend cinfo "tool_id" [$dataobj hints toolid]
1233	lappend cinfo "tool_name" [$dataobj hints toolname]
1234	lappend cinfo "tool_title" [$dataobj hints tooltitle]
1235	lappend cinfo "tool_command" [$dataobj hints toolcommand]
1236	lappend cinfo "tool_revision" [$dataobj hints toolrevision]
1237	lappend cinfo "dataset_label" [encoding convertto utf-8 $info(label)]
1238	lappend cinfo "dataset_tag" $layer
1239	SendCmd "clientinfo [list $cinfo]"
1240	}
1241	set _layers($layer) 1
1242	SetLayerStyle $dataobj $layer
1243	}
1244	if {$info(type) == "elevation"} {
1245	set haveTerrain 1
1246	}
1247	# FIXME: This is overriding all layers' initial visibility setting
1248	if { [info exists _obj2ovride($dataobj-raise)] } {
1249	SendCmd "map layer visible 1 $layer"
1250	set _visibility($layer) 1
1251	#SetLayerOpacity $dataobj $layer
1252	}
1253	}
1254	}
1255
1256	if ($haveTerrain) {
1257	$itk_component(vscale_l) configure -state normal
1258	$itk_component(vscale) configure -state normal
1259	} else {
1260	$itk_component(vscale_l) configure -state disabled
1261	$itk_component(vscale) configure -state disabled
1262	}
1263
1264	if {$_reset} {
1265	if {$_initCamera} {
1266	# If this is the first Rebuild, we need to
1267	# set up the initial view settings if there
1268	# are any
1269	if { [info exists _mapsettings(camera)] } {
1270	set location $_mapsettings(camera)
1271	if { $location != "" } {
1272	array set _view $location
1273	camera set all
1274	}
1275	}
1276	set _initCamera 0
1277	} else {
1278	# Restore view from before reconnect
1279	camera set all
1280	}
1281	}
1282
1283	UpdateLayerControls
1284	UpdateViewpointControls
1285	set _reset 0
1286	global readyForNextFrame
1287	set readyForNextFrame 0; # Don't advance to the next frame
1288	# until we get an image.
1289
1290	# Actually write the commands to the server socket. If it fails, we
1291	# don't care. We're finished here.
1292	blt::busy hold $itk_component(hull)
1293	StopBufferingCommands
1294	blt::busy release $itk_component(hull)
1295	}
1296
1297	itcl::body Rappture::MapViewer::EnablePanningMouseBindings {} {
1298	if {$_useServerManip} {
1299	bind $itk_component(view) <ButtonPress-1> \
1300	[itcl::code $this MouseClick 1 %x %y]
1301	bind $itk_component(view) <B1-Motion> \
1302	[itcl::code $this MouseDrag 1 %x %y]
1303	bind $itk_component(view) <ButtonRelease-1> \
1304	[itcl::code $this MouseRelease 1 %x %y]
1305	} else {
1306	bind $itk_component(view) <ButtonPress-1> \
1307	[itcl::code $this Pan click %x %y]
1308	bind $itk_component(view) <B1-Motion> \
1309	[itcl::code $this Pan drag %x %y]
1310	bind $itk_component(view) <ButtonRelease-1> \
1311	[itcl::code $this Pan release %x %y]
1312	}
1313	}
1314
1315	itcl::body Rappture::MapViewer::DisablePanningMouseBindings {} {
1316	bind $itk_component(view) <ButtonPress-1> {}
1317	bind $itk_component(view) <B1-Motion> {}
1318	bind $itk_component(view) <ButtonRelease-1> {}
1319	}
1320
1321	itcl::body Rappture::MapViewer::EnableRotationMouseBindings {} {
1322	if {$_useServerManip} {
1323	bind $itk_component(view) <ButtonPress-2> \
1324	[itcl::code $this Rotate click %x %y]
1325	bind $itk_component(view) <B2-Motion> \
1326	[itcl::code $this Rotate drag %x %y]
1327	bind $itk_component(view) <ButtonRelease-2> \
1328	[itcl::code $this Rotate release %x %y]
1329	} else {
1330	# Bindings for rotation via mouse
1331	bind $itk_component(view) <ButtonPress-2> \
1332	[itcl::code $this MouseClick 2 %x %y]
1333	bind $itk_component(view) <B2-Motion> \
1334	[itcl::code $this MouseDrag 2 %x %y]
1335	bind $itk_component(view) <ButtonRelease-2> \
1336	[itcl::code $this MouseRelease 2 %x %y]
1337	}
1338	}
1339
1340	itcl::body Rappture::MapViewer::DisableRotationMouseBindings {} {
1341	bind $itk_component(view) <ButtonPress-2> {}
1342	bind $itk_component(view) <B2-Motion> {}
1343	bind $itk_component(view) <ButtonRelease-2> {}
1344	}
1345
1346	itcl::body Rappture::MapViewer::EnableZoomMouseBindings {} {
1347	if {$_useServerManip} {
1348	bind $itk_component(view) <ButtonPress-3> \
1349	[itcl::code $this MouseClick 3 %x %y]
1350	bind $itk_component(view) <B3-Motion> \
1351	[itcl::code $this MouseDrag 3 %x %y]
1352	bind $itk_component(view) <ButtonRelease-3> \
1353	[itcl::code $this MouseRelease 3 %x %y]
1354	} else {
1355	bind $itk_component(view) <ButtonPress-3> \
1356	[itcl::code $this Zoom click %x %y]
1357	bind $itk_component(view) <B3-Motion> \
1358	[itcl::code $this Zoom drag %x %y]
1359	bind $itk_component(view) <ButtonRelease-3> \
1360	[itcl::code $this Zoom release %x %y]
1361	}
1362	}
1363
1364	itcl::body Rappture::MapViewer::DisableZoomMouseBindings {} {
1365	bind $itk_component(view) <ButtonPress-3> {}
1366	bind $itk_component(view) <B3-Motion> {}
1367	bind $itk_component(view) <ButtonRelease-3> {}
1368	}
1369	# ----------------------------------------------------------------------
1370	# USAGE: CurrentLayers ?-all -visible? ?dataobjs?
1371	#
1372	# Returns a list of server IDs for the current datasets being displayed.
1373	# This is normally a single ID, but it might be a list of IDs if the
1374	# current data object has multiple components.
1375	# ----------------------------------------------------------------------
1376	itcl::body Rappture::MapViewer::CurrentLayers {args} {
1377	set flag [lindex $args 0]
1378	switch -- $flag {
1379	"-all" {
1380	if { [llength $args] > 1 } {
1381	error "CurrentLayers: can't specify dataobj after \"-all\""
1382	}
1383	set dlist [get -objects]
1384	}
1385	"-visible" {
1386	if { [llength $args] > 1 } {
1387	set dlist {}
1388	set args [lrange $args 1 end]
1389	foreach dataobj $args {
1390	if { [info exists _obj2ovride($dataobj-raise)] } {
1391	lappend dlist $dataobj
1392	}
1393	}
1394	} else {
1395	set dlist [get -visible]
1396	}
1397	}
1398	default {
1399	set dlist $args
1400	}
1401	}
1402	set rlist ""
1403	foreach dataobj $dlist {
1404	foreach layer [$dataobj layers] {
1405	if { [info exists _layers($layer)] && $_layers($layer) } {
1406	lappend rlist $layer
1407	}
1408	}
1409	}
1410	return $rlist
1411	}
1412
1413	itcl::body Rappture::MapViewer::KeyPress {k} {
1414	SendCmd "key press $k"
1415	}
1416
1417	itcl::body Rappture::MapViewer::KeyRelease {k} {
1418	SendCmd "key release $k"
1419	}
1420
1421	itcl::body Rappture::MapViewer::GetNormalizedMouse {x y} {
1422	set w [winfo width $itk_component(view)]
1423	set h [winfo height $itk_component(view)]
1424	set x [expr {(2.0 * double($x)/$w) - 1.0}]
1425	set y [expr {(2.0 * double($y)/$h) - 1.0}]
1426	return [list $x $y]
1427	}
1428
1429	itcl::body Rappture::MapViewer::MouseClick {button x y} {
1430	SendCmd "mouse click $button $x $y"
1431	}
1432
1433	itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1434	SendCmd "mouse dblclick $button $x $y"
1435	}
1436
1437	itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1438	SendCmd "mouse drag $button $x $y"
1439	}
1440
1441	itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1442	SendCmd "mouse release $button $x $y"
1443	}
1444
1445	itcl::body Rappture::MapViewer::MouseMotion {} {
1446	#SendCmd "mouse motion $_motion(x) $_motion(y)"
1447	SendCmd "map pin hover $_motion(x) $_motion(y)"
1448	set _motion(pending) 0
1449	}
1450
1451	itcl::body Rappture::MapViewer::MouseScroll {direction} {
1452	switch -- $direction {
1453	"up" {
1454	SendCmd "mouse scroll 1"
1455	}
1456	"down" {
1457	SendCmd "mouse scroll -1"
1458	}
1459	}
1460	}
1461
1462	#
1463	# EventuallyHandleMotionEvent --
1464	#
1465	# This routine compresses (no button press) motion events. It
1466	# delivers a server mouse command once every 100 milliseconds (if a
1467	# motion event is pending).
1468	#
1469	itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1470	set _motion(x) $x
1471	set _motion(y) $y
1472	if { !$_motion(compress) } {
1473	MouseMotion
1474	return
1475	}
1476	if { !$_motion(pending) } {
1477	set _motion(pending) 1
1478	$_dispatcher event -after $_motion(delay) !motion
1479	}
1480	}
1481
1482	# ----------------------------------------------------------------------
1483	# USAGE: Zoom in
1484	# USAGE: Zoom out
1485	# USAGE: Zoom reset
1486	# $this Zoom click x y
1487	# $this Zoom drag x y
1488	# $this Zoom release x y
1489	#
1490	# Called automatically when the user clicks on one of the zoom
1491	# controls for this widget. Changes the zoom for the current view.
1492	# Also implements mouse zoom.
1493	# ----------------------------------------------------------------------
1494	itcl::body Rappture::MapViewer::Zoom {option {x 0} {y 0}} {
1495	switch -- $option {
1496	"in" {
1497	# z here is normalized mouse Y delta
1498	set z -0.25
1499	SendCmd "camera zoom $z"
1500	}
1501	"out" {
1502	# z here is normalized mouse Y delta
1503	set z 0.25
1504	SendCmd "camera zoom $z"
1505	}
1506	"reset" {
1507	SendCmd "camera dist $_view(distance)"
1508	}
1509	"click" {
1510	set _click(x) $x
1511	set _click(y) $y
1512	$itk_component(view) configure -cursor hand1
1513	}
1514	"drag" {
1515	if { ![info exists _click(x)] } {
1516	set _click(x) $x
1517	}
1518	if { ![info exists _click(y)] } {
1519	set _click(y) $y
1520	}
1521	set h [winfo height $itk_component(view)]
1522	set dy [expr ($_click(y) - $y)/double($h)]
1523	set _click(x) $x
1524	set _click(y) $y
1525	if {[expr (abs($dy) > 0.0)]} {
1526	SendCmd "camera zoom $dy"
1527	}
1528	}
1529	"release" {
1530	Zoom drag $x $y
1531	$itk_component(view) configure -cursor ""
1532	}
1533	}
1534	}
1535
1536	# ----------------------------------------------------------------------
1537	# USAGE: Rotate click <x> <y>
1538	# USAGE: Rotate drag <x> <y>
1539	# USAGE: Rotate release <x> <y>
1540	#
1541	# Called automatically when the user clicks/drags/releases in the
1542	# plot area. Moves the plot according to the user's actions.
1543	# ----------------------------------------------------------------------
1544	itcl::body Rappture::MapViewer::Rotate {option x y} {
1545	switch -- $option {
1546	"click" {
1547	$itk_component(view) configure -cursor fleur
1548	set _click(x) $x
1549	set _click(y) $y
1550	set _rotate(azimuth) 0
1551	set _rotate(elevation) 0
1552	}
1553	"drag" {
1554	if {[array size _click] == 0} {
1555	Rotate click $x $y
1556	} else {
1557	set w [winfo width $itk_component(view)]
1558	set h [winfo height $itk_component(view)]
1559	if {$w <= 0 \|\| $h <= 0} {
1560	return
1561	}
1562	set dx [expr ($x - $_click(x))/double($w)]
1563	set dy [expr ($_click(y) - $y)/double($h)]
1564	set _click(x) $x
1565	set _click(y) $y
1566	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1567	#SendCmd "camera rotate $dx $dy"
1568	EventuallyRotate $dx $dy
1569	}
1570	}
1571	}
1572	"release" {
1573	Rotate drag $x $y
1574	$itk_component(view) configure -cursor ""
1575	catch {unset _click}
1576	}
1577	"set" {
1578	set w [winfo width $itk_component(view)]
1579	set h [winfo height $itk_component(view)]
1580	set dx [expr $x / double($w)]
1581	set dy [expr $y / double($h)]
1582	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1583	EventuallyRotate $dx $dy
1584	}
1585	}
1586	default {
1587	error "bad option \"$option\": should be click, drag, release"
1588	}
1589	}
1590	}
1591
1592	itcl::body Rappture::MapViewer::Select {option x y} {
1593	switch -- $option {
1594	"click" {
1595	set _click(x) $x
1596	set _click(y) $y
1597	set _b1mode "select"
1598	SendCmd "map box init $x $y"
1599	}
1600	"drag" {
1601	if {$_b1mode == "select"} {
1602	EventuallySelect $x $y
1603	}
1604	}
1605	"release" {
1606	set _b1mode ""
1607	if {$_click(x) == $x &&
1608	$_click(y) == $y} {
1609	SendCmd "map box clear"
1610	}
1611	}
1612	}
1613	}
1614
1615	itcl::body Rappture::MapViewer::Pin {option x y} {
1616	set _click(x) $x
1617	set _click(y) $y
1618	switch -- $option {
1619	"add" {
1620	incr _labelCount
1621	set label "Label $_labelCount"
1622	SendCmd [list "map" "pin" "add" $x $y [encoding convertto utf-8 $label]]
1623	}
1624	"delete" {
1625	SendCmd "map pin delete $x $y"
1626	}
1627	}
1628	}
1629
1630	# ----------------------------------------------------------------------
1631	# USAGE: $this Pan set x y
1632	# $this Pan click x y
1633	# $this Pan drag x y
1634	# $this Pan release x y
1635	#
1636	# Called automatically when the user clicks on one of the zoom
1637	# controls for this widget. Changes the zoom for the current view.
1638	# ----------------------------------------------------------------------
1639	itcl::body Rappture::MapViewer::Pan {option x y} {
1640	switch -- $option {
1641	"set" {
1642	set w [winfo width $itk_component(view)]
1643	set h [winfo height $itk_component(view)]
1644	set x [expr $x / double($w)]
1645	set y [expr $y / double($h)]
1646	if {[expr (abs($x) > 0.0 \|\| abs($y) > 0.0)]} {
1647	SendCmd "camera pan $x $y"
1648	}
1649	return
1650	}
1651	"click" {
1652	set _click(x) $x
1653	set _click(y) $y
1654	set _pan(x) 0
1655	set _pan(y) 0
1656	$itk_component(view) configure -cursor hand1
1657	set _b1mode "pan"
1658	}
1659	"drag" {
1660	if {$_b1mode != "pan"} {
1661	return
1662	}
1663	if { ![info exists _click(x)] } {
1664	set _click(x) $x
1665	}
1666	if { ![info exists _click(y)] } {
1667	set _click(y) $y
1668	}
1669	set w [winfo width $itk_component(view)]
1670	set h [winfo height $itk_component(view)]
1671	set dx [expr ($x - $_click(x))/double($w)]
1672	set dy [expr ($_click(y) - $y)/double($h)]
1673	set _click(x) $x
1674	set _click(y) $y
1675	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1676	EventuallyPan $dx $dy
1677	#SendCmd "camera pan $dx $dy"
1678	}
1679	}
1680	"release" {
1681	Pan drag $x $y
1682	$itk_component(view) configure -cursor ""
1683	set _b1mode ""
1684	}
1685	default {
1686	error "unknown option \"$option\": should set, click, drag, or release"
1687	}
1688	}
1689	}
1690
1691	itcl::body Rappture::MapViewer::SetHeading { {value 0} } {
1692	set _view(heading) $value
1693	camera set heading
1694	}
1695
1696	itcl::body Rappture::MapViewer::SetPitch { {value -89.999} } {
1697	set _view(pitch) $value
1698	camera set pitch
1699	}
1700
1701	# ----------------------------------------------------------------------
1702	# USAGE: InitSettings <what> ?<value>?
1703	#
1704	# Used internally to update rendering settings whenever parameters
1705	# change in the popup settings panel. Sends the new settings off
1706	# to the back end.
1707	# ----------------------------------------------------------------------
1708	itcl::body Rappture::MapViewer::InitSettings { args } {
1709	foreach setting $args {
1710	AdjustSetting $setting
1711	}
1712	}
1713
1714	#
1715	# AdjustSetting --
1716	#
1717	# Changes/updates a specific setting in the widget. There are
1718	# usually user-setable option. Commands are sent to the render
1719	# server.
1720	#
1721	itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1722	if { ![isconnected] } {
1723	return
1724	}
1725	switch -- $what {
1726	"coords-visible" - "coords-precision" - "coords-units" {
1727	set bool $_settings(coords-visible)
1728	set units $_settings(coords-units)
1729	set precision $_settings(coords-precision)
1730	SendCmd "map posdisp $bool $units $precision"
1731	}
1732	"grid" - "grid-type" {
1733	set bool $_settings(grid)
1734	set gridType $_settings(grid-type)
1735	SendCmd "map grid $bool $gridType"
1736	}
1737	"camera-throw" {
1738	set bool $_settings($what)
1739	SendCmd "camera throw $bool"
1740	}
1741	"terrain-edges" {
1742	set bool $_settings($what)
1743	SendCmd "map terrain edges $bool"
1744	}
1745	"terrain-lighting" {
1746	set bool $_settings($what)
1747	SendCmd "map terrain lighting $bool"
1748	}
1749	"terrain-palette" {
1750	set cmap [$itk_component(terrainpalette) value]
1751	#SendCmd "map terrain colormap $cmap"
1752	}
1753	"terrain-vertscale" {
1754	set val $_settings($what)
1755	SendCmd "map terrain vertscale $val"
1756	}
1757	"terrain-wireframe" {
1758	set bool $_settings($what)
1759	SendCmd "map terrain wireframe $bool"
1760	}
1761	"time" {
1762	set val $_settings($what)
1763	SendCmd "map time $val"
1764	}
1765	default {
1766	error "don't know how to fix $what"
1767	}
1768	}
1769	}
1770
1771	# ----------------------------------------------------------------------
1772	# CONFIGURATION OPTION: -plotbackground
1773	# ----------------------------------------------------------------------
1774	itcl::configbody Rappture::MapViewer::plotbackground {
1775	if { [isconnected] } {
1776	set rgb [Color2RGB $itk_option(-plotbackground)]
1777	SendCmd "screen bgcolor $rgb"
1778	}
1779	}
1780
1781	# ----------------------------------------------------------------------
1782	# CONFIGURATION OPTION: -plotforeground
1783	# ----------------------------------------------------------------------
1784	itcl::configbody Rappture::MapViewer::plotforeground {
1785	if { [isconnected] } {
1786	set rgb [Color2RGB $itk_option(-plotforeground)]
1787	# FIXME: Set font foreground colors
1788	}
1789	}
1790
1791	itcl::body Rappture::MapViewer::BuildMapTab {} {
1792	set fg [option get $itk_component(hull) font Font]
1793	#set bfg [option get $itk_component(hull) boldFont Font]
1794
1795	set inner [$itk_component(main) insert end \
1796	-title "Map Settings" \
1797	-icon [Rappture::icon wrench]]
1798	$inner configure -borderwidth 4
1799
1800	checkbutton $inner.posdisp \
1801	-text "Show Coordinate Readout" \
1802	-variable [itcl::scope _settings(coords-visible)] \
1803	-command [itcl::code $this AdjustSetting coords-visible] \
1804	-font "Arial 9" -anchor w
1805
1806	itk_component add grid {
1807	checkbutton $inner.grid \
1808	-text "Show Graticule" \
1809	-variable [itcl::scope _settings(grid)] \
1810	-command [itcl::code $this AdjustSetting grid] \
1811	-font "Arial 9" -anchor w
1812	} {
1813	ignore -font
1814	}
1815	Rappture::Tooltip::for $inner.grid "Toggle graticule (grid) display <g>"
1816
1817	checkbutton $inner.wireframe \
1818	-text "Show Wireframe" \
1819	-variable [itcl::scope _settings(terrain-wireframe)] \
1820	-command [itcl::code $this AdjustSetting terrain-wireframe] \
1821	-font "Arial 9" -anchor w
1822	Rappture::Tooltip::for $inner.wireframe "Toggle wireframe rendering of terrain geometry <w>"
1823
1824	checkbutton $inner.lighting \
1825	-text "Enable Lighting" \
1826	-variable [itcl::scope _settings(terrain-lighting)] \
1827	-command [itcl::code $this AdjustSetting terrain-lighting] \
1828	-font "Arial 9" -anchor w
1829	Rappture::Tooltip::for $inner.lighting "Toggle sky lighting of terrain <l>"
1830
1831	checkbutton $inner.edges \
1832	-text "Show Edges" \
1833	-variable [itcl::scope _settings(terrain-edges)] \
1834	-command [itcl::code $this AdjustSetting terrain-edges] \
1835	-font "Arial 9" -anchor w
1836
1837	itk_component add time_l {
1838	label $inner.time_l -text "Time (UTC)" -font "Arial 9"
1839	} {
1840	ignore -font
1841	}
1842	itk_component add time {
1843	::scale $inner.time -from 0 -to 23.9 -orient horizontal \
1844	-resolution 0.1 \
1845	-variable [itcl::scope _settings(time)] \
1846	-width 10 \
1847	-showvalue on \
1848	-command [itcl::code $this AdjustSetting time]
1849	}
1850
1851	blt::table $inner \
1852	0,0 $inner.posdisp -cspan 2 -anchor w -pady 2 \
1853	1,0 $inner.grid -cspan 2 -anchor w -pady 2 \
1854	2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
1855	3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \
1856	4,0 $inner.time_l -cspan 2 -anchor w -pady 2 \
1857	4,1 $inner.time -cspan 2 -fill x -pady 2
1858	# 4,0 $inner.edges -cspan 2 -anchor w -pady 2
1859
1860	blt::table configure $inner r* c* -resize none
1861	blt::table configure $inner r5 c1 -resize expand
1862	}
1863
1864	itcl::body Rappture::MapViewer::BuildTerrainTab {} {
1865	set fg [option get $itk_component(hull) font Font]
1866	#set bfg [option get $itk_component(hull) boldFont Font]
1867
1868	set inner [$itk_component(main) insert end \
1869	-title "Terrain Settings" \
1870	-icon [Rappture::icon terrain]]
1871	$inner configure -borderwidth 4
1872
1873	label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
1874	itk_component add terrainpalette {
1875	Rappture::Combobox $inner.palette -width 10 -editable no
1876	}
1877	$inner.palette choices insert end [GetColormapList]
1878
1879	$itk_component(terrainpalette) value "BCGYR"
1880	bind $inner.palette <<Value>> \
1881	[itcl::code $this AdjustSetting terrain-palette]
1882
1883	itk_component add vscale_l {
1884	label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
1885	}
1886	itk_component add vscale {
1887	::scale $inner.vscale -from 0 -to 10 -orient horizontal \
1888	-variable [itcl::scope _settings(terrain-vertscale)] \
1889	-width 10 \
1890	-resolution 0.1 \
1891	-showvalue on \
1892	-command [itcl::code $this AdjustSetting terrain-vertscale]
1893	}
1894	$inner.vscale set $_settings(terrain-vertscale)
1895
1896	blt::table $inner \
1897	0,0 $inner.vscale_l -anchor w -pady 2 \
1898	0,1 $inner.vscale -fill x -pady 2
1899	# 1,0 $inner.palette_l -anchor w -pady 2 \
1900	# 1,1 $inner.palette -fill x -pady 2
1901
1902	blt::table configure $inner r* c* -resize none
1903	blt::table configure $inner r3 c1 -resize expand
1904	}
1905
1906	itcl::body Rappture::MapViewer::BuildLayerTab {} {
1907	set fg [option get $itk_component(hull) font Font]
1908	#set bfg [option get $itk_component(hull) boldFont Font]
1909
1910	set inner [$itk_component(main) insert end \
1911	-title "Layers" \
1912	-icon [Rappture::icon layers]]
1913	$inner configure -borderwidth 4
1914	set f [frame $inner.layers]
1915	blt::table $inner \
1916	0,0 $f -fill both
1917	set _layersFrame $inner
1918	}
1919
1920	itcl::body Rappture::MapViewer::BuildViewpointsTab {} {
1921	set fg [option get $itk_component(hull) font Font]
1922	#set bfg [option get $itk_component(hull) boldFont Font]
1923
1924	set inner [$itk_component(main) insert end \
1925	-title "Places" \
1926	-icon [Rappture::icon placemark16]]
1927	$inner configure -borderwidth 4
1928	set f [frame $inner.viewpoints]
1929	blt::table $inner \
1930	0,0 $f -fill both
1931	set _viewpointsFrame $inner
1932	}
1933
1934	itcl::body Rappture::MapViewer::BuildCameraTab {} {
1935	set inner [$itk_component(main) insert end \
1936	-title "Camera Settings" \
1937	-icon [Rappture::icon camera]]
1938	$inner configure -borderwidth 4
1939
1940	set row 0
1941
1942	set labels { x y z heading pitch distance }
1943	foreach tag $labels {
1944	label $inner.${tag}label -text $tag -font "Arial 9"
1945	entry $inner.${tag} -font "Arial 9" -bg white \
1946	-textvariable [itcl::scope _view($tag)]
1947	bind $inner.${tag} <KeyPress-Return> \
1948	[itcl::code $this camera set ${tag}]
1949	bind $inner.${tag} <KP_Enter> \
1950	[itcl::code $this camera set ${tag}]
1951	blt::table $inner \
1952	$row,0 $inner.${tag}label -anchor e -pady 2 \
1953	$row,1 $inner.${tag} -anchor w -pady 2
1954	blt::table configure $inner r$row -resize none
1955	incr row
1956	}
1957	set labels { srs verticalDatum }
1958	foreach tag $labels {
1959	label $inner.${tag}label -text $tag -font "Arial 9"
1960	entry $inner.${tag} -font "Arial 9" -bg white \
1961	-textvariable [itcl::scope _view($tag)]
1962	bind $inner.${tag} <KeyPress-Return> \
1963	[itcl::code $this camera set ${tag}]
1964	bind $inner.${tag} <KP_Enter> \
1965	[itcl::code $this camera set ${tag}]
1966	blt::table $inner \
1967	$row,0 $inner.${tag}label -anchor e -pady 2 \
1968	$row,1 $inner.${tag} -anchor w -pady 2
1969	blt::table configure $inner r$row -resize none
1970	incr row
1971	}
1972
1973	if {0} {
1974	button $inner.get \
1975	-text "Get Camera Settings" \
1976	-font "Arial 9" \
1977	-command [itcl::code $this SendCmd "camera get"]
1978	blt::table $inner \
1979	$row,0 $inner.get -anchor w -pady 2 -cspan 2
1980	blt::table configure $inner r$row -resize none
1981	incr row
1982
1983	button $inner.set \
1984	-text "Apply Camera Settings" \
1985	-font "Arial 9" \
1986	-command [itcl::code $this camera set all]
1987	blt::table $inner \
1988	$row,0 $inner.set -anchor w -pady 2 -cspan 2
1989	blt::table configure $inner r$row -resize none
1990	incr row
1991	}
1992
1993	if {$_useServerManip} {
1994	checkbutton $inner.throw \
1995	-text "Enable Throw" \
1996	-font "Arial 9" \
1997	-variable [itcl::scope _settings(camera-throw)] \
1998	-command [itcl::code $this AdjustSetting camera-throw]
1999	blt::table $inner \
2000	$row,0 $inner.throw -anchor w -pady 2 -cspan 2
2001	blt::table configure $inner r$row -resize none
2002	incr row
2003	}
2004
2005	label $inner.heading_slider_l -text "Heading" -font "Arial 9"
2006	::scale $inner.heading_slider -font "Arial 9" \
2007	-from -180 -to 180 -orient horizontal \
2008	-variable [itcl::scope _view(heading)] \
2009	-width 10 \
2010	-showvalue on \
2011	-command [itcl::code $this camera set heading]
2012
2013	blt::table $inner \
2014	$row,0 $inner.heading_slider_l -anchor w -pady 2
2015	blt::table $inner \
2016	$row,1 $inner.heading_slider -fill x -anchor w -pady 2
2017	blt::table configure $inner r$row -resize none
2018	incr row
2019
2020	itk_component add pitch_slider_l {
2021	label $inner.pitch_slider_l -text "Pitch" -font "Arial 9"
2022	}
2023	itk_component add pitch_slider {
2024	::scale $inner.pitch_slider -font "Arial 9" \
2025	-from -10 -to -90 -orient horizontal \
2026	-variable [itcl::scope _view(pitch)] \
2027	-width 10 \
2028	-showvalue on \
2029	-command [itcl::code $this camera set pitch]
2030	}
2031
2032	blt::table $inner \
2033	$row,0 $inner.pitch_slider_l -anchor w -pady 2
2034	blt::table $inner \
2035	$row,1 $inner.pitch_slider -fill x -anchor w -pady 2
2036	blt::table configure $inner r$row -resize none
2037	incr row
2038
2039	blt::table configure $inner c* r* -resize none
2040	blt::table configure $inner c2 -resize expand
2041	blt::table configure $inner r$row -resize expand
2042	}
2043
2044	itcl::body Rappture::MapViewer::BuildHelpTab {} {
2045	set fg [option get $itk_component(hull) font Font]
2046	#set bfg [option get $itk_component(hull) boldFont Font]
2047
2048	set inner [$itk_component(main) insert end \
2049	-title "Help" \
2050	-icon [Rappture::icon question_mark12]]
2051	$inner configure -borderwidth 4
2052
2053	set helptext {*************************
2054	Mouse bindings:
2055	*************************
2056	Left - Panning
2057	Middle - Rotation
2058	Right - Zoom
2059
2060	Zoom/travel:
2061	Left double-click:
2062	Zoom to point
2063	Left shift-double:
2064	Travel to point
2065	Right double-click:
2066	Zoom out from point
2067
2068	Pins:
2069	Ctl-Left: Drop pin
2070	Ctl-Right: Delete pin
2071
2072	Select:
2073	Shift-Left click-drag
2074
2075	*************************
2076	Keyboard bindings:
2077	*************************
2078	g - Toggle graticule
2079	l - Toggle lighting
2080	n - Set North up
2081	p - Reset pitch
2082	w - Toggle wireframe
2083	arrows - panning
2084	Shift-arrows - fine pan
2085	Ctl-arrows - rotation
2086	Ctl-Shift-arrows:
2087	fine rotation
2088	PgUp/PgDown - zoom
2089	Home - Reset camera
2090	*************************}
2091
2092	text $inner.info -width 25 -bg white
2093	$inner.info insert end $helptext
2094	$inner.info configure -state disabled
2095	blt::table $inner \
2096	0,0 $inner.info -fill both
2097	}
2098
2099	#
2100	# camera --
2101	#
2102	# USAGE: camera get
2103	# This is called by the server to transfer the
2104	# current Viewpoint settings
2105	# USAGE: camera reset
2106	# Reset the camera to the default view
2107	#
2108	itcl::body Rappture::MapViewer::camera {option args} {
2109	switch -- $option {
2110	"get" {
2111	# We got the camera settings from the server
2112	foreach name {x y z heading pitch distance srs verticalDatum} value $args {
2113	set _view($name) $value
2114	}
2115	# puts stderr "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
2116	}
2117	"go" {
2118	SendCmd "camera go $args"
2119	}
2120	"reset" {
2121	array set _view {
2122	x 0.0
2123	y 0.0
2124	z 0.0
2125	heading 0.0
2126	pitch -89.9
2127	distance 1.0
2128	srs ""
2129	verticalDatum ""
2130	}
2131	if { [info exists _mapsettings(camera)] } {
2132	# Check if the tool specified a default
2133	set location $_mapsettings(camera)
2134	if { $location != "" } {
2135	array set _view $location
2136	set duration 0.0
2137	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2138	} else {
2139	SendCmd "camera reset"
2140	# Retrieve the settings
2141	#SendCmd "camera get"
2142	}
2143	} else {
2144	SendCmd "camera reset"
2145	# Retrieve the settings
2146	# SendCmd "camera get"
2147	}
2148	}
2149	"set" {
2150	set who [lindex $args 0]
2151	if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
2152	set val $_view($who)
2153	set code [catch { string is double $val } result]
2154	if { $code != 0 \|\| !$result } {
2155	return
2156	}
2157	}
2158	switch -- $who {
2159	"distance" {
2160	SendCmd [list camera dist $_view(distance)]
2161	}
2162	"all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
2163	set duration 0.0
2164	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2165	}
2166	}
2167	}
2168	}
2169	}
2170
2171	itcl::body Rappture::MapViewer::GoToViewpoint { dataobj viewpoint } {
2172	array set view [subst {
2173	x 0
2174	y 0
2175	z 0
2176	heading 0
2177	pitch -90
2178	distance $_view(distance)
2179	srs "$_view(srs)"
2180	verticalDatum "$_view(verticalDatum)"
2181	}]
2182	array set view [$dataobj viewpoint $viewpoint]
2183	foreach key {x y z heading pitch distance srs verticalDatum} {
2184	if { [info exists view($key)] } {
2185	set _view($key) $view($key)
2186	}
2187	}
2188	# If map is projected, ignore pitch
2189	if {![MapIsGeocentric]} {
2190	set _view(pitch) -90
2191	}
2192	set duration 2.0
2193	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2194	}
2195
2196	itcl::body Rappture::MapViewer::GetImage { args } {
2197	if { [image width $_image(download)] > 0 &&
2198	[image height $_image(download)] > 0 } {
2199	set bytes [$_image(download) data -format "jpeg -quality 100"]
2200	set bytes [Rappture::encoding::decode -as b64 $bytes]
2201	return [list .jpg $bytes]
2202	}
2203	return ""
2204	}
2205
2206	itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
2207	Rappture::Balloon $popup \
2208	-title "[Rappture::filexfer::label downloadWord] as..."
2209	set inner [$popup component inner]
2210	label $inner.summary -text "" -anchor w
2211
2212	radiobutton $inner.image_button -text "Image File" \
2213	-variable [itcl::scope _downloadPopup(format)] \
2214	-value image
2215	Rappture::Tooltip::for $inner.image_button \
2216	"Save as digital image."
2217
2218	button $inner.ok -text "Save" \
2219	-highlightthickness 0 -pady 2 -padx 3 \
2220	-command $command \
2221	-compound left \
2222	-image [Rappture::icon download]
2223
2224	button $inner.cancel -text "Cancel" \
2225	-highlightthickness 0 -pady 2 -padx 3 \
2226	-command [list $popup deactivate] \
2227	-compound left \
2228	-image [Rappture::icon cancel]
2229
2230	blt::table $inner \
2231	0,0 $inner.summary -cspan 2 \
2232	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2233	4,1 $inner.cancel -width .9i -fill y \
2234	4,0 $inner.ok -padx 2 -width .9i -fill y
2235	blt::table configure $inner r3 -height 4
2236	blt::table configure $inner r4 -pady 4
2237	raise $inner.image_button
2238	$inner.image_button invoke
2239	return $inner
2240	}
2241
2242	itcl::body Rappture::MapViewer::ToggleGrid {} {
2243	set _settings(grid) [expr !$_settings(grid)]
2244	AdjustSetting grid
2245	}
2246
2247	itcl::body Rappture::MapViewer::ToggleLighting {} {
2248	set _settings(terrain-lighting) [expr !$_settings(terrain-lighting)]
2249	AdjustSetting terrain-lighting
2250	}
2251
2252	itcl::body Rappture::MapViewer::ToggleWireframe {} {
2253	set _settings(terrain-wireframe) [expr !$_settings(terrain-wireframe)]
2254	AdjustSetting terrain-wireframe
2255	}
2256
2257	itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
2258	array set settings {
2259	-color white
2260	-edgecolor black
2261	-edges 0
2262	-lighting 0
2263	-linewidth 1.0
2264	-vertscale 1.0
2265	-wireframe 0
2266	}
2267	array set settings $style
2268
2269	SendCmd "map terrain edges $settings(-edges)"
2270	set _settings(terrain-edges) $settings(-edges)
2271	SendCmd "map terrain color [Color2RGB $settings(-color)]"
2272	#SendCmd "map terrain colormode constant"
2273	SendCmd "map terrain lighting $settings(-lighting)"
2274	set _settings(terrain-lighting) $settings(-lighting)
2275	SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
2276	#SendCmd "map terrain linewidth $settings(-linewidth)"
2277	SendCmd "map terrain vertscale $settings(-vertscale)"
2278	set _settings(terrain-vertscale) $settings(-vertscale)
2279	SendCmd "map terrain wireframe $settings(-wireframe)"
2280	set _settings(terrain-wireframe) $settings(-wireframe)
2281	}
2282
2283	itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
2284	array set info [$dataobj layer $layer]
2285	set _visibility($layer) 1
2286
2287	switch -- $info(type) {
2288	"image" {
2289	array set settings {
2290	-minlevel 0
2291	-maxlevel 23
2292	-opacity 1.0
2293	}
2294	if { [info exists info(style)] } {
2295	array set settings $info(style)
2296	}
2297	if { [info exists info(opacity)] } {
2298	set settings(-opacity) $info(opacity)
2299	set _opacity($layer) $info(opacity)
2300	}
2301	set _opacity($layer) [expr $settings(-opacity) * 100]
2302	if {!$_sendEarthFile} {
2303	switch -- $info(driver) {
2304	"colorramp" {
2305	set cmapName $layer
2306	SendCmd [list colormap define $cmapName $info(colorramp.colormap)]
2307	SendCmd [list map layer add $layer image colorramp \
2308	$info(colorramp.url) $info(cache) $info(colorramp.elevdriver) $info(profile) \
2309	$cmapName]
2310	}
2311	"debug" {
2312	SendCmd [list map layer add $layer image debug]
2313	}
2314	"gdal" {
2315	SendCmd [list map layer add $layer image gdal \
2316	$info(gdal.url) $info(cache)]
2317	}
2318	"tms" {
2319	SendCmd [list map layer add $layer image tms \
2320	$info(tms.url) $info(cache)]
2321	}
2322	"wms" {
2323	SendCmd [list map layer add $layer image wms \
2324	$info(wms.url) $info(cache) \
2325	$info(wms.layers) \
2326	$info(wms.format) \
2327	$info(wms.transparent)]
2328	}
2329	"xyz" {
2330	SendCmd [list map layer add $layer image xyz \
2331	$info(xyz.url) $info(cache)]
2332	}
2333	}
2334	}
2335	SendCmd "map layer opacity $settings(-opacity) $layer"
2336	}
2337	"elevation" {
2338	array set settings {
2339	-minlevel 0
2340	-maxlevel 23
2341	}
2342	if { [info exists info(style)] } {
2343	array set settings $info(style)
2344	}
2345	if {!$_sendEarthFile} {
2346	switch -- $info(driver) {
2347	"gdal" {
2348	SendCmd [list map layer add $layer elevation gdal \
2349	$info(gdal.url)]
2350	}
2351	"tms" {
2352	SendCmd [list map layer add $layer elevation tms \
2353	$info(tms.url)]
2354	}
2355	}
2356	}
2357	}
2358	"line" {
2359	array set settings {
2360	-color black
2361	-minbias 1000
2362	-opacity 1.0
2363	-width 1
2364	}
2365	if { [info exists info(style)] } {
2366	array set settings $info(style)
2367	}
2368	if { [info exists info(opacity)] } {
2369	set settings(-opacity) $info(opacity)
2370	}
2371	set _opacity($layer) [expr $settings(-opacity) * 100]
2372	foreach {r g b} [Color2RGB $settings(-color)] {}
2373	if {[info exists settings(-minrange)] && [info exists settings(-maxrange)]} {
2374	SendCmd [list map layer add $layer line $info(ogr.url) $r $g $b $settings(-width) $settings(-minrange) $settings(-maxrange)]
2375	} else {
2376	SendCmd [list map layer add $layer line $info(ogr.url) $r $g $b $settings(-width)]
2377	}
2378	SendCmd "map layer opacity $settings(-opacity) $layer"
2379	}
2380	"point" {
2381	array set settings {
2382	-color black
2383	-minbias 1000
2384	-opacity 1.0
2385	-size 1
2386	}
2387	if { [info exists info(style)] } {
2388	array set settings $info(style)
2389	}
2390	if { [info exists info(opacity)] } {
2391	set settings(-opacity) $info(opacity)
2392	}
2393	set _opacity($layer) [expr $settings(-opacity) * 100]
2394	foreach {r g b} [Color2RGB $settings(-color)] {}
2395	SendCmd [list map layer add $layer point $info(ogr.url) $r $g $b $settings(-size)]
2396	SendCmd "map layer opacity $settings(-opacity) $layer"
2397	}
2398	"polygon" {
2399	array set settings {
2400	-color white
2401	-minbias 1000
2402	-opacity 1.0
2403	}
2404	if { [info exists info(style)] } {
2405	array set settings $info(style)
2406	}
2407	if { [info exists info(opacity)] } {
2408	set settings(-opacity) $info(opacity)
2409	}
2410	set _opacity($layer) [expr $settings(-opacity) * 100]
2411	foreach {r g b} [Color2RGB $settings(-color)] {}
2412	SendCmd [list map layer add $layer polygon $info(ogr.url) $r $g $b]
2413	SendCmd "map layer opacity $settings(-opacity) $layer"
2414	}
2415	"label" {
2416	array set settings {
2417	-align "center-center"
2418	-color black
2419	-declutter 1
2420	-font Arial
2421	-fontsize 16.0
2422	-halocolor white
2423	-halowidth 2.0
2424	-layout "left-to-right"
2425	-minbias 1000
2426	-opacity 1.0
2427	-removedupes 1
2428	}
2429	if { [info exists info(style)] } {
2430	array set settings $info(style)
2431	}
2432	if { [info exists info(opacity)] } {
2433	set settings(-opacity) $info(opacity)
2434	}
2435	set _opacity($layer) [expr $settings(-opacity) * 100]
2436	set contentExpr $info(content)
2437	if {[info exists info(priority)]} {
2438	set priorityExpr $info(priority)
2439	} else {
2440	set priorityExpr ""
2441	}
2442	foreach {fgR fgG fgB} [Color2RGB $settings(-color)] {}
2443	foreach {bgR bgG bgB} [Color2RGB $settings(-halocolor)] {}
2444	if {[info exists settings(-minrange)] && [info exists settings(-maxrange)]} {
2445	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)]
2446	} else {
2447	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)]
2448	}
2449	SendCmd "map layer opacity $settings(-opacity) $layer"
2450	}
2451	}
2452
2453	if { [info exists info(visible)] } {
2454	if { !$info(visible) } {
2455	set _visibility($layer) 0
2456	SendCmd "map layer visible 0 $layer"
2457	}
2458	}
2459	}
2460
2461	itcl::body Rappture::MapViewer::SetLayerOpacity { dataobj layer {value 100}} {
2462	set val $_opacity($layer)
2463	set sval [expr { 0.01 * double($val) }]
2464	SendCmd "map layer opacity $sval $layer"
2465	}
2466
2467	itcl::body Rappture::MapViewer::SetLayerVisibility { dataobj layer } {
2468	set bool $_visibility($layer)
2469	SendCmd "map layer visible $bool $layer"
2470	}
2471
2472	itcl::body Rappture::MapViewer::UpdateLayerControls {} {
2473	set row 0
2474	set inner $_layersFrame
2475	if { [winfo exists $inner.layers] } {
2476	foreach w [winfo children $inner.layers] {
2477	destroy $w
2478	}
2479	}
2480	set f $inner.layers
2481	set attrib [list]
2482	set imgIdx 0
2483	foreach dataobj [get -objects] {
2484	foreach layer [$dataobj layers] {
2485	array unset info
2486	array set info [$dataobj layer $layer]
2487	checkbutton $f.${layer}_visible \
2488	-text $info(label) \
2489	-font "Arial 9" -anchor w \
2490	-variable [itcl::scope _visibility($layer)] \
2491	-command [itcl::code $this \
2492	SetLayerVisibility $dataobj $layer]
2493	blt::table $f $row,0 $f.${layer}_visible -anchor w -pady 2 -cspan 2
2494	incr row
2495	if { $info(type) == "image" } {
2496	incr imgIdx
2497	if { $info(driver) == "colorramp" } {
2498	set colormap $layer
2499	if { ![info exists _image(legend-$colormap)] } {
2500	set _image(legend-$colormap) [image create photo]
2501	}
2502	itk_component add legend-$colormap-min {
2503	label $f.${layer}_legend-$colormap-min -text 0
2504	}
2505	itk_component add legend-$colormap-max {
2506	label $f.${layer}_legend-$colormap-max -text 1
2507	}
2508	itk_component add legend-$colormap {
2509	label $f.${layer}_legend-$colormap -image $_image(legend-$colormap)
2510	}
2511	blt::table $f $row,0 $f.${layer}_legend-$colormap-min -anchor w -pady 0
2512	blt::table $f $row,1 $f.${layer}_legend-$colormap-max -anchor e -pady 0
2513	incr row
2514	blt::table $f $row,0 $f.${layer}_legend-$colormap -anchor w -pady 2 -cspan 2
2515	incr row
2516	RequestLegend $colormap 256 16
2517	}
2518	}
2519	if { $info(type) != "elevation" && ($info(type) != "image" \|\| $imgIdx > 1) } {
2520	label $f.${layer}_opacity_l -text "Opacity" -font "Arial 9"
2521	::scale $f.${layer}_opacity -from 0 -to 100 \
2522	-orient horizontal -showvalue off \
2523	-variable [itcl::scope _opacity($layer)] \
2524	-width 10 \
2525	-command [itcl::code $this \
2526	SetLayerOpacity $dataobj $layer]
2527	Rappture::Tooltip::for $f.${layer}_opacity "Set opacity of $info(label) layer"
2528	blt::table $f $row,0 $f.${layer}_opacity_l -anchor w -pady 2
2529	blt::table $f $row,1 $f.${layer}_opacity -anchor w -pady 2
2530	incr row
2531	}
2532	set tooltip [list $info(description)]
2533	if { [info exists info(attribution)] &&
2534	$info(attribution) != ""} {
2535	lappend tooltip $info(attribution)
2536	}
2537	Rappture::Tooltip::for $f.${layer}_visible [join $tooltip \n]
2538	}
2539	set mapAttrib [$dataobj hints "attribution"]
2540	if { $mapAttrib != "" } {
2541	lappend attrib $mapAttrib
2542	}
2543	}
2544	SendCmd "[list map attrib [encoding convertto utf-8 [join $attrib ,]]]"
2545	label $f.map_attrib -text [join $attrib \n] -font "Arial 9"
2546	blt::table $f $row,0 $f.map_attrib -anchor sw -pady 2 -cspan 2
2547	#incr row
2548	if { $row > 0 } {
2549	blt::table configure $f r* c* -resize none
2550	blt::table configure $f r$row c1 -resize expand
2551	}
2552	}
2553
2554	itcl::body Rappture::MapViewer::UpdateViewpointControls {} {
2555	set row 0
2556	set inner $_viewpointsFrame
2557	if { [winfo exists $inner.viewpoints] } {
2558	foreach w [winfo children $inner.viewpoints] {
2559	destroy $w
2560	}
2561	}
2562	set f $inner.viewpoints
2563	foreach dataobj [get -objects] {
2564	foreach viewpoint [$dataobj viewpoints] {
2565	array unset info
2566	array set info [$dataobj viewpoint $viewpoint]
2567	button $f.${viewpoint}_go \
2568	-relief flat -compound left \
2569	-image [Rappture::icon placemark16] \
2570	-text $info(label) \
2571	-font "Arial 9" -anchor w \
2572	-command [itcl::code $this \
2573	GoToViewpoint $dataobj $viewpoint]
2574	label $f.${viewpoint}_label \
2575	-text $info(label) \
2576	-font "Arial 9" -anchor w
2577	blt::table $f $row,0 $f.${viewpoint}_go -anchor w -pady 2 -cspan 2
2578	#blt::table $f $row,1 $f.${viewpoint}_label -anchor w -pady 2
2579	Rappture::Tooltip::for $f.${viewpoint}_go $info(description)
2580	incr row
2581	}
2582	}
2583	if { $row > 0 } {
2584	blt::table configure $f r* c* -resize none
2585	blt::table configure $f r$row c1 -resize expand
2586	}
2587	}
2588
2589	#
2590	# Generate an OSG Earth file to send to server. This is inteneded
2591	# as a stopgap and testing tool until the protocol is fleshed out.
2592	#
2593	# Note that the lighting settings are required to be "hard-coded"
2594	# as below for the runtime control to work. Don't make those user
2595	# configurable.
2596	#
2597	# Also note: Use "true"/"false" for boolean settings. Not sure if
2598	# the parser in OSG Earth accepts all of Tcl's forms of boolean vals.
2599	#
2600	itcl::body Rappture::MapViewer::EarthFile {} {
2601	append out "<map"
2602	append out " name=\"$_mapsettings(label)\""
2603	append out " type=\"$_mapsettings(type)\""
2604	append out " version=\"2\""
2605	append out ">\n"
2606	append out " <options lighting=\"true\">\n"
2607	# FIXME: convert color setting to hex
2608	# array set style $_mapsettings(style)
2609	# if {[info exists style(-color)]} {
2610	# set color "?"
2611	# }
2612	set color "#ffffffff"
2613	append out " <terrain lighting=\"false\" color=\"$color\"/>\n"
2614	if { [info exists _mapsettings(projection)] } {
2615	append out " <profile"
2616	append out " srs=\"$_mapsettings(projection)\""
2617	if { [info exists _mapsettings(extents)] } {
2618	append out " xmin=\"$_mapsettings(x1)\""
2619	append out " ymin=\"$_mapsettings(y1)\""
2620	append out " xmax=\"$_mapsettings(x2)\""
2621	append out " ymax=\"$_mapsettings(y2)\""
2622	}
2623	append out "/>\n"
2624	}
2625	append out " </options>\n"
2626
2627	foreach dataobj [get -objects] {
2628	foreach layer [$dataobj layers] {
2629	set _layers($layer) 1
2630	array unset info
2631	array set info [$dataobj layer $layer]
2632	switch -- $info(type) {
2633	"image" {
2634	append out " <image"
2635	append out " name=\"$layer\""
2636	append out " driver=\"gdal\""
2637	if { [info exists info(opacity)] } {
2638	append out " opacity=\"$info(opacity)\""
2639	}
2640	if { $info(visible) } {
2641	append out " visible=\"true\""
2642	} else {
2643	append out " visible=\"false\""
2644	}
2645	append out ">\n"
2646	append out " <url>$info(url)</url>\n"
2647	append out " </image>\n"
2648	}
2649	"elevation" {
2650	append out " <elevation"
2651	append out " name=\"$layer\""
2652	append out " driver=\"gdal\""
2653	if { $info(visible) } {
2654	append out " visible=\"true\""
2655	} else {
2656	append out " visible=\"false\""
2657	}
2658	append out ">\n"
2659	append out " <url>$info(url)</url>\n"
2660	append out " </elevation>\n"
2661	}
2662	default {
2663	puts stderr "Type $info(type) not implemented in MapViewer::EarthFile"
2664	}
2665	}
2666	}
2667	}
2668	append out "</map>\n"
2669	return $out
2670	}

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

Download in other formats: