Context Navigation

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

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

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

Download in other formats: