Context Navigation

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

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

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

Download in other formats: