Context Navigation

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

Last change on this file since 6480 was 6452, checked in by ldelgass, 8 years ago
fix cut/paste error
File size: 120.7 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: mapviewer - Map object viewer
4	#
5	# It connects to the GeoVis server running on a rendering farm,
6	# transmits data, and displays the results.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-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 This
1374	# 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	EventuallySelect $x $y
1859	}
1860	}
1861	"release" {
1862	set _b1mode ""
1863	if {$_click(x) == $x &&
1864	$_click(y) == $y} {
1865	SendCmd "map box clear"
1866	} else {
1867	SendCmd "map box end $x $y"
1868	}
1869	}
1870	}
1871	}
1872
1873	itcl::body Rappture::MapViewer::Pin {option x y} {
1874	set _click(x) $x
1875	set _click(y) $y
1876	switch -- $option {
1877	"add" {
1878	incr _labelCount
1879	set label "Label $_labelCount"
1880	SendCmd [list "map" "pin" "add" $x $y [encoding convertto utf-8 $label]]
1881	}
1882	"delete" {
1883	SendCmd "map pin delete $x $y"
1884	}
1885	}
1886	}
1887
1888	# ----------------------------------------------------------------------
1889	# USAGE: $this Pan set x y
1890	# $this Pan click x y
1891	# $this Pan drag x y
1892	# $this Pan release x y
1893	#
1894	# Called automatically when the user clicks on one of the zoom
1895	# controls for this widget. Changes the zoom for the current view.
1896	# ----------------------------------------------------------------------
1897	itcl::body Rappture::MapViewer::Pan {option x y} {
1898	switch -- $option {
1899	"click" {
1900	set _click(x) $x
1901	set _click(y) $y
1902	set _pan(x) 0
1903	set _pan(y) 0
1904	$itk_component(view) configure -cursor hand1
1905	set _b1mode "pan"
1906	}
1907	"drag" {
1908	if {$_b1mode != "pan"} {
1909	return
1910	}
1911	if { ![info exists _click(x)] } {
1912	set _click(x) $x
1913	}
1914	if { ![info exists _click(y)] } {
1915	set _click(y) $y
1916	}
1917	set w [winfo width $itk_component(view)]
1918	set h [winfo height $itk_component(view)]
1919	set dx [expr ($x - $_click(x))/double($w)]
1920	set dy [expr ($_click(y) - $y)/double($h)]
1921	set _click(x) $x
1922	set _click(y) $y
1923	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1924	EventuallyPan $dx $dy
1925	#SendCmd "camera pan $dx $dy"
1926	}
1927	}
1928	"release" {
1929	Pan drag $x $y
1930	$itk_component(view) configure -cursor ""
1931	set _b1mode ""
1932	}
1933	"set" {
1934	set w [winfo width $itk_component(view)]
1935	set h [winfo height $itk_component(view)]
1936	set x [expr $x / double($w)]
1937	set y [expr $y / double($h)]
1938	if {[expr (abs($x) > 0.0 \|\| abs($y) > 0.0)]} {
1939	SendCmd "camera pan $x $y"
1940	}
1941	return
1942	}
1943	default {
1944	error "unknown option \"$option\": should set, click, drag, or release"
1945	}
1946	}
1947	}
1948
1949	itcl::body Rappture::MapViewer::SetHeading { {value 0} } {
1950	set _view(heading) $value
1951	Camera set heading
1952	}
1953
1954	itcl::body Rappture::MapViewer::SetPitch { {value -89.999} } {
1955	set _view(pitch) $value
1956	Camera set pitch
1957	}
1958
1959	# ----------------------------------------------------------------------
1960	# USAGE: InitSettings <what> ?<value>?
1961	#
1962	# Used internally to update rendering settings whenever parameters
1963	# change in the popup settings panel. Sends the new settings off
1964	# to the back end.
1965	# ----------------------------------------------------------------------
1966	itcl::body Rappture::MapViewer::InitSettings { args } {
1967	foreach setting $args {
1968	AdjustSetting $setting
1969	}
1970	}
1971
1972	#
1973	# AdjustSetting --
1974	#
1975	# Changes/updates a specific setting in the widget. There are
1976	# usually user-setable option. Commands are sent to the render
1977	# server.
1978	#
1979	itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1980	if { ![isconnected] } {
1981	return
1982	}
1983	switch -- $what {
1984	"coords-visible" - "coords-precision" - "coords-units" {
1985	set bool $_settings(coords-visible)
1986	set units $_settings(coords-units)
1987	set precision $_settings(coords-precision)
1988	SendCmd "map posdisp $bool $units $precision"
1989	}
1990	"grid" - "grid-type" {
1991	set bool $_settings(grid)
1992	set gridType $_settings(grid-type)
1993	SendCmd "map grid $bool $gridType"
1994	}
1995	"camera-throw" {
1996	set bool $_settings($what)
1997	SendCmd "camera throw $bool"
1998	}
1999	"terrain-ambient" {
2000	set val $_settings($what)
2001	SendCmd "map terrain ambient $val"
2002	}
2003	"terrain-edges" {
2004	set bool $_settings($what)
2005	SendCmd "map terrain edges $bool"
2006	}
2007	"terrain-lighting" {
2008	set bool $_settings($what)
2009	SendCmd "map terrain lighting $bool"
2010	}
2011	"terrain-palette" {
2012	set cmap [$itk_component(terrainpalette) value]
2013	#SendCmd "map terrain colormap $cmap"
2014	}
2015	"terrain-vertscale" {
2016	set val $_settings($what)
2017	SendCmd "map terrain vertscale $val"
2018	}
2019	"terrain-wireframe" {
2020	set bool $_settings($what)
2021	SendCmd "map terrain wireframe $bool"
2022	}
2023	"time" {
2024	set val $_settings($what)
2025	SendCmd "map time $val"
2026	}
2027	default {
2028	error "don't know how to fix $what"
2029	}
2030	}
2031	}
2032
2033	# ----------------------------------------------------------------------
2034	# CONFIGURATION OPTION: -plotbackground
2035	# ----------------------------------------------------------------------
2036	itcl::configbody Rappture::MapViewer::plotbackground {
2037	if { [isconnected] } {
2038	set rgb [Color2RGB $itk_option(-plotbackground)]
2039	SendCmd "screen bgcolor $rgb"
2040	}
2041	}
2042
2043	# ----------------------------------------------------------------------
2044	# CONFIGURATION OPTION: -plotforeground
2045	# ----------------------------------------------------------------------
2046	itcl::configbody Rappture::MapViewer::plotforeground {
2047	if { [isconnected] } {
2048	set rgb [Color2RGB $itk_option(-plotforeground)]
2049	# FIXME: Set font foreground colors
2050	}
2051	}
2052
2053	itcl::body Rappture::MapViewer::BuildMapTab {} {
2054	set fg [option get $itk_component(hull) font Font]
2055	#set bfg [option get $itk_component(hull) boldFont Font]
2056
2057	set inner [$itk_component(main) insert end \
2058	-title "Map Settings" \
2059	-icon [Rappture::icon wrench]]
2060	$inner configure -borderwidth 4
2061
2062	checkbutton $inner.posdisp \
2063	-text "Show Coordinate Readout" \
2064	-variable [itcl::scope _settings(coords-visible)] \
2065	-command [itcl::code $this AdjustSetting coords-visible] \
2066	-font "Arial 9" -anchor w
2067
2068	itk_component add grid {
2069	checkbutton $inner.grid \
2070	-text "Show Graticule" \
2071	-variable [itcl::scope _settings(grid)] \
2072	-command [itcl::code $this AdjustSetting grid] \
2073	-font "Arial 9" -anchor w
2074	} {
2075	ignore -font
2076	}
2077	Rappture::Tooltip::for $inner.grid "Toggle graticule (grid) display <g>"
2078
2079	checkbutton $inner.wireframe \
2080	-text "Show Wireframe" \
2081	-variable [itcl::scope _settings(terrain-wireframe)] \
2082	-command [itcl::code $this AdjustSetting terrain-wireframe] \
2083	-font "Arial 9" -anchor w
2084	Rappture::Tooltip::for $inner.wireframe "Toggle wireframe rendering of terrain geometry <w>"
2085
2086	checkbutton $inner.lighting \
2087	-text "Enable Lighting" \
2088	-variable [itcl::scope _settings(terrain-lighting)] \
2089	-command [itcl::code $this AdjustSetting terrain-lighting] \
2090	-font "Arial 9" -anchor w
2091	Rappture::Tooltip::for $inner.lighting "Toggle sky lighting of terrain <l>"
2092
2093	checkbutton $inner.edges \
2094	-text "Show Edges" \
2095	-variable [itcl::scope _settings(terrain-edges)] \
2096	-command [itcl::code $this AdjustSetting terrain-edges] \
2097	-font "Arial 9" -anchor w
2098
2099	itk_component add time_l {
2100	label $inner.time_l -text "Time (UTC)" -font "Arial 9"
2101	} {
2102	ignore -font
2103	}
2104	itk_component add time {
2105	::scale $inner.time -from 0 -to 23.9 -orient horizontal \
2106	-resolution 0.1 \
2107	-variable [itcl::scope _settings(time)] \
2108	-width 10 \
2109	-showvalue on \
2110	-command [itcl::code $this AdjustSetting time]
2111	}
2112	Rappture::Tooltip::for $inner.time \
2113	"Set ephemeris time for sky lighting"
2114
2115	itk_component add ambient_l {
2116	label $inner.ambient_l -text "Ambient min." -font "Arial 9"
2117	} {
2118	ignore -font
2119	}
2120	itk_component add ambient {
2121	::scale $inner.ambient -from 0 -to 1.0 -orient horizontal \
2122	-resolution 0.01 \
2123	-variable [itcl::scope _settings(terrain-ambient)] \
2124	-width 10 \
2125	-showvalue on \
2126	-command [itcl::code $this AdjustSetting terrain-ambient]
2127	}
2128	Rappture::Tooltip::for $inner.ambient \
2129	"Set minimum global ambient light level"
2130
2131	blt::table $inner \
2132	0,0 $inner.posdisp -cspan 2 -anchor w -pady 2 \
2133	1,0 $inner.grid -cspan 2 -anchor w -pady 2 \
2134	2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
2135	3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \
2136	4,0 $inner.time_l -cspan 2 -anchor w -pady 2 \
2137	4,1 $inner.time -cspan 2 -fill x -pady 2 \
2138	5,0 $inner.ambient_l -cspan 2 -anchor w -pady 2 \
2139	5,1 $inner.ambient -cspan 2 -fill x -pady 2
2140	# 4,0 $inner.edges -cspan 2 -anchor w -pady 2
2141
2142	blt::table configure $inner r* c* -resize none
2143	blt::table configure $inner r6 c1 -resize expand
2144	}
2145
2146	itcl::body Rappture::MapViewer::BuildTerrainTab {} {
2147	set fg [option get $itk_component(hull) font Font]
2148	#set bfg [option get $itk_component(hull) boldFont Font]
2149
2150	set inner [$itk_component(main) insert end \
2151	-title "Terrain Settings" \
2152	-icon [Rappture::icon terrain]]
2153	$inner configure -borderwidth 4
2154
2155	label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
2156	itk_component add terrainpalette {
2157	Rappture::Combobox $inner.palette -width 10 -editable no
2158	}
2159	$inner.palette choices insert end [GetColormapList]
2160
2161	$itk_component(terrainpalette) value "BCGYR"
2162	bind $inner.palette <<Value>> \
2163	[itcl::code $this AdjustSetting terrain-palette]
2164
2165	itk_component add vscale_l {
2166	label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
2167	}
2168	itk_component add vscale {
2169	::scale $inner.vscale -from 0 -to 10 -orient horizontal \
2170	-variable [itcl::scope _settings(terrain-vertscale)] \
2171	-width 10 \
2172	-resolution 0.1 \
2173	-showvalue on \
2174	-command [itcl::code $this AdjustSetting terrain-vertscale]
2175	}
2176	$inner.vscale set $_settings(terrain-vertscale)
2177	Rappture::Tooltip::for $inner.vscale \
2178	"Set terrain vertical scale factor"
2179
2180	blt::table $inner \
2181	0,0 $inner.vscale_l -anchor w -pady 2 \
2182	0,1 $inner.vscale -fill x -pady 2
2183	# 1,0 $inner.palette_l -anchor w -pady 2 \
2184	# 1,1 $inner.palette -fill x -pady 2
2185
2186	blt::table configure $inner r* c* -resize none
2187	blt::table configure $inner r3 c1 -resize expand
2188	}
2189
2190	itcl::body Rappture::MapViewer::BuildLayerTab {} {
2191	set fg [option get $itk_component(hull) font Font]
2192	#set bfg [option get $itk_component(hull) boldFont Font]
2193
2194	set inner [$itk_component(main) insert end \
2195	-title "Layers" \
2196	-icon [Rappture::icon layers]]
2197	$inner configure -borderwidth 4
2198	set f [frame $inner.layers]
2199	blt::table $inner \
2200	0,0 $f -fill both
2201	set _layersFrame $inner
2202	}
2203
2204	itcl::body Rappture::MapViewer::BuildViewpointsTab {} {
2205	set fg [option get $itk_component(hull) font Font]
2206	#set bfg [option get $itk_component(hull) boldFont Font]
2207
2208	set inner [$itk_component(main) insert end \
2209	-title "Places" \
2210	-icon [Rappture::icon placemark16]]
2211	$inner configure -borderwidth 4
2212	set f [frame $inner.viewpoints]
2213	blt::table $inner \
2214	0,0 $f -fill both
2215	set _viewpointsFrame $inner
2216	}
2217
2218	itcl::body Rappture::MapViewer::BuildCameraTab {} {
2219	set inner [$itk_component(main) insert end \
2220	-title "Camera Settings" \
2221	-icon [Rappture::icon camera]]
2222	$inner configure -borderwidth 4
2223
2224	set row 0
2225
2226	set labels { x y z heading pitch distance }
2227	foreach tag $labels {
2228	label $inner.${tag}label -text $tag -font "Arial 9"
2229	entry $inner.${tag} -font "Arial 9" -bg white \
2230	-textvariable [itcl::scope _view($tag)]
2231	bind $inner.${tag} <KeyPress-Return> \
2232	[itcl::code $this Camera set ${tag}]
2233	bind $inner.${tag} <KP_Enter> \
2234	[itcl::code $this Camera set ${tag}]
2235	blt::table $inner \
2236	$row,0 $inner.${tag}label -anchor e -pady 2 \
2237	$row,1 $inner.${tag} -anchor w -pady 2
2238	blt::table configure $inner r$row -resize none
2239	incr row
2240	}
2241	set labels { srs verticalDatum }
2242	foreach tag $labels {
2243	label $inner.${tag}label -text $tag -font "Arial 9"
2244	entry $inner.${tag} -font "Arial 9" -bg white \
2245	-textvariable [itcl::scope _view($tag)]
2246	bind $inner.${tag} <KeyPress-Return> \
2247	[itcl::code $this Camera set ${tag}]
2248	bind $inner.${tag} <KP_Enter> \
2249	[itcl::code $this Camera set ${tag}]
2250	blt::table $inner \
2251	$row,0 $inner.${tag}label -anchor e -pady 2 \
2252	$row,1 $inner.${tag} -anchor w -pady 2
2253	blt::table configure $inner r$row -resize none
2254	incr row
2255	}
2256
2257	if {0} {
2258	button $inner.get \
2259	-text "Get Camera Settings" \
2260	-font "Arial 9" \
2261	-command [itcl::code $this SendCmd "camera get"]
2262	blt::table $inner \
2263	$row,0 $inner.get -anchor w -pady 2 -cspan 2
2264	blt::table configure $inner r$row -resize none
2265	incr row
2266
2267	button $inner.set \
2268	-text "Apply Camera Settings" \
2269	-font "Arial 9" \
2270	-command [itcl::code $this Camera set all]
2271	blt::table $inner \
2272	$row,0 $inner.set -anchor w -pady 2 -cspan 2
2273	blt::table configure $inner r$row -resize none
2274	incr row
2275	}
2276
2277	if {$_useServerManip} {
2278	checkbutton $inner.throw \
2279	-text "Enable Throw" \
2280	-font "Arial 9" \
2281	-variable [itcl::scope _settings(camera-throw)] \
2282	-command [itcl::code $this AdjustSetting camera-throw]
2283	blt::table $inner \
2284	$row,0 $inner.throw -anchor w -pady 2 -cspan 2
2285	blt::table configure $inner r$row -resize none
2286	incr row
2287	}
2288
2289	label $inner.heading_slider_l -text "Heading" -font "Arial 9"
2290	::scale $inner.heading_slider -font "Arial 9" \
2291	-from -180 -to 180 -orient horizontal \
2292	-variable [itcl::scope _view(heading)] \
2293	-width 10 \
2294	-showvalue on \
2295	-command [itcl::code $this Camera set heading]
2296
2297	blt::table $inner \
2298	$row,0 $inner.heading_slider_l -anchor w -pady 2
2299	blt::table $inner \
2300	$row,1 $inner.heading_slider -fill x -anchor w -pady 2
2301	blt::table configure $inner r$row -resize none
2302	incr row
2303
2304	itk_component add pitch_slider_l {
2305	label $inner.pitch_slider_l -text "Pitch" -font "Arial 9"
2306	}
2307	itk_component add pitch_slider {
2308	::scale $inner.pitch_slider -font "Arial 9" \
2309	-from -10 -to -90 -orient horizontal \
2310	-variable [itcl::scope _view(pitch)] \
2311	-width 10 \
2312	-showvalue on \
2313	-command [itcl::code $this Camera set pitch]
2314	}
2315
2316	blt::table $inner \
2317	$row,0 $inner.pitch_slider_l -anchor w -pady 2
2318	blt::table $inner \
2319	$row,1 $inner.pitch_slider -fill x -anchor w -pady 2
2320	blt::table configure $inner r$row -resize none
2321	incr row
2322
2323	blt::table configure $inner c* r* -resize none
2324	blt::table configure $inner c2 -resize expand
2325	blt::table configure $inner r$row -resize expand
2326	}
2327
2328	itcl::body Rappture::MapViewer::BuildHelpTab {} {
2329	set fg [option get $itk_component(hull) font Font]
2330	#set bfg [option get $itk_component(hull) boldFont Font]
2331
2332	set inner [$itk_component(main) insert end \
2333	-title "Help" \
2334	-icon [Rappture::icon question_mark12]]
2335	$inner configure -borderwidth 4
2336
2337	set helptext {*************************
2338	Mouse bindings:
2339	*************************
2340	Left - Panning
2341	Middle - Rotation
2342	Right - Zoom
2343
2344	Zoom/travel:
2345	Left double-click:
2346	Zoom to point
2347	Left shift-double:
2348	Travel to point
2349	Right double-click:
2350	Zoom out from point
2351
2352	Pins:
2353	Ctl-Left: Drop pin
2354	Ctl-Right: Delete pin
2355
2356	Select:
2357	Shift-Left click-drag
2358
2359	*************************
2360	Keyboard bindings:
2361	*************************
2362	g - Toggle graticule
2363	l - Toggle lighting
2364	n - Set North up
2365	p - Reset pitch
2366	w - Toggle wireframe
2367	arrows - panning
2368	Shift-arrows - fine pan
2369	Ctl-arrows - rotation
2370	Ctl-Shift-arrows:
2371	fine rotation
2372	PgUp/PgDown - zoom
2373	Home - Reset camera
2374	*************************}
2375
2376	text $inner.info -width 25 -bg white
2377	$inner.info insert end $helptext
2378	$inner.info configure -state disabled
2379	blt::table $inner \
2380	0,0 $inner.info -fill both
2381	}
2382
2383	#
2384	# camera
2385	#
2386	# This is the public camera API
2387	#
2388	itcl::body Rappture::MapViewer::camera {option args} {
2389	switch -- $option {
2390	"reset" {
2391	Camera reset
2392	}
2393	"viewpoint" {
2394	if {[llength $args] < 1} {
2395	error "wrong # args to camera viewpoint"
2396	}
2397	set vpopt [lindex $args 0]
2398	switch -- $vpopt {
2399	"go" {
2400	if {[llength $args] < 3} {
2401	error "wrong # of args to camera viewpoint go"
2402	}
2403	foreach {dataobj viewpoint} [lrange $args 1 end] break
2404	GoToViewpoint $dataobj $viewpoint
2405	}
2406	default {
2407	error "Unknown camera viewpoint option \"$vpopt\""
2408	}
2409	}
2410	}
2411	"zoom" {
2412	if {[llength $args] < 1} {
2413	error "wrong # of args to camera zoom"
2414	}
2415	set zoomopt [lindex $args 0]
2416	switch -- $zoomopt {
2417	"extent" {
2418	if {[llength $args] < 5} {
2419	error "wrong # of args to camera zoom extent"
2420	}
2421	foreach {xmin ymin xmax ymax duration srs} [lrange $args 1 end] break
2422	foreach key {xmin ymin xmax ymax} {
2423	if {![string is double -strict [set $key]]} {
2424	error "Invalid extent: $key=[set $key]"
2425	}
2426	}
2427	if {$duration == ""} {
2428	set duration 0.0
2429	} elseif {![string is double $duration]} {
2430	error "Invalid duration \"$duration\", should be a double"
2431	}
2432	SendCmd "camera extent $xmin $ymin $xmax $ymax $duration $srs"
2433	}
2434	"layer" {
2435	if {[llength $args] < 3} {
2436	error "wrong # of args to camera zoom layer"
2437	}
2438	foreach {dataobj layer duration} [lrange $args 1 end] break
2439	set tag $layer
2440	if {![$dataobj layer $layer shared]} {
2441	set tag $dataobj-$layer
2442	}
2443	if {![info exists _layers($tag)]} {
2444	error "Unknown layer $layer"
2445	}
2446	if {$duration == ""} {
2447	set duration 0.0
2448	} elseif {![string is double $duration]} {
2449	error "Invalid duration \"$duration\", should be a double"
2450	}
2451	SendCmd "camera lextent $tag $duration"
2452	}
2453	default {
2454	error "Unknown camera zoom option \"$zoomopt\""
2455	}
2456	}
2457	}
2458	default {
2459	error "Unknown camera option \"$option\""
2460	}
2461	}
2462	}
2463
2464	#
2465	# Camera --
2466	#
2467	# USAGE: Camera get
2468	# This is called by the server to transfer the
2469	# current Viewpoint settings
2470	# USAGE: Camera reset
2471	# Reset the camera to the default view
2472	#
2473	itcl::body Rappture::MapViewer::Camera {option args} {
2474	switch -- $option {
2475	"get" {
2476	# We got the camera settings from the server
2477	foreach name {x y z heading pitch distance srs verticalDatum} value $args {
2478	set _view($name) $value
2479	}
2480	#DebugTrace "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
2481	}
2482	"go" {
2483	SendCmd "camera go $args"
2484	}
2485	"reset" {
2486	array set _view {
2487	x 0.0
2488	y 0.0
2489	z 0.0
2490	heading 0.0
2491	pitch -89.9
2492	distance 1.0
2493	srs ""
2494	verticalDatum ""
2495	}
2496	if { [info exists _mapsettings(camera)] } {
2497	# Check if the tool specified a default
2498	set view $_mapsettings(camera)
2499	if { $view != "" } {
2500	array set cam $view
2501	set duration 0.0
2502	if {[info exists cam(xmin)] && [info exists cam(ymin)] &&
2503	[info exists cam(xmax)] && [info exists cam(ymax)]} {
2504	set srs ""
2505	if {[info exists cam(srs)]} {
2506	set srs $cam(srs)
2507	}
2508	SendCmd [list camera extent $cam(xmin) $cam(ymin) $cam(xmax) $cam(ymax) $duration $srs]
2509	} else {
2510	array set _view $view
2511	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2512	}
2513	} else {
2514	SendCmd "camera reset"
2515	# Retrieve the settings
2516	#SendCmd "camera get"
2517	}
2518	} else {
2519	SendCmd "camera reset"
2520	# Retrieve the settings
2521	#SendCmd "camera get"
2522	}
2523	}
2524	"set" {
2525	set who [lindex $args 0]
2526	if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
2527	set val $_view($who)
2528	set code [catch { string is double $val } result]
2529	if { $code != 0 \|\| !$result } {
2530	return
2531	}
2532	}
2533	switch -- $who {
2534	"distance" {
2535	SendCmd [list camera dist $_view(distance)]
2536	}
2537	"all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
2538	set duration 0.0
2539	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2540	}
2541	}
2542	}
2543	}
2544	}
2545
2546	itcl::body Rappture::MapViewer::GoToViewpoint { dataobj viewpoint {duration 2.0}} {
2547	array set view [subst {
2548	x 0
2549	y 0
2550	z 0
2551	heading 0
2552	pitch -90
2553	distance $_view(distance)
2554	srs "$_view(srs)"
2555	verticalDatum "$_view(verticalDatum)"
2556	}]
2557	array set view [$dataobj viewpoint $viewpoint]
2558	foreach key {x y z heading pitch distance srs verticalDatum} {
2559	if { [info exists view($key)] } {
2560	set _view($key) $view($key)
2561	}
2562	}
2563	# If map is projected, ignore pitch
2564	if {![MapIsGeocentric]} {
2565	set _view(pitch) -90
2566	}
2567	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2568	}
2569
2570	itcl::body Rappture::MapViewer::GetImage { args } {
2571	if { [image width $_image(download)] > 0 &&
2572	[image height $_image(download)] > 0 } {
2573	set bytes [$_image(download) data -format "jpeg -quality 100"]
2574	set bytes [Rappture::encoding::decode -as b64 $bytes]
2575	return [list .jpg $bytes]
2576	}
2577	return ""
2578	}
2579
2580	itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
2581	Rappture::Balloon $popup \
2582	-title "[Rappture::filexfer::label downloadWord] as..."
2583	set inner [$popup component inner]
2584	label $inner.summary -text "" -anchor w
2585
2586	radiobutton $inner.image_button -text "Image File" \
2587	-variable [itcl::scope _downloadPopup(format)] \
2588	-value image
2589	Rappture::Tooltip::for $inner.image_button \
2590	"Save as digital image."
2591
2592	button $inner.ok -text "Save" \
2593	-highlightthickness 0 -pady 2 -padx 3 \
2594	-command $command \
2595	-compound left \
2596	-image [Rappture::icon download]
2597
2598	button $inner.cancel -text "Cancel" \
2599	-highlightthickness 0 -pady 2 -padx 3 \
2600	-command [list $popup deactivate] \
2601	-compound left \
2602	-image [Rappture::icon cancel]
2603
2604	blt::table $inner \
2605	0,0 $inner.summary -cspan 2 \
2606	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2607	4,1 $inner.cancel -width .9i -fill y \
2608	4,0 $inner.ok -padx 2 -width .9i -fill y
2609	blt::table configure $inner r3 -height 4
2610	blt::table configure $inner r4 -pady 4
2611	raise $inner.image_button
2612	$inner.image_button invoke
2613	return $inner
2614	}
2615
2616	itcl::body Rappture::MapViewer::ToggleGrid {} {
2617	set _settings(grid) [expr !$_settings(grid)]
2618	AdjustSetting grid
2619	}
2620
2621	itcl::body Rappture::MapViewer::ToggleLighting {} {
2622	set _settings(terrain-lighting) [expr !$_settings(terrain-lighting)]
2623	AdjustSetting terrain-lighting
2624	}
2625
2626	itcl::body Rappture::MapViewer::ToggleWireframe {} {
2627	set _settings(terrain-wireframe) [expr !$_settings(terrain-wireframe)]
2628	AdjustSetting terrain-wireframe
2629	}
2630
2631	itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
2632	array set settings {
2633	-ambient 0.03
2634	-color white
2635	-edgecolor black
2636	-edges 0
2637	-lighting 1
2638	-linewidth 1.0
2639	-vertscale 1.0
2640	-wireframe 0
2641	}
2642	array set settings $style
2643
2644	SendCmd "map terrain ambient $settings(-ambient)"
2645	set _settings(terrain-ambient) $settings(-ambient)
2646	SendCmd "map terrain edges $settings(-edges)"
2647	set _settings(terrain-edges) $settings(-edges)
2648	SendCmd "map terrain color [Color2RGB $settings(-color)]"
2649	#SendCmd "map terrain colormode constant"
2650	SendCmd "map terrain lighting $settings(-lighting)"
2651	set _settings(terrain-lighting) $settings(-lighting)
2652	SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
2653	#SendCmd "map terrain linewidth $settings(-linewidth)"
2654	SendCmd "map terrain vertscale $settings(-vertscale)"
2655	set _settings(terrain-vertscale) $settings(-vertscale)
2656	SendCmd "map terrain wireframe $settings(-wireframe)"
2657	set _settings(terrain-wireframe) $settings(-wireframe)
2658	}
2659
2660	itcl::body Rappture::MapViewer::SendStylesheetFiles { stylesheet } {
2661	set files [Rappture::Map::getFilesFromStylesheet $stylesheet]
2662	foreach file $files {
2663	SendFiles $file
2664	}
2665	}
2666
2667	itcl::body Rappture::MapViewer::SendFiles { path } {
2668	set isRelative [expr {[string first "://" $path] < 0 &&
2669	[string index $path 0] != "/"}]
2670	if {[string range $path 0 7] != "local://" &&
2671	!$isRelative} {
2672	return
2673	}
2674	DebugTrace "Local path: $path"
2675	if {!$isRelative} {
2676	set path [string range $path 8 end]
2677	}
2678	set basename [file rootname $path]
2679	if {[catch {set files [glob -path $basename .*]} err] != 0} {
2680	puts stderr "File not found: $path"
2681	return
2682	}
2683	foreach file $files {
2684	set name $file
2685	set type [file type $file]
2686	set size [file size $file]
2687	set f [open $file "r"]
2688	fconfigure $f -translation binary -encoding binary
2689	set data [read $f]
2690	close $f
2691	SendCmd [list file put $name $type $size]
2692	SendData $data
2693	}
2694	}
2695
2696	itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
2697	array set info [$dataobj layer $layer]
2698	set tag $layer
2699	if { !$info(shared) } {
2700	set tag $dataobj-$layer
2701	}
2702	if { [info exists info(visible)] &&
2703	!$info(visible) } {
2704	set _visibility($tag) 0
2705	} else {
2706	set _visibility($tag) 1
2707	}
2708
2709	switch -- $info(type) {
2710	"image" {
2711	array set style {
2712	-minlevel 0
2713	-maxlevel 23
2714	-opacity 1.0
2715	}
2716	if { [info exists info(style)] } {
2717	DebugTrace "layer style: $info(style)"
2718	array set style $info(style)
2719	}
2720	if { [info exists info(opacity)] } {
2721	set style(-opacity) $info(opacity)
2722	set _opacity($tag) $info(opacity)
2723	}
2724	set _opacity($tag) [expr $style(-opacity) * 100]
2725	set coverage 0
2726	if { [info exists info(coverage)] } {
2727	set coverage $info(coverage)
2728	}
2729	switch -- $info(driver) {
2730	"arcgis" {
2731	SendCmd [list map layer add $tag image arcgis \
2732	$info(arcgis.url) $info(cache) $coverage $info(arcgis.token)]
2733	}
2734	"colorramp" {
2735	set cmapName "[regsub -all {::} ${tag} {}]"
2736	set cmapName "[regsub -all {\-} ${cmapName} {_}]"
2737	SendFiles $info(colorramp.url)
2738	SendCmd [list colormap define $cmapName $info(colorramp.colormap)]
2739	SendCmd [list map layer add $tag image colorramp \
2740	$info(colorramp.url) $info(cache) $coverage $info(colorramp.elevdriver) $info(profile) \
2741	$cmapName]
2742	}
2743	"debug" {
2744	SendCmd [list map layer add $tag image debug]
2745	}
2746	"gdal" {
2747	SendFiles $info(gdal.url)
2748	SendCmd [list map layer add $tag image gdal \
2749	$info(gdal.url) $info(cache) $coverage]
2750	}
2751	"tms" {
2752	SendCmd [list map layer add $tag image tms \
2753	$info(tms.url) $info(cache) $coverage]
2754	}
2755	"wms" {
2756	SendCmd [list map layer add $tag image wms \
2757	$info(wms.url) $info(cache) $coverage \
2758	$info(wms.layers) \
2759	$info(wms.format) \
2760	$info(wms.transparent)]
2761	}
2762	"xyz" {
2763	SendCmd [list map layer add $tag image xyz \
2764	$info(xyz.url) $info(cache) $coverage]
2765	}
2766	}
2767	SendCmd "map layer opacity $style(-opacity) $tag"
2768	}
2769	"elevation" {
2770	array set style {
2771	-minlevel 0
2772	-maxlevel 23
2773	}
2774	if { [info exists info(style)] } {
2775	array set style $info(style)
2776	}
2777	switch -- $info(driver) {
2778	"gdal" {
2779	SendFiles $info(gdal.url)
2780	SendCmd [list map layer add $tag elevation gdal \
2781	$info(gdal.url) $info(cache)]
2782	}
2783	"tms" {
2784	SendCmd [list map layer add $tag elevation tms \
2785	$info(tms.url) $info(cache)]
2786	}
2787	"wcs" {
2788	SendCmd [list map layer add $tag elevation wcs \
2789	$info(wcs.url) $info(cache) $info(wcs.identifier)]
2790	}
2791	}
2792	}
2793	"feature" {
2794	array set style {
2795	-opacity 1.0
2796	}
2797	if { [info exists info(style)] } {
2798	DebugTrace "layer style: $info(style)"
2799	array set style $info(style)
2800	}
2801	if { [info exists info(opacity)] } {
2802	set style(-opacity) $info(opacity)
2803	}
2804	set _opacity($tag) [expr $style(-opacity) * 100]
2805	DebugTrace "stylesheet: $info(stylesheet)"
2806	set script ""
2807	if { [info exists info(script)] } {
2808	set script $info(script)
2809	DebugTrace "script: $script"
2810	}
2811	set selectors [list]
2812	foreach selector [$dataobj selectors $layer] {
2813	array set sinfo [$dataobj selector $layer $selector]
2814	DebugTrace "$selector: [array get sinfo]"
2815	lappend selectors [array get sinfo]
2816	if {[info exists sinfo(styleExpression)]} {
2817	DebugTrace "$selector: $sinfo(styleExpression)"
2818	} elseif {[info exists sinfo(query)]} {
2819	if {[info exists sinfo(queryBounds)]} {
2820	foreach {x1 y1 x2 y2} $sinfo(queryBounds) break
2821	DebugTrace "queryBounds: xmin $x1 ymin $y1 xmax $x2 ymax $y2"
2822	}
2823	}
2824	}
2825	SendStylesheetFiles $info(stylesheet)
2826	set ssSize [string length $info(stylesheet)]
2827	set scriptSize [string length $script]
2828	set selectorsSize [string length $selectors]
2829	switch -- $info(driver) {
2830	"ogr" {
2831	if { [info exists info(ogr.connection)] } {
2832	set cmd [list map layer add $tag feature db {} $info(ogr.layer) $info(ogr.connection) $info(cache) $ssSize $scriptSize $selectorsSize]
2833	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2834	lappend cmd $style(-minrange) $style(-maxrange)
2835	}
2836	} else {
2837	set cmd [list map layer add $tag feature $info(driver) {} {} $info(ogr.url) $info(cache) $ssSize $scriptSize $selectorsSize]
2838	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2839	lappend cmd $style(-minrange) $style(-maxrange)
2840	}
2841	SendFiles $info(ogr.url)
2842	}
2843	}
2844	"tfs" {
2845	set format "json"
2846	if {[info exists info(tfs.format)]} {
2847	set format $info(tfs.format)
2848	}
2849	set cmd [list map layer add $tag feature $info(driver) $format {} $info(tfs.url) $info(cache) $ssSize $scriptSize $selectorsSize]
2850	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2851	lappend cmd $style(-minrange) $style(-maxrange)
2852	}
2853	}
2854	"wfs" {
2855	set format "json"
2856	if {[info exists info(wfs.format)]} {
2857	set format $info(wfs.format)
2858	}
2859	set wfsType ""
2860	if {[info exists info(wfs.typename)]} {
2861	set wfsType $info(wfs.typename)
2862	}
2863	set cmd [list map layer add $tag feature $info(driver) $format $wfsType $info(wfs.url) $info(cache) $ssSize $scriptSize $selectorsSize]
2864	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2865	lappend cmd $style(-minrange) $style(-maxrange)
2866	}
2867	}
2868	}
2869	SendCmd $cmd
2870	if { $ssSize > 0 } { SendData $info(stylesheet) }
2871	if { $scriptSize > 0 } { SendData $script }
2872	if { $selectorsSize > 0 } { SendData $selectors }
2873	SendCmd "map layer opacity $style(-opacity) $tag"
2874	}
2875	"line" {
2876	array set style {
2877	-cap "flat"
2878	-clamping terrain
2879	-clamptechnique gpu
2880	-color black
2881	-join "mitre"
2882	-minbias 1000
2883	-opacity 1.0
2884	-stipplepattern 0
2885	-stipplefactor 1
2886	-width 1
2887	}
2888	if { [info exists info(style)] } {
2889	array set style $info(style)
2890	}
2891	if { [info exists info(opacity)] } {
2892	set style(-opacity) $info(opacity)
2893	}
2894	set _opacity($tag) [expr $style(-opacity) * 100]
2895	foreach {r g b} [Color2RGB $style(-color)] {}
2896	switch -- $info(driver) {
2897	"ogr" {
2898	SendFiles $info(ogr.url)
2899	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2900	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)]
2901	} else {
2902	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)]
2903	}
2904	}
2905	"tfs" {
2906	set format "json"
2907	if {[info exists info(tfs.format)]} {
2908	set format $info(tfs.format)
2909	}
2910	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2911	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)]
2912	} else {
2913	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)]
2914	}
2915	}
2916	"wfs" {
2917	set format "json"
2918	if {[info exists info(wfs.format)]} {
2919	set format $info(wfs.format)
2920	}
2921	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2922	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)]
2923	} else {
2924	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)]
2925	}
2926	}
2927	}
2928	SendCmd "map layer opacity $style(-opacity) $tag"
2929	}
2930	"point" {
2931	array set style {
2932	-color black
2933	-minbias 1000
2934	-opacity 1.0
2935	-size 1
2936	}
2937	if { [info exists info(style)] } {
2938	array set style $info(style)
2939	}
2940	if { [info exists info(opacity)] } {
2941	set style(-opacity) $info(opacity)
2942	}
2943	set _opacity($tag) [expr $style(-opacity) * 100]
2944	foreach {r g b} [Color2RGB $style(-color)] {}
2945	switch -- $info(driver) {
2946	"ogr" {
2947	SendFiles $info(ogr.url)
2948	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2949	SendCmd [list map layer add $tag point ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2950	} else {
2951	SendCmd [list map layer add $tag point ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2952	}
2953	}
2954	"tfs" {
2955	set format "json"
2956	if {[info exists info(tfs.format)]} {
2957	set format $info(tfs.format)
2958	}
2959	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2960	SendCmd [list map layer add $tag point tfs $format {} $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2961	} else {
2962	SendCmd [list map layer add $tag point tfs $format {} $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2963	}
2964	}
2965	"wfs" {
2966	set format "json"
2967	if {[info exists info(wfs.format)]} {
2968	set format $info(wfs.format)
2969	}
2970	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2971	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)]
2972	} else {
2973	SendCmd [list map layer add $tag point wfs $format $info(wfs.typename) $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2974	}
2975	}
2976	}
2977	SendCmd "map layer opacity $style(-opacity) $tag"
2978	}
2979	"icon" {
2980	array set style {
2981	-align "center_bottom"
2982	-declutter 1
2983	-heading {}
2984	-icon pin
2985	-minbias 1000
2986	-opacity 1.0
2987	-placement "vertex"
2988	-scale {}
2989	}
2990	if { [info exists info(style)] } {
2991	array set style $info(style)
2992	}
2993	if { [info exists info(opacity)] } {
2994	set style(-opacity) $info(opacity)
2995	}
2996	set _opacity($tag) [expr $style(-opacity) * 100]
2997	switch -- $info(driver) {
2998	"ogr" {
2999	SendFiles $info(ogr.url)
3000	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3001	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)]
3002	} else {
3003	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)]
3004	}
3005	}
3006	"tfs" {
3007	set format "json"
3008	if {[info exists info(tfs.format)]} {
3009	set format $info(tfs.format)
3010	}
3011	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3012	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)]
3013	} else {
3014	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)]
3015	}
3016	}
3017	"wfs" {
3018	set format "json"
3019	if {[info exists info(wfs.format)]} {
3020	set format $info(wfs.format)
3021	}
3022	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3023	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)]
3024	} else {
3025	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)]
3026	}
3027	}
3028	}
3029	SendCmd "map layer opacity $style(-opacity) $tag"
3030	}
3031	"polygon" {
3032	array set style {
3033	-clamping terrain
3034	-clamptechnique drape
3035	-color white
3036	-minbias 1000
3037	-opacity 1.0
3038	-strokecolor black
3039	-strokewidth 0.0
3040	}
3041	if { [info exists info(style)] } {
3042	array set style $info(style)
3043	}
3044	if { [info exists info(opacity)] } {
3045	set style(-opacity) $info(opacity)
3046	}
3047	set _opacity($tag) [expr $style(-opacity) * 100]
3048	foreach {r g b} [Color2RGB $style(-color)] {}
3049	foreach {strokeR strokeG strokeB} [Color2RGB $style(-strokecolor)] {}
3050	switch -- $info(driver) {
3051	"ogr" {
3052	SendFiles $info(ogr.url)
3053	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3054	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) $style(-minrange) $style(-maxrange)]
3055	} else {
3056	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)]
3057	}
3058	}
3059	"tfs" {
3060	set format "json"
3061	if {[info exists info(tfs.format)]} {
3062	set format $info(tfs.format)
3063	}
3064	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3065	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) $style(-minrange) $style(-maxrange)]
3066	} else {
3067	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)]
3068	}
3069	}
3070	"wfs" {
3071	set format "json"
3072	if {[info exists info(wfs.format)]} {
3073	set format $info(wfs.format)
3074	}
3075	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3076	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) $style(-minrange) $style(-maxrange)]
3077	} else {
3078	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)]
3079	}
3080	}
3081	}
3082	SendCmd "map layer opacity $style(-opacity) $tag"
3083	}
3084	"label" {
3085	array set style {
3086	-align "left_baseline"
3087	-color black
3088	-declutter 1
3089	-font Arial
3090	-fontsize 16.0
3091	-halocolor white
3092	-halowidth 2.0
3093	-layout "left_to_right"
3094	-minbias 1000
3095	-opacity 1.0
3096	-removedupes 1
3097	-xoffset 0
3098	-yoffset 0
3099	}
3100	if { [info exists info(style)] } {
3101	array set style $info(style)
3102	}
3103	if { [info exists info(opacity)] } {
3104	set style(-opacity) $info(opacity)
3105	}
3106	set _opacity($tag) [expr $style(-opacity) * 100]
3107	set contentExpr $info(content)
3108	if {[info exists info(priority)]} {
3109	set priorityExpr $info(priority)
3110	} else {
3111	set priorityExpr ""
3112	}
3113	foreach {fgR fgG fgB} [Color2RGB $style(-color)] {}
3114	foreach {bgR bgG bgB} [Color2RGB $style(-halocolor)] {}
3115	switch -- $info(driver) {
3116	"ogr" {
3117	SendFiles $info(ogr.url)
3118	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3119	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)]
3120	} else {
3121	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)]
3122	}
3123	}
3124	"tfs" {
3125	set format "json"
3126	if {[info exists info(tfs.format)]} {
3127	set format $info(tfs.format)
3128	}
3129	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3130	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)]
3131	} else {
3132	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)]
3133	}
3134	}
3135	"wfs" {
3136	set format "json"
3137	if {[info exists info(wfs.format)]} {
3138	set format $info(wfs.format)
3139	}
3140	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3141	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)]
3142	} else {
3143	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)]
3144	}
3145	}
3146	}
3147	SendCmd "map layer opacity $style(-opacity) $tag"
3148	}
3149	}
3150
3151	if {[info exists info(placard)]} {
3152	if {$info(type) == "image" \|\| $info(type) == "elevation"} {
3153	error "Placard not supported on image or elevation layers"
3154	}
3155	array set placard [$dataobj getPlacardConfig $layer]
3156	SendCmd [list placard config $placard(attrlist) $placard(style) $placard(padding) $tag]
3157	}
3158
3159	SendCmd "map layer visible $_visibility($tag) $tag"
3160	}
3161
3162	itcl::body Rappture::MapViewer::SetLayerOpacity { dataobj layer {value 100}} {
3163	set tag $layer
3164	if {![$dataobj layer $layer shared]} {
3165	set tag $dataobj-$layer
3166	}
3167	set val $_opacity($tag)
3168	set sval [expr { 0.01 * double($val) }]
3169	SendCmd "map layer opacity $sval $tag"
3170	}
3171
3172	itcl::body Rappture::MapViewer::SetLayerVisibility { dataobj layer } {
3173	set tag $layer
3174	if {![$dataobj layer $layer shared]} {
3175	set tag $dataobj-$layer
3176	}
3177	set bool $_visibility($tag)
3178	SendCmd "map layer visible $bool $tag"
3179	}
3180
3181	itcl::body Rappture::MapViewer::UpdateLayerControls {} {
3182	set row 0
3183	set inner $_layersFrame
3184	if { [winfo exists $inner.layers] } {
3185	foreach w [winfo children $inner.layers] {
3186	destroy $w
3187	}
3188	}
3189	set f $inner.layers
3190	set attrib [list]
3191	set imgIdx 0
3192	# FIXME: This order may not match stacking order in server
3193	foreach dataobj [get -objects] {
3194	foreach layer [$dataobj layers] {
3195	array unset info
3196	array set info [$dataobj layer $layer]
3197	set tag $layer
3198	set ctlname $layer
3199	if {!$info(shared)} {
3200	set tag $dataobj-$layer
3201	set ctlname "[regsub -all {::} ${tag} {}]"
3202	set ctlname "[regsub -all {\-} ${ctlname} {_}]"
3203	}
3204	checkbutton $f.${ctlname}_visible \
3205	-text $info(label) \
3206	-font "Arial 9" -anchor w \
3207	-variable [itcl::scope _visibility($tag)] \
3208	-command [itcl::code $this \
3209	SetLayerVisibility $dataobj $layer]
3210	blt::table $f $row,0 $f.${ctlname}_visible -anchor w -pady 2 -cspan 2
3211	incr row
3212	if { $info(type) == "image" } {
3213	incr imgIdx
3214	if { $info(driver) == "colorramp" } {
3215	set colormap $ctlname
3216	if { ![info exists _image(legend-$colormap)] } {
3217	set _image(legend-$colormap) [image create photo]
3218	}
3219	itk_component add legend-$colormap-min {
3220	label $f.legend-$colormap-min -text 0
3221	}
3222	itk_component add legend-$colormap-max {
3223	label $f.legend-$colormap-max -text 1
3224	}
3225	itk_component add legend-$colormap {
3226	label $f.legend-$colormap -image $_image(legend-$colormap)
3227	}
3228	blt::table $f $row,0 $f.legend-$colormap-min -anchor w -pady 0
3229	blt::table $f $row,1 $f.legend-$colormap-max -anchor e -pady 0
3230	incr row
3231	blt::table $f $row,0 $f.legend-$colormap -anchor w -pady 2 -cspan 2
3232	incr row
3233	RequestLegend $colormap 256 16
3234	}
3235	}
3236	if { $info(type) != "elevation" &&
3237	($info(type) != "image" \|\| $imgIdx > 1) } {
3238	label $f.${ctlname}_opacity_l -text "Opacity" -font "Arial 9"
3239	::scale $f.${ctlname}_opacity -from 0 -to 100 \
3240	-orient horizontal -showvalue off \
3241	-variable [itcl::scope _opacity($tag)] \
3242	-width 10 \
3243	-command [itcl::code $this \
3244	SetLayerOpacity $dataobj $layer]
3245	Rappture::Tooltip::for $f.${ctlname}_opacity "Set opacity of $info(label) layer"
3246	blt::table $f $row,0 $f.${ctlname}_opacity_l -anchor w -pady 2
3247	blt::table $f $row,1 $f.${ctlname}_opacity -anchor w -pady 2
3248	incr row
3249	}
3250	set tooltip [list $info(description)]
3251	if { [info exists info(attribution)] &&
3252	$info(attribution) != ""} {
3253	lappend tooltip $info(attribution)
3254	}
3255	Rappture::Tooltip::for $f.${ctlname}_visible [join $tooltip \n]
3256	}
3257	set mapAttrib [$dataobj hints "attribution"]
3258	if { $mapAttrib != "" } {
3259	lappend attrib $mapAttrib
3260	}
3261	}
3262	SendCmd "[list map attrib [encoding convertto utf-8 [join $attrib ,]]]"
3263	label $f.map_attrib -text [join $attrib \n] -font "Arial 9"
3264	blt::table $f $row,0 $f.map_attrib -anchor sw -pady 2 -cspan 2
3265	#incr row
3266	if { $row > 0 } {
3267	blt::table configure $f r* c* -resize none
3268	blt::table configure $f r$row c1 -resize expand
3269	}
3270	}
3271
3272	itcl::body Rappture::MapViewer::UpdateViewpointControls {} {
3273	set row 0
3274	set inner $_viewpointsFrame
3275	if { [winfo exists $inner.viewpoints] } {
3276	foreach w [winfo children $inner.viewpoints] {
3277	destroy $w
3278	}
3279	}
3280	set f $inner.viewpoints
3281	foreach dataobj [get -objects] {
3282	foreach viewpoint [$dataobj viewpoints] {
3283	array unset info
3284	array set info [$dataobj viewpoint $viewpoint]
3285	button $f.${viewpoint}_go \
3286	-relief flat -compound left \
3287	-image [Rappture::icon placemark16] \
3288	-text $info(label) \
3289	-font "Arial 9" -anchor w \
3290	-command [itcl::code $this \
3291	GoToViewpoint $dataobj $viewpoint]
3292	label $f.${viewpoint}_label \
3293	-text $info(label) \
3294	-font "Arial 9" -anchor w
3295	blt::table $f $row,0 $f.${viewpoint}_go -anchor w -pady 2 -cspan 2
3296	#blt::table $f $row,1 $f.${viewpoint}_label -anchor w -pady 2
3297	Rappture::Tooltip::for $f.${viewpoint}_go $info(description)
3298	incr row
3299	}
3300	}
3301	if { $row > 0 } {
3302	blt::table configure $f r* c* -resize none
3303	blt::table configure $f r$row c1 -resize expand
3304	}
3305	}
3306
3307	# ----------------------------------------------------------------------
3308	# OPTION: -map
3309	# ----------------------------------------------------------------------
3310	itcl::configbody Rappture::MapViewer::map {
3311	if {$itk_option(-map) != "" } {
3312	if {[catch {$itk_option(-map) isa Rappture::Map} valid] != 0 \|\| !$valid} {
3313	error "bad value \"$itk_option(-map)\": should be Rappture::Map object"
3314	}
3315	$this clear
3316	$this add $itk_option(-map)
3317	$this scale $itk_option(-map)
3318	} else {
3319	$this clear
3320	}
3321
3322	if { [isconnected] } {
3323	$_dispatcher event -idle !rebuild
3324	}
3325	}

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

Download in other formats: