Context Navigation

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

Last change on this file since 6224 was 6224, checked in by ldelgass, 8 years ago
Add client support for feature selection set add/delete/set.
File size: 113.2 KB

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

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

Download in other formats: