Context Navigation

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

Last change on this file since 5008 was 5008, checked in by ldelgass, 10 years ago
whitespace
File size: 74.8 KB

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

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

Download in other formats: