Context Navigation

source: branches/blt4_trunk/gui/scripts/mapviewer.tcl @ 6414

Last change on this file since 6414 was 6414, checked in by ldelgass, 8 years ago
merge from trunk
File size: 120.2 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: mapviewer - Map object viewer
4	#
5	# It connects to the GeoVis server running on a rendering farm,
6	# transmits data, and displays the results.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-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	}
882	return $_image(legend-$colormap)
883	}
884	view {
885	return $_image(plot)
886	}
887	default {
888	error "bad image name \"[lindex $args 1]\": should be view\|legend"
889	}
890	}
891	}
892	default {
893	error "bad option \"$op\": should be -objects, -hidden, -visible or -image"
894	}
895	}
896	}
897
898	itcl::body Rappture::MapViewer::MapIsGeocentric {} {
899	if { [info exists _mapsettings(type)] } {
900	return [expr {$_mapsettings(type) eq "geocentric"}]
901	} else {
902	return 0
903	}
904	}
905
906	# ----------------------------------------------------------------------
907	# USAGE: scale ?<data1> <data2> ...?
908	#
909	# Sets the default limits for the overall plot according to the
910	# limits of the data for all of the given <data> objects. This
911	# accounts for all objects--even those not showing on the screen.
912	# Because of this, the limits are appropriate for all objects as
913	# the user scans through data in the ResultSet viewer.
914	# ----------------------------------------------------------------------
915	itcl::body Rappture::MapViewer::scale {args} {
916	DebugTrace "Enter"
917	array unset _mapsettings
918
919	foreach dataobj $args {
920	if { ![$dataobj isvalid] } {
921	continue
922	}
923	# Global map view settings are taken from the first dataobj
924	array unset settings
925	array set settings [$dataobj hints]
926	if { [array size _mapsettings] == 0 } {
927	set _mapsettings(label) $settings(label)
928	set _mapsettings(style) $settings(style)
929	set _mapsettings(type) $settings(type)
930	set _mapsettings(projection) $settings(projection)
931	set _mapsettings(extents) $settings(extents)
932	set _mapsettings(camera) $settings(camera)
933	}
934	# If dataobj has the same type and projection as view, expand extents
935	if { $settings(extents) != "" &&
936	$settings(type) == $_mapsettings(type) &&
937	$settings(projection) == $_mapsettings(projection)} {
938	foreach {xmin ymin xmax ymax} $settings(extents) break
939	if { $_mapsettings(extents) == $settings(extents) } {
940	set _mapsettings(xmin) $xmin
941	set _mapsettings(ymin) $ymin
942	set _mapsettings(xmax) $xmax
943	set _mapsettings(ymax) $ymax
944	} else {
945	if { $xmin < $_mapsettings(xmin) } {
946	set _mapsettings(xmin) $xmin
947	#set _reset 1
948	}
949	if { $ymin < $_mapsettings(ymin) } {
950	set _mapsettings(ymin) $ymin
951	#set _reset 1
952	}
953	if { $xmax > $_mapsettings(xmax) } {
954	set _mapsettings(xmax) $xmax
955	#set _reset 1
956	}
957	if { $ymax > $_mapsettings(ymax) } {
958	set _mapsettings(ymax) $ymax
959	#set _reset 1
960	}
961	}
962	}
963	foreach viewpoint [$dataobj viewpoints] {
964	set _viewpoints($viewpoint) [$dataobj viewpoint $viewpoint]
965	if {$_debug} {
966	array set vp $_viewpoints($viewpoint)
967	foreach key { label description x y z distance heading pitch srs verticalDatum } {
968	if { [info exists vp($key)] } {
969	DebugTrace "vp: $viewpoint $key $vp($key)"
970	}
971	}
972	}
973	}
974	}
975	#if { $_reset } {
976	# $_dispatcher event -idle !rebuild
977	#}
978	}
979
980	itcl::body Rappture::MapViewer::setSelectCallback {cmd} {
981	set _selectCallback $cmd
982	}
983
984	itcl::body Rappture::MapViewer::DoSelectCallback {option {args ""}} {
985	if { $_selectCallback != "" } {
986	set cmd [concat $_selectCallback $option $args]
987	uplevel #0 $cmd
988	}
989	}
990
991	# ----------------------------------------------------------------------
992	# USAGE: ReceiveSelect clear
993	# USAGE: ReceiveSelect feature <args...>
994	# USAGE: ReceiveSelect annotation <args...>
995	# ----------------------------------------------------------------------
996	itcl::body Rappture::MapViewer::ReceiveSelect {option {args ""}} {
997	DebugTrace "Enter"
998	eval DoSelectCallback $option $args
999	}
1000
1001	# ----------------------------------------------------------------------
1002	# USAGE: select clear
1003	# USAGE: select feature add\|delete\|set <featureIDList> <layerName>
1004	# USAGE: select mode <boolean>
1005	#
1006	# Clients use this method to notify the map widget of a selection event
1007	# originating from outside the map
1008	# ----------------------------------------------------------------------
1009	itcl::body Rappture::MapViewer::select {option {args ""}} {
1010	switch $option {
1011	"clear" {
1012	if {[llength $args] > 0} {
1013	error "wrong # args: should be \"select clear\""
1014	}
1015	SendCmd "select clear"
1016	}
1017	"feature" {
1018	if {[llength $args] != 3} {
1019	error "wrong #args: should be \"select feature <op> <featureIDList> <layerName>\""
1020	}
1021	set op [lindex $args 0]
1022	set layer [lindex $args end]
1023	if {![info exists _layers($layer)]} {
1024	puts stderr "Unknown layer \"$layer\""
1025	return
1026	}
1027	switch $op {
1028	"add" {
1029	SendCmd "select fadd [lrange $args 1 end]"
1030	}
1031	"delete" {
1032	SendCmd "select fdelete [lrange $args 1 end]"
1033	}
1034	"set" {
1035	SendCmd "select feature [lrange $args 1 end]"
1036	}
1037	default {
1038	puts stderr "Unknown select feature op \"$op\""
1039	}
1040	}
1041	}
1042	"mode" {
1043	if {[llength $args] != 1} {
1044	error "wrong # args: should be \"select mode <boolean>\""
1045	}
1046	if {![string is boolean $args]} {
1047	error "argument to \"select mode\" must be boolean"
1048	}
1049	SendCmd "select mode $args"
1050	}
1051	default {
1052	puts stderr "Unknown select option \"$option\""
1053	}
1054	}
1055	}
1056
1057	# ----------------------------------------------------------------------
1058	# USAGE: placard enable <state> <layerName>
1059	#
1060	# Clients use this method to enable/disable display of a feature placard
1061	# when a feature is clicked/selected.
1062	# ----------------------------------------------------------------------
1063	itcl::body Rappture::MapViewer::placard {option args} {
1064	switch $option {
1065	enable {
1066	if {[llength $args] != 2} {
1067	error "wrong $ args: should be \"enable <boolean> <layerName>\""
1068	}
1069	set state [lindex $args 0]
1070	set layerName [lindex $args 1]
1071	if {![info exists _layers($layerName)]} {
1072	error "Unknown layer \"$layerName\""
1073	}
1074	if {![string is boolean $state]} {
1075	error "argument to placard enable must be boolean"
1076	}
1077	SendCmd "placard enable $state $layerName"
1078	}
1079	default {
1080	error "bad option \"$option\": should be enable"
1081	}
1082	}
1083	}
1084
1085	# ----------------------------------------------------------------------
1086	# USAGE: download coming
1087	# USAGE: download controls <downloadCommand>
1088	# USAGE: download now
1089	#
1090	# Clients use this method to create a downloadable representation
1091	# of the plot. Returns a list of the form {ext string}, where
1092	# "ext" is the file extension (indicating the type of data) and
1093	# "string" is the data itself.
1094	# ----------------------------------------------------------------------
1095	itcl::body Rappture::MapViewer::download {option args} {
1096	switch $option {
1097	coming {
1098	if {[catch {
1099	blt::winop snap $itk_component(plotarea) $_image(download)
1100	}]} {
1101	$_image(download) configure -width 1 -height 1
1102	$_image(download) put #000000
1103	}
1104	}
1105	controls {
1106	set popup .mapviewerdownload
1107	if { ![winfo exists .mapviewerdownload] } {
1108	set inner [BuildDownloadPopup $popup [lindex $args 0]]
1109	} else {
1110	set inner [$popup component inner]
1111	}
1112	set _downloadPopup(image_controls) $inner.image_frame
1113	set num [llength [get]]
1114	set num [expr {($num == 1) ? "1 result" : "$num results"}]
1115	set word [Rappture::filexfer::label downloadWord]
1116	$inner.summary configure -text "$word $num in the following format:"
1117	update idletasks ;# Fix initial sizes
1118	return $popup
1119	}
1120	now {
1121	set popup .mapviewerdownload
1122	if {[winfo exists .mapviewerdownload]} {
1123	$popup deactivate
1124	}
1125	switch -- $_downloadPopup(format) {
1126	"image" {
1127	return [$this GetImage [lindex $args 0]]
1128	}
1129	}
1130	return ""
1131	}
1132	default {
1133	error "bad option \"$option\": should be coming, controls, now"
1134	}
1135	}
1136	}
1137
1138	# ----------------------------------------------------------------------
1139	# USAGE: Connect ?<host:port>,<host:port>...?
1140	#
1141	# Clients use this method to establish a connection to a new
1142	# server, or to reestablish a connection to the previous server.
1143	# Any existing connection is automatically closed.
1144	# ----------------------------------------------------------------------
1145	itcl::body Rappture::MapViewer::Connect {} {
1146	global readyForNextFrame
1147	set readyForNextFrame 1
1148	set _reset 1
1149	set _hosts [GetServerList "geovis"]
1150	if { "" == $_hosts } {
1151	return 0
1152	}
1153	set result [VisViewer::Connect $_hosts]
1154	if { $result } {
1155	if { $_reportClientInfo } {
1156	# Tell the server the viewer, hub, user and session.
1157	# Do this immediately on connect before buffering any commands
1158	global env
1159
1160	set info {}
1161	set user "???"
1162	if { [info exists env(USER)] } {
1163	set user $env(USER)
1164	}
1165	set session "???"
1166	if { [info exists env(SESSION)] } {
1167	set session $env(SESSION)
1168	}
1169	lappend info "version" "$Rappture::version"
1170	lappend info "build" "$Rappture::build"
1171	lappend info "svnurl" "$Rappture::svnurl"
1172	lappend info "installdir" "$Rappture::installdir"
1173	lappend info "hub" [exec hostname]
1174	lappend info "hub_url" [Rappture::Tool::resources -huburl]
1175	lappend info "client" "mapviewer"
1176	lappend info "user" $user
1177	lappend info "session" $session
1178	SendCmd "clientinfo [list $info]"
1179	}
1180
1181	set w [winfo width $itk_component(view)]
1182	set h [winfo height $itk_component(view)]
1183	EventuallyResize $w $h
1184	}
1185	return $result
1186	}
1187
1188	#
1189	# isconnected --
1190	#
1191	# Indicates if we are currently connected to the visualization server.
1192	#
1193	itcl::body Rappture::MapViewer::isconnected {} {
1194	return [VisViewer::IsConnected]
1195	}
1196
1197	#
1198	# disconnect --
1199	#
1200	itcl::body Rappture::MapViewer::disconnect {} {
1201	Disconnect
1202	set _reset 1
1203	}
1204
1205	#
1206	# Disconnect --
1207	#
1208	# Clients use this method to disconnect from the current rendering
1209	# server.
1210	#
1211	itcl::body Rappture::MapViewer::Disconnect {} {
1212	VisViewer::Disconnect
1213
1214	$_dispatcher cancel !pan
1215	$_dispatcher cancel !motion
1216	$_dispatcher cancel !rebuild
1217	$_dispatcher cancel !resize
1218	$_dispatcher cancel !rotate
1219	# disconnected -- no more data sitting on server
1220	array unset _layers
1221	array unset _layersFrame
1222	global readyForNextFrame
1223	set readyForNextFrame 1
1224	}
1225
1226	# ----------------------------------------------------------------------
1227	# USAGE: ReceiveImage -type <type> -token <token> -bytes <size>
1228	#
1229	# Invoked automatically whenever the "image" command comes in from
1230	# the rendering server. Indicates that binary image data with the
1231	# specified <size> will follow.
1232	# ----------------------------------------------------------------------
1233	itcl::body Rappture::MapViewer::ReceiveImage { args } {
1234	global readyForNextFrame
1235	set readyForNextFrame 1
1236	array set info {
1237	-bytes 0
1238	-token "???"
1239	-type image
1240	}
1241	array set info $args
1242	set bytes [ReceiveBytes $info(-bytes)]
1243	if { $info(-type) == "image" } {
1244	$_image(plot) configure -data $bytes
1245	} elseif { $info(type) == "print" } {
1246	set tag $this-print-$info(-token)
1247	set _hardcopy($tag) $bytes
1248	}
1249	set _waitTimeout 0
1250	}
1251
1252	#
1253	# ReceiveLegend
1254	#
1255	# Invoked automatically whenever the "legend" command comes in from
1256	# the rendering server. Indicates that binary image data with the
1257	# specified <size> will follow.
1258	#
1259	itcl::body Rappture::MapViewer::ReceiveLegend { colormap min max size } {
1260	DebugTrace "ReceiveLegend colormap=$colormap range=$min,$max size=$size"
1261	if { [IsConnected] } {
1262	set bytes [ReceiveBytes $size]
1263	if { ![info exists _image(legend-$colormap)] } {
1264	set _image(legend-$colormap) [image create photo]
1265	}
1266	if 0 {
1267	set f [open "/tmp/legend-${colormap}.ppm" "w"]
1268	fconfigure $f -translation binary -encoding binary
1269	puts $f $bytes
1270	close $f
1271	}
1272	$_image(legend-$colormap) configure -data $bytes
1273	#puts stderr "read $size bytes for [image width $_image(legend-$colormap)]x[image height $_image(legend-$colormap)] legend>"
1274	if { [catch {DrawLegend $colormap $min $max} errs] != 0 } {
1275	global errorInfo
1276	puts stderr "errs=$errs errorInfo=$errorInfo"
1277	}
1278	}
1279	}
1280
1281	#
1282	# ReceiveMapInfo --
1283	#
1284	itcl::body Rappture::MapViewer::ReceiveMapInfo { args } {
1285	if { ![isconnected] } {
1286	return
1287	}
1288	set timeReceived [clock clicks -milliseconds]
1289	set elapsed [expr $timeReceived - $_start]
1290	set option [lindex $args 0]
1291	switch -- $option {
1292	"coords" {
1293	set len [llength $args]
1294	if {$len < 3} {
1295	error "Bad map coords response"
1296	} else {
1297	set token [lindex $args 1]
1298	}
1299	foreach { x y z } [lindex $args 2] {
1300	puts stderr "\[$token\] Map coords: $x $y $z"
1301	}
1302	if {$len > 3} {
1303	set srs [lindex $args 3]
1304	set vert [lindex $args 4]
1305	puts stderr "\[$token\] {$srs} {$vert}"
1306	}
1307	}
1308	"names" {
1309	foreach { name } [lindex $args 1] {
1310	puts stderr "layer: $name"
1311	}
1312	}
1313	default {
1314	error "unknown map option \"$option\" from server"
1315	}
1316	}
1317	}
1318
1319	#
1320	# ReceiveScreenInfo --
1321	#
1322	itcl::body Rappture::MapViewer::ReceiveScreenInfo { args } {
1323	if { ![isconnected] } {
1324	return
1325	}
1326	set option [lindex $args 0]
1327	switch -- $option {
1328	"coords" {
1329	set len [llength $args]
1330	if {$len < 3} {
1331	error "Bad screen coords response"
1332	} else {
1333	set token [lindex $args 1]
1334	}
1335	foreach { x y z } [lindex $args 2] {
1336	puts stderr "\[$token\] Screen coords: $x $y $z"
1337	}
1338	}
1339	default {
1340	error "unknown screen option \"$option\" from server"
1341	}
1342	}
1343	}
1344
1345	# ----------------------------------------------------------------------
1346	# USAGE: Rebuild
1347	#
1348	# Called automatically whenever something changes that affects the
1349	# data in the widget. Clears any existing data and rebuilds the
1350	# widget to display new data.
1351	# ----------------------------------------------------------------------
1352	itcl::body Rappture::MapViewer::Rebuild {} {
1353	set w [winfo width $itk_component(view)]
1354	set h [winfo height $itk_component(view)]
1355	if { $w < 2 \|\| $h < 2 } {
1356	update idletasks
1357	$_dispatcher event -idle !rebuild
1358	return
1359	}
1360
1361	# Turn on buffering of commands to the server. We don't want to be
1362	# preempted by a server disconnect/reconnect (which automatically
1363	# generates a new call to Rebuild).
1364	StartBufferingCommands
1365
1366	if { $_reset } {
1367	set _width $w
1368	set _height $h
1369	DoResize
1370
1371	if { [info exists _mapsettings(type)] } {
1372	# The map must be reset once before any layers are added This
1373	# should not be done more than once as it is very expensive.
1374	if { [info exists _mapsettings(style)] } {
1375	array set settings {
1376	-color white
1377	}
1378	array set settings $_mapsettings(style)
1379	}
1380	set bgcolor [Color2RGB $settings(-color)]
1381	if { $_mapsettings(type) == "geocentric" } {
1382	if { [info exists itk_component(grid)] } {
1383	$itk_component(grid) configure -state normal
1384	}
1385	if { [info exists itk_component(time)] } {
1386	$itk_component(time_l) configure -state normal
1387	$itk_component(time) configure -state normal
1388	}
1389	if { [info exists itk_component(pitch_slider)] } {
1390	$itk_component(pitch_slider_l) configure -state normal
1391	$itk_component(pitch_slider) configure -state normal
1392	}
1393	EnableRotationMouseBindings
1394	SendCmd "map reset geocentric $bgcolor"
1395	} else {
1396	if { [info exists itk_component(grid)] } {
1397	$itk_component(grid) configure -state disabled
1398	}
1399	if { [info exists itk_component(time)] } {
1400	$itk_component(time_l) configure -state disabled
1401	$itk_component(time) configure -state disabled
1402	}
1403	if { [info exists itk_component(pitch_slider)] } {
1404	$itk_component(pitch_slider_l) configure -state disabled
1405	$itk_component(pitch_slider) configure -state disabled
1406	}
1407	DisableRotationMouseBindings
1408	set proj $_mapsettings(projection)
1409	SendCmd "screen bgcolor $bgcolor"
1410	if { $proj == "" } {
1411	SendCmd "map reset projected $bgcolor global-mercator"
1412	} elseif { ![info exists _mapsettings(extents)] \|\|
1413	$_mapsettings(extents) == "" } {
1414	SendCmd "map reset projected $bgcolor [list $proj]"
1415	} else {
1416	foreach key "xmin ymin xmax ymax" {
1417	set $key $_mapsettings($key)
1418	}
1419	SendCmd "map reset projected $bgcolor [list $proj] $xmin $ymin $xmax $ymax"
1420	}
1421	}
1422	# XXX: Remove after implementing batch load of layers on reset
1423	SendCmd "map layer delete base"
1424
1425	# Most terrain settings are global to the map and apply even
1426	# if there is no elevation layer. The exception is the
1427	# vertical scale, which only applies if there is an elevation
1428	# layer
1429	if { [info exists _mapsettings(style)] } {
1430	SetTerrainStyle $_mapsettings(style)
1431	} else {
1432	InitSettings terrain-ambient terrain-edges terrain-lighting \
1433	terrain-vertscale terrain-wireframe
1434	}
1435	InitSettings coords-visible
1436	} else {
1437	error "No map settings on reset"
1438	}
1439	}
1440
1441	set _first ""
1442	set haveTerrain 0
1443	foreach dataobj [get -hidden] {
1444	foreach layer [$dataobj layers] {
1445	if { ![$dataobj layer $layer shared] } {
1446	set tag $dataobj-$layer
1447	SendCmd "map layer visible 0 $tag"
1448	}
1449	}
1450	}
1451	foreach dataobj [get -objects] {
1452	if { [info exists _obj2ovride($dataobj-raise)] && $_first == "" } {
1453	set _first $dataobj
1454	}
1455	foreach layer [$dataobj layers] {
1456	array unset info
1457	array set info [$dataobj layer $layer]
1458	set tag $layer
1459	if { !$info(shared) } {
1460	set tag $dataobj-$layer
1461	}
1462	if { ![info exists _layers($tag)] } {
1463	if { $_reportClientInfo } {
1464	set cinfo {}
1465	lappend cinfo "tool_id" [$dataobj hints toolid]
1466	lappend cinfo "tool_name" [$dataobj hints toolname]
1467	lappend cinfo "tool_title" [$dataobj hints tooltitle]
1468	lappend cinfo "tool_command" [$dataobj hints toolcommand]
1469	lappend cinfo "tool_revision" [$dataobj hints toolrevision]
1470	lappend cinfo "dataset_label" [encoding convertto utf-8 $info(label)]
1471	lappend cinfo "dataset_tag" $tag
1472	SendCmd "clientinfo [list $cinfo]"
1473	}
1474	set _layers($tag) 1
1475	SetLayerStyle $dataobj $layer
1476	} elseif { [$dataobj dirty $layer] } {
1477	# Recreate layer
1478	# FIXME: retain layer order
1479	SendCmd "map layer delete $tag"
1480	SetLayerStyle $dataobj $layer
1481	}
1482	$dataobj dirty $layer 0
1483	# Don't change visibility of shared/base layers
1484	if { !$info(shared) } {
1485	# FIXME: This is overriding data layers' initial visibility
1486	if { [info exists _obj2ovride($dataobj-raise)] } {
1487	SendCmd "map layer visible 1 $tag"
1488	set _visibility($tag) 1
1489	} else {
1490	SendCmd "map layer visible 0 $tag"
1491	set _visibility($tag) 0
1492	}
1493	}
1494	if {$info(type) == "elevation"} {
1495	set haveTerrain 1
1496	}
1497	}
1498	# Search our layer list for data layers removed from map object
1499	foreach tag [array names _layers -glob $dataobj-*] {
1500	set layer [string range $tag [string length "$dataobj-"] end]
1501	if {![$dataobj hasLayer $layer]} {
1502	DebugTrace "Delete layer: tag: $tag layer: $layer"
1503	SendCmd "map layer delete $tag"
1504	array unset _layers $tag
1505	array unset _opacity $tag
1506	array unset _visibility $tag
1507	}
1508	}
1509	}
1510
1511	if {$_reset} {
1512	if {$_initCamera} {
1513	# If this is the first Rebuild, we need to
1514	# set up the initial view settings if there
1515	# are any
1516	Camera reset
1517	set _initCamera 0
1518	} else {
1519	# Restore view from before reconnect
1520	Camera set all
1521	}
1522	}
1523
1524	if {$_useSidebar} {
1525	if ($haveTerrain) {
1526	if { [info exists itk_component(vscale)] } {
1527	$itk_component(vscale_l) configure -state normal
1528	$itk_component(vscale) configure -state normal
1529	}
1530	} else {
1531	if { [info exists itk_component(vscale)] } {
1532	$itk_component(vscale_l) configure -state disabled
1533	$itk_component(vscale) configure -state disabled
1534	}
1535	}
1536	UpdateLayerControls
1537	UpdateViewpointControls
1538	}
1539
1540	set _reset 0
1541	global readyForNextFrame
1542	set readyForNextFrame 0; # Don't advance to the next frame
1543	# until we get an image.
1544
1545	# Actually write the commands to the server socket. If it fails, we
1546	# don't care. We're finished here.
1547	blt::busy hold $itk_component(hull)
1548	StopBufferingCommands
1549	blt::busy release $itk_component(hull)
1550	}
1551
1552	itcl::body Rappture::MapViewer::EnablePanningMouseBindings {} {
1553	if {1 \|\| $_useServerManip} {
1554	bind $itk_component(view) <ButtonPress-1> \
1555	[itcl::code $this MouseClick 1 %x %y]
1556	bind $itk_component(view) <B1-Motion> \
1557	[itcl::code $this MouseDrag 1 %x %y]
1558	bind $itk_component(view) <ButtonRelease-1> \
1559	[itcl::code $this MouseRelease 1 %x %y]
1560	} else {
1561	bind $itk_component(view) <ButtonPress-1> \
1562	[itcl::code $this Pan click %x %y]
1563	bind $itk_component(view) <B1-Motion> \
1564	[itcl::code $this Pan drag %x %y]
1565	bind $itk_component(view) <ButtonRelease-1> \
1566	[itcl::code $this Pan release %x %y]
1567	}
1568	}
1569
1570	itcl::body Rappture::MapViewer::DisablePanningMouseBindings {} {
1571	bind $itk_component(view) <ButtonPress-1> {}
1572	bind $itk_component(view) <B1-Motion> {}
1573	bind $itk_component(view) <ButtonRelease-1> {}
1574	}
1575
1576	itcl::body Rappture::MapViewer::EnableRotationMouseBindings {} {
1577	if {1 \|\| $_useServerManip} {
1578	# Bindings for rotation via mouse
1579	bind $itk_component(view) <ButtonPress-2> \
1580	[itcl::code $this MouseClick 2 %x %y]
1581	bind $itk_component(view) <B2-Motion> \
1582	[itcl::code $this MouseDrag 2 %x %y]
1583	bind $itk_component(view) <ButtonRelease-2> \
1584	[itcl::code $this MouseRelease 2 %x %y]
1585	} else {
1586	bind $itk_component(view) <ButtonPress-2> \
1587	[itcl::code $this Rotate click %x %y]
1588	bind $itk_component(view) <B2-Motion> \
1589	[itcl::code $this Rotate drag %x %y]
1590	bind $itk_component(view) <ButtonRelease-2> \
1591	[itcl::code $this Rotate release %x %y]
1592	}
1593	}
1594
1595	itcl::body Rappture::MapViewer::DisableRotationMouseBindings {} {
1596	bind $itk_component(view) <ButtonPress-2> {}
1597	bind $itk_component(view) <B2-Motion> {}
1598	bind $itk_component(view) <ButtonRelease-2> {}
1599	}
1600
1601	itcl::body Rappture::MapViewer::EnableZoomMouseBindings {} {
1602	if {1 \|\| $_useServerManip} {
1603	bind $itk_component(view) <ButtonPress-3> \
1604	[itcl::code $this MouseClick 3 %x %y]
1605	bind $itk_component(view) <B3-Motion> \
1606	[itcl::code $this MouseDrag 3 %x %y]
1607	bind $itk_component(view) <ButtonRelease-3> \
1608	[itcl::code $this MouseRelease 3 %x %y]
1609	} else {
1610	bind $itk_component(view) <ButtonPress-3> \
1611	[itcl::code $this Zoom click %x %y]
1612	bind $itk_component(view) <B3-Motion> \
1613	[itcl::code $this Zoom drag %x %y]
1614	bind $itk_component(view) <ButtonRelease-3> \
1615	[itcl::code $this Zoom release %x %y]
1616	}
1617	}
1618
1619	itcl::body Rappture::MapViewer::DisableZoomMouseBindings {} {
1620	bind $itk_component(view) <ButtonPress-3> {}
1621	bind $itk_component(view) <B3-Motion> {}
1622	bind $itk_component(view) <ButtonRelease-3> {}
1623	}
1624	# ----------------------------------------------------------------------
1625	# USAGE: CurrentLayers ?-all -visible? ?dataobjs?
1626	#
1627	# Returns a list of server IDs for the current datasets being displayed.
1628	# This is normally a single ID, but it might be a list of IDs if the
1629	# current data object has multiple components.
1630	# ----------------------------------------------------------------------
1631	itcl::body Rappture::MapViewer::CurrentLayers {args} {
1632	set flag [lindex $args 0]
1633	switch -- $flag {
1634	"-all" {
1635	if { [llength $args] > 1 } {
1636	error "CurrentLayers: can't specify dataobj after \"-all\""
1637	}
1638	set dlist [get -objects]
1639	}
1640	"-visible" {
1641	if { [llength $args] > 1 } {
1642	set dlist {}
1643	set args [lrange $args 1 end]
1644	foreach dataobj $args {
1645	if { [info exists _obj2ovride($dataobj-raise)] } {
1646	lappend dlist $dataobj
1647	}
1648	}
1649	} else {
1650	set dlist [get -visible]
1651	}
1652	}
1653	default {
1654	set dlist $args
1655	}
1656	}
1657	set rlist ""
1658	foreach dataobj $dlist {
1659	foreach layer [$dataobj layers] {
1660	if { [info exists _layers($layer)] && $_layers($layer) } {
1661	lappend rlist $layer
1662	}
1663	}
1664	}
1665	return $rlist
1666	}
1667
1668	itcl::body Rappture::MapViewer::KeyPress {k} {
1669	SendCmd "key press $k"
1670	}
1671
1672	itcl::body Rappture::MapViewer::KeyRelease {k} {
1673	SendCmd "key release $k"
1674	}
1675
1676	itcl::body Rappture::MapViewer::GetNormalizedMouse {x y} {
1677	set w [winfo width $itk_component(view)]
1678	set h [winfo height $itk_component(view)]
1679	set x [expr {(2.0 * double($x)/$w) - 1.0}]
1680	set y [expr {(2.0 * double($y)/$h) - 1.0}]
1681	return [list $x $y]
1682	}
1683
1684	itcl::body Rappture::MapViewer::MouseClick {button x y} {
1685	SendCmd "mouse click $button $x $y"
1686	}
1687
1688	itcl::body Rappture::MapViewer::MouseDoubleClick {button x y} {
1689	SendCmd "mouse dblclick $button $x $y"
1690	}
1691
1692	itcl::body Rappture::MapViewer::MouseDrag {button x y} {
1693	SendCmd "mouse drag $button $x $y"
1694	}
1695
1696	itcl::body Rappture::MapViewer::MouseRelease {button x y} {
1697	SendCmd "mouse release $button $x $y"
1698	}
1699
1700	itcl::body Rappture::MapViewer::MouseMotion {} {
1701	SendCmd "mouse motion $_motion(x) $_motion(y)"
1702	#SendCmd "map pin hover $_motion(x) $_motion(y)"
1703	set _motion(pending) 0
1704	}
1705
1706	itcl::body Rappture::MapViewer::MouseScroll {direction} {
1707	switch -- $direction {
1708	"up" {
1709	SendCmd "mouse scroll 1"
1710	}
1711	"down" {
1712	SendCmd "mouse scroll -1"
1713	}
1714	}
1715	}
1716
1717	#
1718	# EventuallyHandleMotionEvent --
1719	#
1720	# This routine compresses (no button press) motion events. It
1721	# delivers a server mouse command once every 100 milliseconds (if a
1722	# motion event is pending).
1723	#
1724	itcl::body Rappture::MapViewer::EventuallyHandleMotionEvent {x y} {
1725	set _motion(x) $x
1726	set _motion(y) $y
1727	if { !$_motion(compress) } {
1728	MouseMotion
1729	return
1730	}
1731	if { !$_motion(pending) } {
1732	set _motion(pending) 1
1733	$_dispatcher event -after $_motion(delay) !motion
1734	}
1735	}
1736
1737	# ----------------------------------------------------------------------
1738	# USAGE: Zoom in
1739	# USAGE: Zoom out
1740	# USAGE: Zoom reset
1741	# $this Zoom click x y
1742	# $this Zoom drag x y
1743	# $this Zoom release x y
1744	#
1745	# Called automatically when the user clicks on one of the zoom
1746	# controls for this widget. Changes the zoom for the current view.
1747	# Also implements mouse zoom.
1748	# ----------------------------------------------------------------------
1749	itcl::body Rappture::MapViewer::Zoom {option {x 0} {y 0}} {
1750	switch -- $option {
1751	"in" {
1752	# z here is normalized mouse Y delta
1753	set z -0.25
1754	SendCmd "camera zoom $z"
1755	}
1756	"out" {
1757	# z here is normalized mouse Y delta
1758	set z 0.25
1759	SendCmd "camera zoom $z"
1760	}
1761	"reset" {
1762	SendCmd "camera dist $_view(distance)"
1763	}
1764	"click" {
1765	set _click(x) $x
1766	set _click(y) $y
1767	$itk_component(view) configure -cursor hand1
1768	}
1769	"drag" {
1770	if { ![info exists _click(x)] } {
1771	set _click(x) $x
1772	}
1773	if { ![info exists _click(y)] } {
1774	set _click(y) $y
1775	}
1776	set h [winfo height $itk_component(view)]
1777	set dy [expr ($_click(y) - $y)/double($h)]
1778	set _click(x) $x
1779	set _click(y) $y
1780	if {[expr (abs($dy) > 0.0)]} {
1781	SendCmd "camera zoom $dy"
1782	}
1783	}
1784	"release" {
1785	Zoom drag $x $y
1786	$itk_component(view) configure -cursor ""
1787	}
1788	}
1789	}
1790
1791	# ----------------------------------------------------------------------
1792	# USAGE: Rotate click <x> <y>
1793	# USAGE: Rotate drag <x> <y>
1794	# USAGE: Rotate release <x> <y>
1795	#
1796	# Called automatically when the user clicks/drags/releases in the
1797	# plot area. Moves the plot according to the user's actions.
1798	# ----------------------------------------------------------------------
1799	itcl::body Rappture::MapViewer::Rotate {option x y} {
1800	switch -- $option {
1801	"click" {
1802	$itk_component(view) configure -cursor fleur
1803	set _click(x) $x
1804	set _click(y) $y
1805	set _rotate(azimuth) 0
1806	set _rotate(elevation) 0
1807	}
1808	"drag" {
1809	if {[array size _click] == 0} {
1810	Rotate click $x $y
1811	} else {
1812	set w [winfo width $itk_component(view)]
1813	set h [winfo height $itk_component(view)]
1814	if {$w <= 0 \|\| $h <= 0} {
1815	return
1816	}
1817	set dx [expr ($x - $_click(x))/double($w)]
1818	set dy [expr ($_click(y) - $y)/double($h)]
1819	set _click(x) $x
1820	set _click(y) $y
1821	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1822	#SendCmd "camera rotate $dx $dy"
1823	EventuallyRotate $dx $dy
1824	}
1825	}
1826	}
1827	"release" {
1828	Rotate drag $x $y
1829	$itk_component(view) configure -cursor ""
1830	catch {unset _click}
1831	}
1832	"set" {
1833	set w [winfo width $itk_component(view)]
1834	set h [winfo height $itk_component(view)]
1835	set dx [expr $x / double($w)]
1836	set dy [expr $y / double($h)]
1837	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1838	EventuallyRotate $dx $dy
1839	}
1840	}
1841	default {
1842	error "bad option \"$option\": should be click, drag, release"
1843	}
1844	}
1845	}
1846
1847	itcl::body Rappture::MapViewer::Select {option x y} {
1848	switch -- $option {
1849	"click" {
1850	set _click(x) $x
1851	set _click(y) $y
1852	set _b1mode "select"
1853	SendCmd "map box init $x $y"
1854	}
1855	"drag" {
1856	if {$_b1mode == "select"} {
1857	EventuallySelect $x $y
1858	}
1859	}
1860	"release" {
1861	set _b1mode ""
1862	if {$_click(x) == $x &&
1863	$_click(y) == $y} {
1864	SendCmd "map box clear"
1865	} else {
1866	SendCmd "map box end $x $y"
1867	}
1868	}
1869	}
1870	}
1871
1872	itcl::body Rappture::MapViewer::Pin {option x y} {
1873	set _click(x) $x
1874	set _click(y) $y
1875	switch -- $option {
1876	"add" {
1877	incr _labelCount
1878	set label "Label $_labelCount"
1879	SendCmd [list "map" "pin" "add" $x $y [encoding convertto utf-8 $label]]
1880	}
1881	"delete" {
1882	SendCmd "map pin delete $x $y"
1883	}
1884	}
1885	}
1886
1887	# ----------------------------------------------------------------------
1888	# USAGE: $this Pan set x y
1889	# $this Pan click x y
1890	# $this Pan drag x y
1891	# $this Pan release x y
1892	#
1893	# Called automatically when the user clicks on one of the zoom
1894	# controls for this widget. Changes the zoom for the current view.
1895	# ----------------------------------------------------------------------
1896	itcl::body Rappture::MapViewer::Pan {option x y} {
1897	switch -- $option {
1898	"click" {
1899	set _click(x) $x
1900	set _click(y) $y
1901	set _pan(x) 0
1902	set _pan(y) 0
1903	$itk_component(view) configure -cursor hand1
1904	set _b1mode "pan"
1905	}
1906	"drag" {
1907	if {$_b1mode != "pan"} {
1908	return
1909	}
1910	if { ![info exists _click(x)] } {
1911	set _click(x) $x
1912	}
1913	if { ![info exists _click(y)] } {
1914	set _click(y) $y
1915	}
1916	set w [winfo width $itk_component(view)]
1917	set h [winfo height $itk_component(view)]
1918	set dx [expr ($x - $_click(x))/double($w)]
1919	set dy [expr ($_click(y) - $y)/double($h)]
1920	set _click(x) $x
1921	set _click(y) $y
1922	if {[expr (abs($dx) > 0.0 \|\| abs($dy) > 0.0)]} {
1923	EventuallyPan $dx $dy
1924	#SendCmd "camera pan $dx $dy"
1925	}
1926	}
1927	"release" {
1928	Pan drag $x $y
1929	$itk_component(view) configure -cursor ""
1930	set _b1mode ""
1931	}
1932	"set" {
1933	set w [winfo width $itk_component(view)]
1934	set h [winfo height $itk_component(view)]
1935	set x [expr $x / double($w)]
1936	set y [expr $y / double($h)]
1937	if {[expr (abs($x) > 0.0 \|\| abs($y) > 0.0)]} {
1938	SendCmd "camera pan $x $y"
1939	}
1940	return
1941	}
1942	default {
1943	error "unknown option \"$option\": should set, click, drag, or release"
1944	}
1945	}
1946	}
1947
1948	itcl::body Rappture::MapViewer::SetHeading { {value 0} } {
1949	set _view(heading) $value
1950	Camera set heading
1951	}
1952
1953	itcl::body Rappture::MapViewer::SetPitch { {value -89.999} } {
1954	set _view(pitch) $value
1955	Camera set pitch
1956	}
1957
1958	# ----------------------------------------------------------------------
1959	# USAGE: InitSettings <what> ?<value>?
1960	#
1961	# Used internally to update rendering settings whenever parameters
1962	# change in the popup settings panel. Sends the new settings off
1963	# to the back end.
1964	# ----------------------------------------------------------------------
1965	itcl::body Rappture::MapViewer::InitSettings { args } {
1966	foreach setting $args {
1967	AdjustSetting $setting
1968	}
1969	}
1970
1971	#
1972	# AdjustSetting --
1973	#
1974	# Changes/updates a specific setting in the widget. There are
1975	# usually user-setable option. Commands are sent to the render
1976	# server.
1977	#
1978	itcl::body Rappture::MapViewer::AdjustSetting {what {value ""}} {
1979	if { ![isconnected] } {
1980	return
1981	}
1982	switch -- $what {
1983	"coords-visible" - "coords-precision" - "coords-units" {
1984	set bool $_settings(coords-visible)
1985	set units $_settings(coords-units)
1986	set precision $_settings(coords-precision)
1987	SendCmd "map posdisp $bool $units $precision"
1988	}
1989	"grid" - "grid-type" {
1990	set bool $_settings(grid)
1991	set gridType $_settings(grid-type)
1992	SendCmd "map grid $bool $gridType"
1993	}
1994	"camera-throw" {
1995	set bool $_settings($what)
1996	SendCmd "camera throw $bool"
1997	}
1998	"terrain-ambient" {
1999	set val $_settings($what)
2000	SendCmd "map terrain ambient $val"
2001	}
2002	"terrain-edges" {
2003	set bool $_settings($what)
2004	SendCmd "map terrain edges $bool"
2005	}
2006	"terrain-lighting" {
2007	set bool $_settings($what)
2008	SendCmd "map terrain lighting $bool"
2009	}
2010	"terrain-palette" {
2011	set cmap [$itk_component(terrainpalette) value]
2012	#SendCmd "map terrain colormap $cmap"
2013	}
2014	"terrain-vertscale" {
2015	set val $_settings($what)
2016	SendCmd "map terrain vertscale $val"
2017	}
2018	"terrain-wireframe" {
2019	set bool $_settings($what)
2020	SendCmd "map terrain wireframe $bool"
2021	}
2022	"time" {
2023	set val $_settings($what)
2024	SendCmd "map time $val"
2025	}
2026	default {
2027	error "don't know how to fix $what"
2028	}
2029	}
2030	}
2031
2032	# ----------------------------------------------------------------------
2033	# CONFIGURATION OPTION: -plotbackground
2034	# ----------------------------------------------------------------------
2035	itcl::configbody Rappture::MapViewer::plotbackground {
2036	if { [isconnected] } {
2037	set rgb [Color2RGB $itk_option(-plotbackground)]
2038	SendCmd "screen bgcolor $rgb"
2039	}
2040	}
2041
2042	# ----------------------------------------------------------------------
2043	# CONFIGURATION OPTION: -plotforeground
2044	# ----------------------------------------------------------------------
2045	itcl::configbody Rappture::MapViewer::plotforeground {
2046	if { [isconnected] } {
2047	set rgb [Color2RGB $itk_option(-plotforeground)]
2048	# FIXME: Set font foreground colors
2049	}
2050	}
2051
2052	itcl::body Rappture::MapViewer::BuildMapTab {} {
2053	set fg [option get $itk_component(hull) font Font]
2054	#set bfg [option get $itk_component(hull) boldFont Font]
2055
2056	set inner [$itk_component(main) insert end \
2057	-title "Map Settings" \
2058	-icon [Rappture::icon wrench]]
2059	$inner configure -borderwidth 4
2060
2061	checkbutton $inner.posdisp \
2062	-text "Show Coordinate Readout" \
2063	-variable [itcl::scope _settings(coords-visible)] \
2064	-command [itcl::code $this AdjustSetting coords-visible] \
2065	-font "Arial 9" -anchor w
2066
2067	itk_component add grid {
2068	checkbutton $inner.grid \
2069	-text "Show Graticule" \
2070	-variable [itcl::scope _settings(grid)] \
2071	-command [itcl::code $this AdjustSetting grid] \
2072	-font "Arial 9" -anchor w
2073	} {
2074	ignore -font
2075	}
2076	Rappture::Tooltip::for $inner.grid "Toggle graticule (grid) display <g>"
2077
2078	checkbutton $inner.wireframe \
2079	-text "Show Wireframe" \
2080	-variable [itcl::scope _settings(terrain-wireframe)] \
2081	-command [itcl::code $this AdjustSetting terrain-wireframe] \
2082	-font "Arial 9" -anchor w
2083	Rappture::Tooltip::for $inner.wireframe "Toggle wireframe rendering of terrain geometry <w>"
2084
2085	checkbutton $inner.lighting \
2086	-text "Enable Lighting" \
2087	-variable [itcl::scope _settings(terrain-lighting)] \
2088	-command [itcl::code $this AdjustSetting terrain-lighting] \
2089	-font "Arial 9" -anchor w
2090	Rappture::Tooltip::for $inner.lighting "Toggle sky lighting of terrain <l>"
2091
2092	checkbutton $inner.edges \
2093	-text "Show Edges" \
2094	-variable [itcl::scope _settings(terrain-edges)] \
2095	-command [itcl::code $this AdjustSetting terrain-edges] \
2096	-font "Arial 9" -anchor w
2097
2098	itk_component add time_l {
2099	label $inner.time_l -text "Time (UTC)" -font "Arial 9"
2100	} {
2101	ignore -font
2102	}
2103	itk_component add time {
2104	::scale $inner.time -from 0 -to 23.9 -orient horizontal \
2105	-resolution 0.1 \
2106	-variable [itcl::scope _settings(time)] \
2107	-width 10 \
2108	-showvalue on \
2109	-command [itcl::code $this AdjustSetting time]
2110	}
2111
2112	itk_component add ambient_l {
2113	label $inner.ambient_l -text "Ambient min." -font "Arial 9"
2114	} {
2115	ignore -font
2116	}
2117	itk_component add ambient {
2118	::scale $inner.ambient -from 0 -to 1.0 -orient horizontal \
2119	-resolution 0.01 \
2120	-variable [itcl::scope _settings(terrain-ambient)] \
2121	-width 10 \
2122	-showvalue on \
2123	-command [itcl::code $this AdjustSetting terrain-ambient]
2124	}
2125
2126	blt::table $inner \
2127	0,0 $inner.posdisp -cspan 2 -anchor w -pady 2 \
2128	1,0 $inner.grid -cspan 2 -anchor w -pady 2 \
2129	2,0 $inner.wireframe -cspan 2 -anchor w -pady 2 \
2130	3,0 $inner.lighting -cspan 2 -anchor w -pady 2 \
2131	4,0 $inner.time_l -cspan 2 -anchor w -pady 2 \
2132	4,1 $inner.time -cspan 2 -fill x -pady 2 \
2133	5,0 $inner.ambient_l -cspan 2 -anchor w -pady 2 \
2134	5,1 $inner.ambient -cspan 2 -fill x -pady 2
2135	# 4,0 $inner.edges -cspan 2 -anchor w -pady 2
2136
2137	blt::table configure $inner r* c* -resize none
2138	blt::table configure $inner r6 c1 -resize expand
2139	}
2140
2141	itcl::body Rappture::MapViewer::BuildTerrainTab {} {
2142	set fg [option get $itk_component(hull) font Font]
2143	#set bfg [option get $itk_component(hull) boldFont Font]
2144
2145	set inner [$itk_component(main) insert end \
2146	-title "Terrain Settings" \
2147	-icon [Rappture::icon terrain]]
2148	$inner configure -borderwidth 4
2149
2150	label $inner.palette_l -text "Palette" -font "Arial 9" -anchor w
2151	itk_component add terrainpalette {
2152	Rappture::Combobox $inner.palette -width 10 -editable no
2153	}
2154	$inner.palette choices insert end [GetColormapList]
2155
2156	$itk_component(terrainpalette) value "BCGYR"
2157	bind $inner.palette <<Value>> \
2158	[itcl::code $this AdjustSetting terrain-palette]
2159
2160	itk_component add vscale_l {
2161	label $inner.vscale_l -text "Vertical Scale" -font "Arial 9" -anchor w
2162	}
2163	itk_component add vscale {
2164	::scale $inner.vscale -from 0 -to 10 -orient horizontal \
2165	-variable [itcl::scope _settings(terrain-vertscale)] \
2166	-width 10 \
2167	-resolution 0.1 \
2168	-showvalue on \
2169	-command [itcl::code $this AdjustSetting terrain-vertscale]
2170	}
2171	$inner.vscale set $_settings(terrain-vertscale)
2172
2173	blt::table $inner \
2174	0,0 $inner.vscale_l -anchor w -pady 2 \
2175	0,1 $inner.vscale -fill x -pady 2
2176	# 1,0 $inner.palette_l -anchor w -pady 2 \
2177	# 1,1 $inner.palette -fill x -pady 2
2178
2179	blt::table configure $inner r* c* -resize none
2180	blt::table configure $inner r3 c1 -resize expand
2181	}
2182
2183	itcl::body Rappture::MapViewer::BuildLayerTab {} {
2184	set fg [option get $itk_component(hull) font Font]
2185	#set bfg [option get $itk_component(hull) boldFont Font]
2186
2187	set inner [$itk_component(main) insert end \
2188	-title "Layers" \
2189	-icon [Rappture::icon layers]]
2190	$inner configure -borderwidth 4
2191	set f [frame $inner.layers]
2192	blt::table $inner \
2193	0,0 $f -fill both
2194	set _layersFrame $inner
2195	}
2196
2197	itcl::body Rappture::MapViewer::BuildViewpointsTab {} {
2198	set fg [option get $itk_component(hull) font Font]
2199	#set bfg [option get $itk_component(hull) boldFont Font]
2200
2201	set inner [$itk_component(main) insert end \
2202	-title "Places" \
2203	-icon [Rappture::icon placemark16]]
2204	$inner configure -borderwidth 4
2205	set f [frame $inner.viewpoints]
2206	blt::table $inner \
2207	0,0 $f -fill both
2208	set _viewpointsFrame $inner
2209	}
2210
2211	itcl::body Rappture::MapViewer::BuildCameraTab {} {
2212	set inner [$itk_component(main) insert end \
2213	-title "Camera Settings" \
2214	-icon [Rappture::icon camera]]
2215	$inner configure -borderwidth 4
2216
2217	set row 0
2218
2219	set labels { x y z heading pitch distance }
2220	foreach tag $labels {
2221	label $inner.${tag}label -text $tag -font "Arial 9"
2222	entry $inner.${tag} -font "Arial 9" -bg white \
2223	-textvariable [itcl::scope _view($tag)]
2224	bind $inner.${tag} <KeyPress-Return> \
2225	[itcl::code $this Camera set ${tag}]
2226	bind $inner.${tag} <KP_Enter> \
2227	[itcl::code $this Camera set ${tag}]
2228	blt::table $inner \
2229	$row,0 $inner.${tag}label -anchor e -pady 2 \
2230	$row,1 $inner.${tag} -anchor w -pady 2
2231	blt::table configure $inner r$row -resize none
2232	incr row
2233	}
2234	set labels { srs verticalDatum }
2235	foreach tag $labels {
2236	label $inner.${tag}label -text $tag -font "Arial 9"
2237	entry $inner.${tag} -font "Arial 9" -bg white \
2238	-textvariable [itcl::scope _view($tag)]
2239	bind $inner.${tag} <KeyPress-Return> \
2240	[itcl::code $this Camera set ${tag}]
2241	bind $inner.${tag} <KP_Enter> \
2242	[itcl::code $this Camera set ${tag}]
2243	blt::table $inner \
2244	$row,0 $inner.${tag}label -anchor e -pady 2 \
2245	$row,1 $inner.${tag} -anchor w -pady 2
2246	blt::table configure $inner r$row -resize none
2247	incr row
2248	}
2249
2250	if {0} {
2251	button $inner.get \
2252	-text "Get Camera Settings" \
2253	-font "Arial 9" \
2254	-command [itcl::code $this SendCmd "camera get"]
2255	blt::table $inner \
2256	$row,0 $inner.get -anchor w -pady 2 -cspan 2
2257	blt::table configure $inner r$row -resize none
2258	incr row
2259
2260	button $inner.set \
2261	-text "Apply Camera Settings" \
2262	-font "Arial 9" \
2263	-command [itcl::code $this Camera set all]
2264	blt::table $inner \
2265	$row,0 $inner.set -anchor w -pady 2 -cspan 2
2266	blt::table configure $inner r$row -resize none
2267	incr row
2268	}
2269
2270	if {$_useServerManip} {
2271	checkbutton $inner.throw \
2272	-text "Enable Throw" \
2273	-font "Arial 9" \
2274	-variable [itcl::scope _settings(camera-throw)] \
2275	-command [itcl::code $this AdjustSetting camera-throw]
2276	blt::table $inner \
2277	$row,0 $inner.throw -anchor w -pady 2 -cspan 2
2278	blt::table configure $inner r$row -resize none
2279	incr row
2280	}
2281
2282	label $inner.heading_slider_l -text "Heading" -font "Arial 9"
2283	::scale $inner.heading_slider -font "Arial 9" \
2284	-from -180 -to 180 -orient horizontal \
2285	-variable [itcl::scope _view(heading)] \
2286	-width 10 \
2287	-showvalue on \
2288	-command [itcl::code $this Camera set heading]
2289
2290	blt::table $inner \
2291	$row,0 $inner.heading_slider_l -anchor w -pady 2
2292	blt::table $inner \
2293	$row,1 $inner.heading_slider -fill x -anchor w -pady 2
2294	blt::table configure $inner r$row -resize none
2295	incr row
2296
2297	itk_component add pitch_slider_l {
2298	label $inner.pitch_slider_l -text "Pitch" -font "Arial 9"
2299	}
2300	itk_component add pitch_slider {
2301	::scale $inner.pitch_slider -font "Arial 9" \
2302	-from -10 -to -90 -orient horizontal \
2303	-variable [itcl::scope _view(pitch)] \
2304	-width 10 \
2305	-showvalue on \
2306	-command [itcl::code $this Camera set pitch]
2307	}
2308
2309	blt::table $inner \
2310	$row,0 $inner.pitch_slider_l -anchor w -pady 2
2311	blt::table $inner \
2312	$row,1 $inner.pitch_slider -fill x -anchor w -pady 2
2313	blt::table configure $inner r$row -resize none
2314	incr row
2315
2316	blt::table configure $inner c* r* -resize none
2317	blt::table configure $inner c2 -resize expand
2318	blt::table configure $inner r$row -resize expand
2319	}
2320
2321	itcl::body Rappture::MapViewer::BuildHelpTab {} {
2322	set fg [option get $itk_component(hull) font Font]
2323	#set bfg [option get $itk_component(hull) boldFont Font]
2324
2325	set inner [$itk_component(main) insert end \
2326	-title "Help" \
2327	-icon [Rappture::icon question_mark12]]
2328	$inner configure -borderwidth 4
2329
2330	set helptext {*************************
2331	Mouse bindings:
2332	*************************
2333	Left - Panning
2334	Middle - Rotation
2335	Right - Zoom
2336
2337	Zoom/travel:
2338	Left double-click:
2339	Zoom to point
2340	Left shift-double:
2341	Travel to point
2342	Right double-click:
2343	Zoom out from point
2344
2345	Pins:
2346	Ctl-Left: Drop pin
2347	Ctl-Right: Delete pin
2348
2349	Select:
2350	Shift-Left click-drag
2351
2352	*************************
2353	Keyboard bindings:
2354	*************************
2355	g - Toggle graticule
2356	l - Toggle lighting
2357	n - Set North up
2358	p - Reset pitch
2359	w - Toggle wireframe
2360	arrows - panning
2361	Shift-arrows - fine pan
2362	Ctl-arrows - rotation
2363	Ctl-Shift-arrows:
2364	fine rotation
2365	PgUp/PgDown - zoom
2366	Home - Reset camera
2367	*************************}
2368
2369	text $inner.info -width 25 -bg white
2370	$inner.info insert end $helptext
2371	$inner.info configure -state disabled
2372	blt::table $inner \
2373	0,0 $inner.info -fill both
2374	}
2375
2376	#
2377	# camera
2378	#
2379	# This is the public camera API
2380	#
2381	itcl::body Rappture::MapViewer::camera {option args} {
2382	switch -- $option {
2383	"reset" {
2384	Camera reset
2385	}
2386	"viewpoint" {
2387	if {[llength $args] < 1} {
2388	error "wrong # args to camera viewpoint"
2389	}
2390	set vpopt [lindex $args 0]
2391	switch -- $vpopt {
2392	"go" {
2393	if {[llength $args] < 3} {
2394	error "wrong # of args to camera viewpoint go"
2395	}
2396	foreach {dataobj viewpoint} [lrange $args 1 end] break
2397	GoToViewpoint $dataobj $viewpoint
2398	}
2399	default {
2400	error "Unknown camera viewpoint option \"$vpopt\""
2401	}
2402	}
2403	}
2404	"zoom" {
2405	if {[llength $args] < 1} {
2406	error "wrong # of args to camera zoom"
2407	}
2408	set zoomopt [lindex $args 0]
2409	switch -- $zoomopt {
2410	"extent" {
2411	if {[llength $args] < 5} {
2412	error "wrong # of args to camera zoom extent"
2413	}
2414	foreach {xmin ymin xmax ymax duration srs} [lrange $args 1 end] break
2415	foreach key {xmin ymin xmax ymax} {
2416	if {![string is double -strict [set $key]]} {
2417	error "Invalid extent: $key=[set $key]"
2418	}
2419	}
2420	if {$duration == ""} {
2421	set duration 0.0
2422	} elseif {![string is double $duration]} {
2423	error "Invalid duration \"$duration\", should be a double"
2424	}
2425	SendCmd "camera extent $xmin $ymin $xmax $ymax $duration $srs"
2426	}
2427	"layer" {
2428	if {[llength $args] < 3} {
2429	error "wrong # of args to camera zoom layer"
2430	}
2431	foreach {dataobj layer duration} [lrange $args 1 end] break
2432	set tag $layer
2433	if {![$dataobj layer $layer shared]} {
2434	set tag $dataobj-$layer
2435	}
2436	if {![info exists _layers($tag)]} {
2437	error "Unknown layer $layer"
2438	}
2439	if {$duration == ""} {
2440	set duration 0.0
2441	} elseif {![string is double $duration]} {
2442	error "Invalid duration \"$duration\", should be a double"
2443	}
2444	SendCmd "camera lextent $tag $duration"
2445	}
2446	default {
2447	error "Unknown camera zoom option \"$zoomopt\""
2448	}
2449	}
2450	}
2451	default {
2452	error "Unknown camera option \"$option\""
2453	}
2454	}
2455	}
2456
2457	#
2458	# Camera --
2459	#
2460	# USAGE: Camera get
2461	# This is called by the server to transfer the
2462	# current Viewpoint settings
2463	# USAGE: Camera reset
2464	# Reset the camera to the default view
2465	#
2466	itcl::body Rappture::MapViewer::Camera {option args} {
2467	switch -- $option {
2468	"get" {
2469	# We got the camera settings from the server
2470	foreach name {x y z heading pitch distance srs verticalDatum} value $args {
2471	set _view($name) $value
2472	}
2473	#DebugTrace "view: $_view(x), $_view(y), $_view(z), $_view(heading), $_view(pitch), $_view(distance), {$_view(srs)}, {$_view(verticalDatum)}"
2474	}
2475	"go" {
2476	SendCmd "camera go $args"
2477	}
2478	"reset" {
2479	array set _view {
2480	x 0.0
2481	y 0.0
2482	z 0.0
2483	heading 0.0
2484	pitch -89.9
2485	distance 1.0
2486	srs ""
2487	verticalDatum ""
2488	}
2489	if { [info exists _mapsettings(camera)] } {
2490	# Check if the tool specified a default
2491	set view $_mapsettings(camera)
2492	if { $view != "" } {
2493	array set cam $view
2494	set duration 0.0
2495	if {[info exists cam(xmin)] && [info exists cam(ymin)] &&
2496	[info exists cam(xmax)] && [info exists cam(ymax)]} {
2497	set srs ""
2498	if {[info exists cam(srs)]} {
2499	set srs $cam(srs)
2500	}
2501	SendCmd [list camera extent $cam(xmin) $cam(ymin) $cam(xmax) $cam(ymax) $duration $srs]
2502	} else {
2503	array set _view $view
2504	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2505	}
2506	} else {
2507	SendCmd "camera reset"
2508	# Retrieve the settings
2509	#SendCmd "camera get"
2510	}
2511	} else {
2512	SendCmd "camera reset"
2513	# Retrieve the settings
2514	#SendCmd "camera get"
2515	}
2516	}
2517	"set" {
2518	set who [lindex $args 0]
2519	if {$who != "all" && $who != "srs" && $who != "verticalDatum"} {
2520	set val $_view($who)
2521	set code [catch { string is double $val } result]
2522	if { $code != 0 \|\| !$result } {
2523	return
2524	}
2525	}
2526	switch -- $who {
2527	"distance" {
2528	SendCmd [list camera dist $_view(distance)]
2529	}
2530	"all" - "x" - "y" - "z" - "heading" - "pitch" - "srs" - "verticalDatum" {
2531	set duration 0.0
2532	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2533	}
2534	}
2535	}
2536	}
2537	}
2538
2539	itcl::body Rappture::MapViewer::GoToViewpoint { dataobj viewpoint {duration 2.0}} {
2540	array set view [subst {
2541	x 0
2542	y 0
2543	z 0
2544	heading 0
2545	pitch -90
2546	distance $_view(distance)
2547	srs "$_view(srs)"
2548	verticalDatum "$_view(verticalDatum)"
2549	}]
2550	array set view [$dataobj viewpoint $viewpoint]
2551	foreach key {x y z heading pitch distance srs verticalDatum} {
2552	if { [info exists view($key)] } {
2553	set _view($key) $view($key)
2554	}
2555	}
2556	# If map is projected, ignore pitch
2557	if {![MapIsGeocentric]} {
2558	set _view(pitch) -90
2559	}
2560	SendCmd [list camera set $_view(x) $_view(y) $_view(z) $_view(heading) $_view(pitch) $_view(distance) $duration $_view(srs) $_view(verticalDatum)]
2561	}
2562
2563	itcl::body Rappture::MapViewer::GetImage { args } {
2564	if { [image width $_image(download)] > 0 &&
2565	[image height $_image(download)] > 0 } {
2566	set bytes [$_image(download) data -format "jpeg -quality 100"]
2567	set bytes [Rappture::encoding::decode -as b64 $bytes]
2568	return [list .jpg $bytes]
2569	}
2570	return ""
2571	}
2572
2573	itcl::body Rappture::MapViewer::BuildDownloadPopup { popup command } {
2574	Rappture::Balloon $popup \
2575	-title "[Rappture::filexfer::label downloadWord] as..."
2576	set inner [$popup component inner]
2577	label $inner.summary -text "" -anchor w
2578
2579	radiobutton $inner.image_button -text "Image File" \
2580	-variable [itcl::scope _downloadPopup(format)] \
2581	-value image
2582	Rappture::Tooltip::for $inner.image_button \
2583	"Save as digital image."
2584
2585	button $inner.ok -text "Save" \
2586	-highlightthickness 0 -pady 2 -padx 3 \
2587	-command $command \
2588	-compound left \
2589	-image [Rappture::icon download]
2590
2591	button $inner.cancel -text "Cancel" \
2592	-highlightthickness 0 -pady 2 -padx 3 \
2593	-command [list $popup deactivate] \
2594	-compound left \
2595	-image [Rappture::icon cancel]
2596
2597	blt::table $inner \
2598	0,0 $inner.summary -cspan 2 \
2599	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2600	4,1 $inner.cancel -width .9i -fill y \
2601	4,0 $inner.ok -padx 2 -width .9i -fill y
2602	blt::table configure $inner r3 -height 4
2603	blt::table configure $inner r4 -pady 4
2604	raise $inner.image_button
2605	$inner.image_button invoke
2606	return $inner
2607	}
2608
2609	itcl::body Rappture::MapViewer::ToggleGrid {} {
2610	set _settings(grid) [expr !$_settings(grid)]
2611	AdjustSetting grid
2612	}
2613
2614	itcl::body Rappture::MapViewer::ToggleLighting {} {
2615	set _settings(terrain-lighting) [expr !$_settings(terrain-lighting)]
2616	AdjustSetting terrain-lighting
2617	}
2618
2619	itcl::body Rappture::MapViewer::ToggleWireframe {} {
2620	set _settings(terrain-wireframe) [expr !$_settings(terrain-wireframe)]
2621	AdjustSetting terrain-wireframe
2622	}
2623
2624	itcl::body Rappture::MapViewer::SetTerrainStyle { style } {
2625	array set settings {
2626	-ambient 0.03
2627	-color white
2628	-edgecolor black
2629	-edges 0
2630	-lighting 1
2631	-linewidth 1.0
2632	-vertscale 1.0
2633	-wireframe 0
2634	}
2635	array set settings $style
2636
2637	SendCmd "map terrain ambient $settings(-ambient)"
2638	set _settings(terrain-ambient) $settings(-ambient)
2639	SendCmd "map terrain edges $settings(-edges)"
2640	set _settings(terrain-edges) $settings(-edges)
2641	SendCmd "map terrain color [Color2RGB $settings(-color)]"
2642	#SendCmd "map terrain colormode constant"
2643	SendCmd "map terrain lighting $settings(-lighting)"
2644	set _settings(terrain-lighting) $settings(-lighting)
2645	SendCmd "map terrain linecolor [Color2RGB $settings(-edgecolor)]"
2646	#SendCmd "map terrain linewidth $settings(-linewidth)"
2647	SendCmd "map terrain vertscale $settings(-vertscale)"
2648	set _settings(terrain-vertscale) $settings(-vertscale)
2649	SendCmd "map terrain wireframe $settings(-wireframe)"
2650	set _settings(terrain-wireframe) $settings(-wireframe)
2651	}
2652
2653	itcl::body Rappture::MapViewer::SendStylesheetFiles { stylesheet } {
2654	set files [Rappture::Map::getFilesFromStylesheet $stylesheet]
2655	foreach file $files {
2656	SendFiles $file
2657	}
2658	}
2659
2660	itcl::body Rappture::MapViewer::SendFiles { path } {
2661	set isRelative [expr {[string first "://" $path] < 0 &&
2662	[string index $path 0] != "/"}]
2663	if {[string range $path 0 7] != "local://" &&
2664	!$isRelative} {
2665	return
2666	}
2667	DebugTrace "Local path: $path"
2668	if {!$isRelative} {
2669	set path [string range $path 8 end]
2670	}
2671	set basename [file rootname $path]
2672	if {[catch {set files [glob -path $basename .*]} err] != 0} {
2673	puts stderr "File not found: $path"
2674	return
2675	}
2676	foreach file $files {
2677	set name $file
2678	set type [file type $file]
2679	set size [file size $file]
2680	set f [open $file "r"]
2681	fconfigure $f -translation binary -encoding binary
2682	set data [read $f]
2683	close $f
2684	SendCmd [list file put $name $type $size]
2685	SendData $data
2686	}
2687	}
2688
2689	itcl::body Rappture::MapViewer::SetLayerStyle { dataobj layer } {
2690	array set info [$dataobj layer $layer]
2691	set tag $layer
2692	if { !$info(shared) } {
2693	set tag $dataobj-$layer
2694	}
2695	if { [info exists info(visible)] &&
2696	!$info(visible) } {
2697	set _visibility($tag) 0
2698	} else {
2699	set _visibility($tag) 1
2700	}
2701
2702	switch -- $info(type) {
2703	"image" {
2704	array set style {
2705	-minlevel 0
2706	-maxlevel 23
2707	-opacity 1.0
2708	}
2709	if { [info exists info(style)] } {
2710	DebugTrace "layer style: $info(style)"
2711	array set style $info(style)
2712	}
2713	if { [info exists info(opacity)] } {
2714	set style(-opacity) $info(opacity)
2715	set _opacity($tag) $info(opacity)
2716	}
2717	set _opacity($tag) [expr $style(-opacity) * 100]
2718	set coverage 0
2719	if { [info exists info(coverage)] } {
2720	set coverage $info(coverage)
2721	}
2722	switch -- $info(driver) {
2723	"arcgis" {
2724	SendCmd [list map layer add $tag image arcgis \
2725	$info(arcgis.url) $info(cache) $coverage $info(arcgis.token)]
2726	}
2727	"colorramp" {
2728	set cmapName "[regsub -all {::} ${tag} {}]"
2729	SendFiles $info(colorramp.url)
2730	SendCmd [list colormap define $cmapName $info(colorramp.colormap)]
2731	SendCmd [list map layer add $tag image colorramp \
2732	$info(colorramp.url) $info(cache) $coverage $info(colorramp.elevdriver) $info(profile) \
2733	$cmapName]
2734	}
2735	"debug" {
2736	SendCmd [list map layer add $tag image debug]
2737	}
2738	"gdal" {
2739	SendFiles $info(gdal.url)
2740	SendCmd [list map layer add $tag image gdal \
2741	$info(gdal.url) $info(cache) $coverage]
2742	}
2743	"tms" {
2744	SendCmd [list map layer add $tag image tms \
2745	$info(tms.url) $info(cache) $coverage]
2746	}
2747	"wms" {
2748	SendCmd [list map layer add $tag image wms \
2749	$info(wms.url) $info(cache) $coverage \
2750	$info(wms.layers) \
2751	$info(wms.format) \
2752	$info(wms.transparent)]
2753	}
2754	"xyz" {
2755	SendCmd [list map layer add $tag image xyz \
2756	$info(xyz.url) $info(cache) $coverage]
2757	}
2758	}
2759	SendCmd "map layer opacity $style(-opacity) $tag"
2760	}
2761	"elevation" {
2762	array set style {
2763	-minlevel 0
2764	-maxlevel 23
2765	}
2766	if { [info exists info(style)] } {
2767	array set style $info(style)
2768	}
2769	switch -- $info(driver) {
2770	"gdal" {
2771	SendFiles $info(gdal.url)
2772	SendCmd [list map layer add $tag elevation gdal \
2773	$info(gdal.url) $info(cache)]
2774	}
2775	"tms" {
2776	SendCmd [list map layer add $tag elevation tms \
2777	$info(tms.url) $info(cache)]
2778	}
2779	"wcs" {
2780	SendCmd [list map layer add $tag elevation wcs \
2781	$info(wcs.url) $info(cache) $info(wcs.identifier)]
2782	}
2783	}
2784	}
2785	"feature" {
2786	array set style {
2787	-opacity 1.0
2788	}
2789	if { [info exists info(style)] } {
2790	DebugTrace "layer style: $info(style)"
2791	array set style $info(style)
2792	}
2793	if { [info exists info(opacity)] } {
2794	set style(-opacity) $info(opacity)
2795	}
2796	set _opacity($tag) [expr $style(-opacity) * 100]
2797	DebugTrace "stylesheet: $info(stylesheet)"
2798	set script ""
2799	if { [info exists info(script)] } {
2800	set script $info(script)
2801	DebugTrace "script: $script"
2802	}
2803	set selectors [list]
2804	foreach selector [$dataobj selectors $layer] {
2805	array set sinfo [$dataobj selector $layer $selector]
2806	DebugTrace "$selector: [array get sinfo]"
2807	lappend selectors [array get sinfo]
2808	if {[info exists sinfo(styleExpression)]} {
2809	DebugTrace "$selector: $sinfo(styleExpression)"
2810	} elseif {[info exists sinfo(query)]} {
2811	if {[info exists sinfo(queryBounds)]} {
2812	foreach {x1 y1 x2 y2} $sinfo(queryBounds) break
2813	DebugTrace "queryBounds: xmin $x1 ymin $y1 xmax $x2 ymax $y2"
2814	}
2815	}
2816	}
2817	SendStylesheetFiles $info(stylesheet)
2818	set ssSize [string length $info(stylesheet)]
2819	set scriptSize [string length $script]
2820	set selectorsSize [string length $selectors]
2821	switch -- $info(driver) {
2822	"ogr" {
2823	if { [info exists info(ogr.connection)] } {
2824	set cmd [list map layer add $tag feature db {} $info(ogr.layer) $info(ogr.connection) $info(cache) $ssSize $scriptSize $selectorsSize]
2825	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2826	lappend cmd $style(-minrange) $style(-maxrange)
2827	}
2828	} else {
2829	set cmd [list map layer add $tag feature $info(driver) {} {} $info(ogr.url) $info(cache) $ssSize $scriptSize $selectorsSize]
2830	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2831	lappend cmd $style(-minrange) $style(-maxrange)
2832	}
2833	SendFiles $info(ogr.url)
2834	}
2835	}
2836	"tfs" {
2837	set format "json"
2838	if {[info exists info(tfs.format)]} {
2839	set format $info(tfs.format)
2840	}
2841	set cmd [list map layer add $tag feature $info(driver) $format {} $info(tfs.url) $info(cache) $ssSize $scriptSize $selectorsSize]
2842	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2843	lappend cmd $style(-minrange) $style(-maxrange)
2844	}
2845	}
2846	"wfs" {
2847	set format "json"
2848	if {[info exists info(wfs.format)]} {
2849	set format $info(wfs.format)
2850	}
2851	set wfsType ""
2852	if {[info exists info(wfs.typename)]} {
2853	set wfsType $info(wfs.typename)
2854	}
2855	set cmd [list map layer add $tag feature $info(driver) $format $wfsType $info(wfs.url) $info(cache) $ssSize $scriptSize $selectorsSize]
2856	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2857	lappend cmd $style(-minrange) $style(-maxrange)
2858	}
2859	}
2860	}
2861	SendCmd $cmd
2862	if { $ssSize > 0 } { SendData $info(stylesheet) }
2863	if { $scriptSize > 0 } { SendData $script }
2864	if { $selectorsSize > 0 } { SendData $selectors }
2865	SendCmd "map layer opacity $style(-opacity) $tag"
2866	}
2867	"line" {
2868	array set style {
2869	-cap "flat"
2870	-clamping terrain
2871	-clamptechnique gpu
2872	-color black
2873	-join "mitre"
2874	-minbias 1000
2875	-opacity 1.0
2876	-stipplepattern 0
2877	-stipplefactor 1
2878	-width 1
2879	}
2880	if { [info exists info(style)] } {
2881	array set style $info(style)
2882	}
2883	if { [info exists info(opacity)] } {
2884	set style(-opacity) $info(opacity)
2885	}
2886	set _opacity($tag) [expr $style(-opacity) * 100]
2887	foreach {r g b} [Color2RGB $style(-color)] {}
2888	switch -- $info(driver) {
2889	"ogr" {
2890	SendFiles $info(ogr.url)
2891	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2892	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)]
2893	} else {
2894	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)]
2895	}
2896	}
2897	"tfs" {
2898	set format "json"
2899	if {[info exists info(tfs.format)]} {
2900	set format $info(tfs.format)
2901	}
2902	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2903	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)]
2904	} else {
2905	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)]
2906	}
2907	}
2908	"wfs" {
2909	set format "json"
2910	if {[info exists info(wfs.format)]} {
2911	set format $info(wfs.format)
2912	}
2913	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2914	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)]
2915	} else {
2916	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)]
2917	}
2918	}
2919	}
2920	SendCmd "map layer opacity $style(-opacity) $tag"
2921	}
2922	"point" {
2923	array set style {
2924	-color black
2925	-minbias 1000
2926	-opacity 1.0
2927	-size 1
2928	}
2929	if { [info exists info(style)] } {
2930	array set style $info(style)
2931	}
2932	if { [info exists info(opacity)] } {
2933	set style(-opacity) $info(opacity)
2934	}
2935	set _opacity($tag) [expr $style(-opacity) * 100]
2936	foreach {r g b} [Color2RGB $style(-color)] {}
2937	switch -- $info(driver) {
2938	"ogr" {
2939	SendFiles $info(ogr.url)
2940	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2941	SendCmd [list map layer add $tag point ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2942	} else {
2943	SendCmd [list map layer add $tag point ogr {} {} $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2944	}
2945	}
2946	"tfs" {
2947	set format "json"
2948	if {[info exists info(tfs.format)]} {
2949	set format $info(tfs.format)
2950	}
2951	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2952	SendCmd [list map layer add $tag point tfs $format {} $info(ogr.url) $info(cache) $r $g $b $style(-size) $style(-minrange) $style(-maxrange)]
2953	} else {
2954	SendCmd [list map layer add $tag point tfs $format {} $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2955	}
2956	}
2957	"wfs" {
2958	set format "json"
2959	if {[info exists info(wfs.format)]} {
2960	set format $info(wfs.format)
2961	}
2962	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2963	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)]
2964	} else {
2965	SendCmd [list map layer add $tag point wfs $format $info(wfs.typename) $info(ogr.url) $info(cache) $r $g $b $style(-size)]
2966	}
2967	}
2968	}
2969	SendCmd "map layer opacity $style(-opacity) $tag"
2970	}
2971	"icon" {
2972	array set style {
2973	-align "center_bottom"
2974	-declutter 1
2975	-heading {}
2976	-icon pin
2977	-minbias 1000
2978	-opacity 1.0
2979	-placement "vertex"
2980	-scale {}
2981	}
2982	if { [info exists info(style)] } {
2983	array set style $info(style)
2984	}
2985	if { [info exists info(opacity)] } {
2986	set style(-opacity) $info(opacity)
2987	}
2988	set _opacity($tag) [expr $style(-opacity) * 100]
2989	switch -- $info(driver) {
2990	"ogr" {
2991	SendFiles $info(ogr.url)
2992	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
2993	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)]
2994	} else {
2995	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)]
2996	}
2997	}
2998	"tfs" {
2999	set format "json"
3000	if {[info exists info(tfs.format)]} {
3001	set format $info(tfs.format)
3002	}
3003	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3004	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)]
3005	} else {
3006	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)]
3007	}
3008	}
3009	"wfs" {
3010	set format "json"
3011	if {[info exists info(wfs.format)]} {
3012	set format $info(wfs.format)
3013	}
3014	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3015	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)]
3016	} else {
3017	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)]
3018	}
3019	}
3020	}
3021	SendCmd "map layer opacity $style(-opacity) $tag"
3022	}
3023	"polygon" {
3024	array set style {
3025	-clamping terrain
3026	-clamptechnique drape
3027	-color white
3028	-minbias 1000
3029	-opacity 1.0
3030	-strokecolor black
3031	-strokewidth 0.0
3032	}
3033	if { [info exists info(style)] } {
3034	array set style $info(style)
3035	}
3036	if { [info exists info(opacity)] } {
3037	set style(-opacity) $info(opacity)
3038	}
3039	set _opacity($tag) [expr $style(-opacity) * 100]
3040	foreach {r g b} [Color2RGB $style(-color)] {}
3041	foreach {strokeR strokeG strokeB} [Color2RGB $style(-strokecolor)] {}
3042	switch -- $info(driver) {
3043	"ogr" {
3044	SendFiles $info(ogr.url)
3045	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3046	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)]
3047	} else {
3048	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)]
3049	}
3050	}
3051	"tfs" {
3052	set format "json"
3053	if {[info exists info(tfs.format)]} {
3054	set format $info(tfs.format)
3055	}
3056	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3057	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)]
3058	} else {
3059	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)]
3060	}
3061	}
3062	"wfs" {
3063	set format "json"
3064	if {[info exists info(wfs.format)]} {
3065	set format $info(wfs.format)
3066	}
3067	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3068	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)]
3069	} else {
3070	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)]
3071	}
3072	}
3073	}
3074	SendCmd "map layer opacity $style(-opacity) $tag"
3075	}
3076	"label" {
3077	array set style {
3078	-align "left_baseline"
3079	-color black
3080	-declutter 1
3081	-font Arial
3082	-fontsize 16.0
3083	-halocolor white
3084	-halowidth 2.0
3085	-layout "left_to_right"
3086	-minbias 1000
3087	-opacity 1.0
3088	-removedupes 1
3089	-xoffset 0
3090	-yoffset 0
3091	}
3092	if { [info exists info(style)] } {
3093	array set style $info(style)
3094	}
3095	if { [info exists info(opacity)] } {
3096	set style(-opacity) $info(opacity)
3097	}
3098	set _opacity($tag) [expr $style(-opacity) * 100]
3099	set contentExpr $info(content)
3100	if {[info exists info(priority)]} {
3101	set priorityExpr $info(priority)
3102	} else {
3103	set priorityExpr ""
3104	}
3105	foreach {fgR fgG fgB} [Color2RGB $style(-color)] {}
3106	foreach {bgR bgG bgB} [Color2RGB $style(-halocolor)] {}
3107	switch -- $info(driver) {
3108	"ogr" {
3109	SendFiles $info(ogr.url)
3110	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3111	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)]
3112	} else {
3113	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)]
3114	}
3115	}
3116	"tfs" {
3117	set format "json"
3118	if {[info exists info(tfs.format)]} {
3119	set format $info(tfs.format)
3120	}
3121	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3122	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)]
3123	} else {
3124	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)]
3125	}
3126	}
3127	"wfs" {
3128	set format "json"
3129	if {[info exists info(wfs.format)]} {
3130	set format $info(wfs.format)
3131	}
3132	if {[info exists style(-minrange)] && [info exists style(-maxrange)]} {
3133	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)]
3134	} else {
3135	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)]
3136	}
3137	}
3138	}
3139	SendCmd "map layer opacity $style(-opacity) $tag"
3140	}
3141	}
3142
3143	if {[info exists info(placard)]} {
3144	if {$info(type) == "image" \|\| $info(type) == "elevation"} {
3145	error "Placard not supported on image or elevation layers"
3146	}
3147	array set placard [$dataobj getPlacardConfig $layer]
3148	SendCmd [list placard config $placard(attrlist) $placard(style) $placard(padding) $tag]
3149	}
3150
3151	SendCmd "map layer visible $_visibility($tag) $tag"
3152	}
3153
3154	itcl::body Rappture::MapViewer::SetLayerOpacity { dataobj layer {value 100}} {
3155	set tag $layer
3156	if {![$dataobj layer $layer shared]} {
3157	set tag $dataobj-$layer
3158	}
3159	set val $_opacity($tag)
3160	set sval [expr { 0.01 * double($val) }]
3161	SendCmd "map layer opacity $sval $tag"
3162	}
3163
3164	itcl::body Rappture::MapViewer::SetLayerVisibility { dataobj layer } {
3165	set tag $layer
3166	if {![$dataobj layer $layer shared]} {
3167	set tag $dataobj-$layer
3168	}
3169	set bool $_visibility($tag)
3170	SendCmd "map layer visible $bool $tag"
3171	}
3172
3173	itcl::body Rappture::MapViewer::UpdateLayerControls {} {
3174	set row 0
3175	set inner $_layersFrame
3176	if { [winfo exists $inner.layers] } {
3177	foreach w [winfo children $inner.layers] {
3178	destroy $w
3179	}
3180	}
3181	set f $inner.layers
3182	set attrib [list]
3183	set imgIdx 0
3184	# FIXME: This order may not match stacking order in server
3185	foreach dataobj [get -objects] {
3186	foreach layer [$dataobj layers] {
3187	array unset info
3188	array set info [$dataobj layer $layer]
3189	set tag $layer
3190	set ctlname $layer
3191	if {!$info(shared)} {
3192	set tag $dataobj-$layer
3193	set ctlname "[regsub -all {::} ${tag} {}]"
3194	}
3195	checkbutton $f.${ctlname}_visible \
3196	-text $info(label) \
3197	-font "Arial 9" -anchor w \
3198	-variable [itcl::scope _visibility($tag)] \
3199	-command [itcl::code $this \
3200	SetLayerVisibility $dataobj $layer]
3201	blt::table $f $row,0 $f.${ctlname}_visible -anchor w -pady 2 -cspan 2
3202	incr row
3203	if { $info(type) == "image" } {
3204	incr imgIdx
3205	if { $info(driver) == "colorramp" } {
3206	set colormap $ctlname
3207	if { ![info exists _image(legend-$colormap)] } {
3208	set _image(legend-$colormap) [image create photo]
3209	}
3210	itk_component add legend-$colormap-min {
3211	label $f.legend-$colormap-min -text 0
3212	}
3213	itk_component add legend-$colormap-max {
3214	label $f.legend-$colormap-max -text 1
3215	}
3216	itk_component add legend-$colormap {
3217	label $f.legend-$colormap -image $_image(legend-$colormap)
3218	}
3219	blt::table $f $row,0 $f.legend-$colormap-min -anchor w -pady 0
3220	blt::table $f $row,1 $f.legend-$colormap-max -anchor e -pady 0
3221	incr row
3222	blt::table $f $row,0 $f.legend-$colormap -anchor w -pady 2 -cspan 2
3223	incr row
3224	RequestLegend $colormap 256 16
3225	}
3226	}
3227	if { $info(type) != "elevation" &&
3228	($info(type) != "image" \|\| $imgIdx > 1) } {
3229	label $f.${ctlname}_opacity_l -text "Opacity" -font "Arial 9"
3230	::scale $f.${ctlname}_opacity -from 0 -to 100 \
3231	-orient horizontal -showvalue off \
3232	-variable [itcl::scope _opacity($tag)] \
3233	-width 10 \
3234	-command [itcl::code $this \
3235	SetLayerOpacity $dataobj $layer]
3236	Rappture::Tooltip::for $f.${ctlname}_opacity "Set opacity of $info(label) layer"
3237	blt::table $f $row,0 $f.${ctlname}_opacity_l -anchor w -pady 2
3238	blt::table $f $row,1 $f.${ctlname}_opacity -anchor w -pady 2
3239	incr row
3240	}
3241	set tooltip [list $info(description)]
3242	if { [info exists info(attribution)] &&
3243	$info(attribution) != ""} {
3244	lappend tooltip $info(attribution)
3245	}
3246	Rappture::Tooltip::for $f.${ctlname}_visible [join $tooltip \n]
3247	}
3248	set mapAttrib [$dataobj hints "attribution"]
3249	if { $mapAttrib != "" } {
3250	lappend attrib $mapAttrib
3251	}
3252	}
3253	SendCmd "[list map attrib [encoding convertto utf-8 [join $attrib ,]]]"
3254	label $f.map_attrib -text [join $attrib \n] -font "Arial 9"
3255	blt::table $f $row,0 $f.map_attrib -anchor sw -pady 2 -cspan 2
3256	#incr row
3257	if { $row > 0 } {
3258	blt::table configure $f r* c* -resize none
3259	blt::table configure $f r$row c1 -resize expand
3260	}
3261	}
3262
3263	itcl::body Rappture::MapViewer::UpdateViewpointControls {} {
3264	set row 0
3265	set inner $_viewpointsFrame
3266	if { [winfo exists $inner.viewpoints] } {
3267	foreach w [winfo children $inner.viewpoints] {
3268	destroy $w
3269	}
3270	}
3271	set f $inner.viewpoints
3272	foreach dataobj [get -objects] {
3273	foreach viewpoint [$dataobj viewpoints] {
3274	array unset info
3275	array set info [$dataobj viewpoint $viewpoint]
3276	button $f.${viewpoint}_go \
3277	-relief flat -compound left \
3278	-image [Rappture::icon placemark16] \
3279	-text $info(label) \
3280	-font "Arial 9" -anchor w \
3281	-command [itcl::code $this \
3282	GoToViewpoint $dataobj $viewpoint]
3283	label $f.${viewpoint}_label \
3284	-text $info(label) \
3285	-font "Arial 9" -anchor w
3286	blt::table $f $row,0 $f.${viewpoint}_go -anchor w -pady 2 -cspan 2
3287	#blt::table $f $row,1 $f.${viewpoint}_label -anchor w -pady 2
3288	Rappture::Tooltip::for $f.${viewpoint}_go $info(description)
3289	incr row
3290	}
3291	}
3292	if { $row > 0 } {
3293	blt::table configure $f r* c* -resize none
3294	blt::table configure $f r$row c1 -resize expand
3295	}
3296	}
3297
3298	# ----------------------------------------------------------------------
3299	# OPTION: -map
3300	# ----------------------------------------------------------------------
3301	itcl::configbody Rappture::MapViewer::map {
3302	if {$itk_option(-map) != "" } {
3303	if {[catch {$itk_option(-map) isa Rappture::Map} valid] != 0 \|\| !$valid} {
3304	error "bad value \"$itk_option(-map)\": should be Rappture::Map object"
3305	}
3306	$this clear
3307	$this add $itk_option(-map)
3308	$this scale $itk_option(-map)
3309	} else {
3310	$this clear
3311	}
3312
3313	if { [isconnected] } {
3314	$_dispatcher event -idle !rebuild
3315	}
3316	}

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

Download in other formats: