Context Navigation

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

Last change on this file since 6101 was 6101, checked in by ldelgass, 9 years ago
map camera zoom layer
File size: 111.9 KB

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

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

Download in other formats: