Context Navigation

source: branches/blt4_trunk/gui/scripts/mapviewer.tcl @ 6284

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

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

Download in other formats: