Context Navigation

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

Last change on this file since 6062 was 6062, checked in by ldelgass, 9 years ago
Cleanups in Map::scale: don't throw error on mismatched map global settings, just use the first dataobj for settings.
File size: 106.7 KB

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

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

Download in other formats: