Context Navigation

source: branches/uiuc_vtk_viewers/gui/scripts/mapviewer.tcl @ 5053

Last change on this file since 5053 was 5053, checked in by dkearney, 9 years ago
Merge sync from trunk to uvv branch
File size: 82.7 KB

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

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

Download in other formats: