Context Navigation

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

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

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

Download in other formats: