Context Navigation

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

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

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

Download in other formats: