Context Navigation

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

Last change on this file since 5188 was 5188, checked in by ldelgass, 10 years ago
merge r5187 from 1.4 branch
File size: 91.3 KB

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

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

Download in other formats: