Context Navigation

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

Last change on this file since 5975 was 5975, checked in by ldelgass, 9 years ago
Add feature layer placard config to map object
File size: 110.2 KB

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

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

Download in other formats: