Context Navigation

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

Last change on this file since 6027 was 6027, checked in by ldelgass, 9 years ago
debug msgs
File size: 106.8 KB

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

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

Download in other formats: