Context Navigation

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

Last change on this file since 6073 was 6073, checked in by ldelgass, 9 years ago
whitespace
File size: 107.6 KB

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

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

Download in other formats: