Context Navigation

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

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

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

Download in other formats: