Context Navigation

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

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

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

Download in other formats: