Context Navigation

source: branches/blt4/gui/scripts/heightmapviewer.tcl @ 1829

Last change on this file since 1829 was 1764, checked in by gah, 14 years ago

File size: 39.2 KB

Line
1
2	# ----------------------------------------------------------------------
3	# Component: heightmapviewer - 3D surface rendering
4	#
5	# This widget performs surface rendering on 3D scalar/vector datasets.
6	# It connects to the Nanovis server running on a rendering farm,
7	# transmits data, and displays the results.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2005 Purdue Research Foundation
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15
16	package require Itk
17	package require BLT
18	#package require Img
19
20	option add *HeightmapViewer.width 4i widgetDefault
21	option add *HeightmapViewer.height 4i widgetDefault
22	option add *HeightmapViewer.foreground black widgetDefault
23	option add *HeightmapViewer.plotBackground black widgetDefault
24	option add *HeightmapViewer.plotForeground white widgetDefault
25	option add *HeightmapViewer.plotOutline white widgetDefault
26	option add HeightmapViewer.font --helvetica-medium-r-normal--12- widgetDefault
27
28	# must use this name -- plugs into Rappture::resources::load
29	proc HeightmapViewer_init_resources {} {
30	Rappture::resources::register \
31	nanovis_server Rappture::HeightmapViewer::SetServerList
32	}
33
34	itcl::class Rappture::HeightmapViewer {
35	inherit Rappture::VisViewer
36
37	itk_option define -plotforeground plotForeground Foreground ""
38	itk_option define -plotbackground plotBackground Background ""
39	itk_option define -plotoutline plotOutline PlotOutline ""
40
41	constructor { hostlist args } {
42	Rappture::VisViewer::constructor $hostlist
43	} {
44	# defined below
45	}
46	destructor {
47	# defined below
48	}
49
50	public proc SetServerList { namelist } {
51	Rappture::VisViewer::SetServerList "nanovis" $namelist
52	}
53	public method add {dataobj {settings ""}}
54	public method get {args}
55	public method delete {args}
56	public method scale {args}
57	public method snap { w h }
58	public method download {option args}
59	public method parameters {title args} {
60	# do nothing
61	}
62	public method camera {option args}
63	protected method Connect {}
64	protected method Disconnect {}
65	public method isconnected {}
66
67	protected method SendCmd {string}
68	protected method ReceiveImage { args }
69	private method ReceiveLegend {tf vmin vmax size}
70	private method BuildViewTab {}
71	private method BuildCameraTab {}
72	private method PanCamera {}
73	protected method CurrentSurfaces {{what -all}}
74	protected method Rebuild {}
75	protected method Zoom {option}
76	protected method Pan {option x y}
77	protected method Rotate {option x y}
78
79	protected method State {comp}
80	protected method FixSettings {what {value ""}}
81	protected method GetTransfuncData {dataobj comp}
82	protected method Resize {}
83	private method EventuallyResize { w h }
84
85	private variable _outbuf ;# buffer for outgoing commands
86
87	private variable _dlist "" ;# list of data objects
88	private variable _obj2style ;# maps dataobj => style settings
89	private variable _obj2ovride ;# maps dataobj => style override
90	private variable _click ;# info used for Rotate operations
91	private variable _limits ;# autoscale min/max for all axes
92	private variable _view ;# view params for 3D view
93	private common _settings ;# Array of used for global variables
94	# for checkbuttons and radiobuttons.
95	private variable _serverObjs ;# contains all the dataobj-component
96	;# to heightmaps in the server
97	private variable _location ""
98	private variable _first ""
99	private variable _width 0
100	private variable _height 0
101	private common _hardcopy
102	private variable _buffering 0
103	private variable _resizePending 0
104	private variable _resizeLegendPending 0
105	}
106
107	itk::usual HeightmapViewer {
108	keep -background -foreground -cursor -font
109	keep -plotbackground -plotforeground
110	}
111	itk::usual TkPushbutton {
112	}
113
114	# ----------------------------------------------------------------------
115	# CONSTRUCTOR
116	# ----------------------------------------------------------------------
117	itcl::body Rappture::HeightmapViewer::constructor {hostlist args} {
118	# Draw legend event
119	$_dispatcher register !legend
120	$_dispatcher dispatch $this !legend \
121	"[itcl::code $this FixSettings legend]; list"
122
123	# Rebuild event
124	$_dispatcher register !rebuild
125	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
126
127	# Resize event.
128	$_dispatcher register !resize
129	$_dispatcher dispatch $this !resize "[itcl::code $this Resize]; list"
130
131	set _outbuf ""
132
133	#
134	# Populate parser with commands handle incoming requests
135	#
136	$_parser alias image [itcl::code $this ReceiveImage]
137	$_parser alias legend [itcl::code $this ReceiveLegend]
138
139	# Initialize the view to some default parameters.
140	array set _view {
141	theta 45
142	phi 45
143	psi 0
144	zoom 1.0
145	pan-x 0
146	pan-y 0
147	}
148	foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
149	set _limits($val) ""
150	}
151	array set _settings [subst {
152	$this-pan-x $_view(pan-x)
153	$this-pan-y $_view(pan-y)
154	$this-phi $_view(phi)
155	$this-psi $_view(psi)
156	$this-theta $_view(theta)
157	$this-surface 1
158	$this-xcutplane 0
159	$this-xcutposition 0
160	$this-ycutplane 0
161	$this-ycutposition 0
162	$this-zcutplane 0
163	$this-zcutposition 0
164	$this-zoom $_view(zoom)
165	}]
166
167	itk_component add 3dview {
168	canvas $itk_component(plotarea).vol \
169	-highlightthickness 0 -borderwidth 0
170	} {
171	usual
172	ignore -highlightthickness -borderwidth -background
173	}
174	$_image(plot) configure -data ""
175	$itk_component(3dview) create image 0 0 -anchor nw -image $_image(plot)
176	set f [$itk_component(main) component controls]
177	itk_component add zoom {
178	frame $f.zoom
179	}
180	pack $itk_component(zoom) -side top
181
182	itk_component add reset {
183	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
184	-highlightthickness 0 \
185	-image [Rappture::icon reset-view] \
186	-command [itcl::code $this Zoom reset]
187	} {
188	usual
189	ignore -highlightthickness
190	}
191	pack $itk_component(reset) -side top -padx 1 -pady { 4 0 }
192	Rappture::Tooltip::for $itk_component(reset) \
193	"Reset the view to the default zoom level"
194
195	itk_component add zoomin {
196	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
197	-highlightthickness 0 \
198	-image [Rappture::icon zoom-in] \
199	-command [itcl::code $this Zoom in]
200	} {
201	usual
202	ignore -highlightthickness
203	}
204	pack $itk_component(zoomin) -side top -padx 1 -pady { 4 0 }
205	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
206
207	itk_component add zoomout {
208	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
209	-highlightthickness 0 \
210	-image [Rappture::icon zoom-out] \
211	-command [itcl::code $this Zoom out]
212	} {
213	usual
214	ignore -highlightthickness
215	}
216	pack $itk_component(zoomout) -side top -padx 1 -pady { 4 }
217	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
218
219	itk_component add surface {
220	blt::tk::pushbutton $f.surface \
221	-onimage [Rappture::icon volume-on] \
222	-offimage [Rappture::icon volume-off] \
223	-command [itcl::code $this FixSettings surface] \
224	-variable [itcl::scope _settings($this-surface)]
225	}
226	$itk_component(surface) select
227	Rappture::Tooltip::for $itk_component(surface) \
228	"Toggle surfaces on/off"
229	pack $itk_component(surface) -padx 2 -pady 2
230
231	BuildViewTab
232	BuildCameraTab
233
234	set w [expr [winfo reqwidth $itk_component(hull)] - 80]
235	pack forget $itk_component(3dview)
236	pack $itk_component(3dview) -side left -fill both -expand yes
237
238
239	# Bindings for rotation via mouse
240	bind $itk_component(3dview) <ButtonPress-1> \
241	[itcl::code $this Rotate click %x %y]
242	bind $itk_component(3dview) <B1-Motion> \
243	[itcl::code $this Rotate drag %x %y]
244	bind $itk_component(3dview) <ButtonRelease-1> \
245	[itcl::code $this Rotate release %x %y]
246	bind $itk_component(3dview) <Configure> \
247	[itcl::code $this EventuallyResize %w %h]
248
249	# Bindings for panning via mouse
250	bind $itk_component(3dview) <ButtonPress-2> \
251	[itcl::code $this Pan click %x %y]
252	bind $itk_component(3dview) <B2-Motion> \
253	[itcl::code $this Pan drag %x %y]
254	bind $itk_component(3dview) <ButtonRelease-2> \
255	[itcl::code $this Pan release %x %y]
256
257	# Bindings for panning via keyboard
258	bind $itk_component(3dview) <KeyPress-Left> \
259	[itcl::code $this Pan set -10 0]
260	bind $itk_component(3dview) <KeyPress-Right> \
261	[itcl::code $this Pan set 10 0]
262	bind $itk_component(3dview) <KeyPress-Up> \
263	[itcl::code $this Pan set 0 -10]
264	bind $itk_component(3dview) <KeyPress-Down> \
265	[itcl::code $this Pan set 0 10]
266	bind $itk_component(3dview) <Shift-KeyPress-Left> \
267	[itcl::code $this Pan set -2 0]
268	bind $itk_component(3dview) <Shift-KeyPress-Right> \
269	[itcl::code $this Pan set 2 0]
270	bind $itk_component(3dview) <Shift-KeyPress-Up> \
271	[itcl::code $this Pan set 0 -2]
272	bind $itk_component(3dview) <Shift-KeyPress-Down> \
273	[itcl::code $this Pan set 0 2]
274
275	# Bindings for zoom via keyboard
276	bind $itk_component(3dview) <KeyPress-Prior> \
277	[itcl::code $this Zoom out]
278	bind $itk_component(3dview) <KeyPress-Next> \
279	[itcl::code $this Zoom in]
280
281	bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
282
283	if {[string equal "x11" [tk windowingsystem]]} {
284	# Bindings for zoom via mouse
285	bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
286	bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
287	}
288
289	set _image(download) [image create picture]
290	eval itk_initialize $args
291	Connect
292	}
293
294	# ----------------------------------------------------------------------
295	# DESTRUCTOR
296	# ----------------------------------------------------------------------
297	itcl::body Rappture::HeightmapViewer::destructor {} {
298	$_dispatcher cancel !rebuild
299	image delete $_image(plot)
300	image delete $_image(legend)
301	image delete $_image(download)
302	}
303
304	# ----------------------------------------------------------------------
305	# USAGE: add <dataobj> ?<settings>?
306	#
307	# Clients use this to add a data object to the plot. The optional
308	# <settings> are used to configure the plot. Allowed settings are
309	# -color, -brightness, -width, -linestyle, and -raise.
310	# ----------------------------------------------------------------------
311	itcl::body Rappture::HeightmapViewer::add {dataobj {settings ""}} {
312	array set params {
313	-color auto
314	-width 1
315	-linestyle solid
316	-brightness 0
317	-raise 0
318	-description ""
319	-param ""
320	}
321	foreach {opt val} $settings {
322	if {![info exists params($opt)]} {
323	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
324	}
325	set params($opt) $val
326	}
327	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
328	# can't handle -autocolors yet
329	set params(-color) black
330	}
331	set pos [lsearch -exact $dataobj $_dlist]
332	if {$pos < 0} {
333	lappend _dlist $dataobj
334	set _obj2ovride($dataobj-color) $params(-color)
335	set _obj2ovride($dataobj-width) $params(-width)
336	set _obj2ovride($dataobj-raise) $params(-raise)
337	set _obj2ovride($dataobj-brightness) $params(-brightness)
338	$_dispatcher event -idle !rebuild
339	}
340	scale $dataobj
341	}
342
343	# ----------------------------------------------------------------------
344	# USAGE: get ?-objects?
345	# USAGE: get ?-image 3dview\|legend?
346	#
347	# Clients use this to query the list of objects being plotted, in
348	# order from bottom to top of this result. The optional "-image"
349	# flag can also request the internal images being shown.
350	# ----------------------------------------------------------------------
351	itcl::body Rappture::HeightmapViewer::get { args } {
352	if {[llength $args] == 0} {
353	set args "-objects"
354	}
355
356	set op [lindex $args 0]
357	switch -- $op {
358	-objects {
359	# put the dataobj list in order according to -raise options
360	set dlist $_dlist
361	foreach obj $dlist {
362	if { [info exists _obj2ovride($obj-raise)] &&
363	$_obj2ovride($obj-raise)} {
364	set i [lsearch -exact $dlist $obj]
365	if {$i >= 0} {
366	set dlist [lreplace $dlist $i $i]
367	lappend dlist $obj
368	}
369	}
370	}
371	return $dlist
372	}
373	-image {
374	if {[llength $args] != 2} {
375	error "wrong # args: should be \"get -image 3dview\|legend\""
376	}
377	switch -- [lindex $args end] {
378	3dview {
379	return $_image(plot)
380	}
381	legend {
382	return $_image(legend)
383	}
384	default {
385	error "bad image name \"[lindex $args end]\": should be 3dview or legend"
386	}
387	}
388	}
389	default {
390	error "bad option \"$op\": should be -objects or -image"
391	}
392	}
393	}
394
395	# ----------------------------------------------------------------------
396	# USAGE: delete ?<dataobj1> <dataobj2> ...?
397	#
398	# Clients use this to delete a dataobj from the plot. If no dataobjs
399	# are specified, then all dataobjs are deleted.
400	# ----------------------------------------------------------------------
401	itcl::body Rappture::HeightmapViewer::delete { args } {
402	if {[llength $args] == 0} {
403	set args $_dlist
404	}
405
406	# delete all specified dataobjs
407	set changed 0
408	foreach dataobj $args {
409	set pos [lsearch -exact $_dlist $dataobj]
410	if {$pos >= 0} {
411	set _dlist [lreplace $_dlist $pos $pos]
412	foreach key [array names _obj2ovride $dataobj-*] {
413	unset _obj2ovride($key)
414	}
415	array unset _serverObjs $dataobj-*
416	set changed 1
417	}
418	}
419
420	# if anything changed, then rebuild the plot
421	if {$changed} {
422	$_dispatcher event -idle !rebuild
423	}
424	}
425
426	# ----------------------------------------------------------------------
427	# USAGE: scale ?<data1> <data2> ...?
428	#
429	# Sets the default limits for the overall plot according to the
430	# limits of the data for all of the given <data> objects. This
431	# accounts for all objects--even those not showing on the screen.
432	# Because of this, the limits are appropriate for all objects as
433	# the user scans through data in the ResultSet viewer.
434	# ----------------------------------------------------------------------
435	itcl::body Rappture::HeightmapViewer::scale { args } {
436	if 0 {
437	foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
438	set _limits($val) ""
439	}
440	}
441	foreach obj $args {
442	foreach axis {x y z v} {
443	foreach {min max} [$obj limits $axis] break
444	if {"" != $min && "" != $max} {
445	if {"" == $_limits(${axis}min)} {
446	set _limits(${axis}min) $min
447	set _limits(${axis}max) $max
448	} else {
449	if {$min < $_limits(${axis}min)} {
450	set _limits(${axis}min) $min
451	}
452	if {$max > $_limits(${axis}max)} {
453	set _limits(${axis}max) $max
454	}
455	}
456	set _limits(${axis}range) [expr {$max - $min}]
457	}
458	}
459	}
460	}
461
462	# ----------------------------------------------------------------------
463	# USAGE: download coming
464	# USAGE: download controls <downloadCommand>
465	# USAGE: download now
466	#
467	# Clients use this method to create a downloadable representation
468	# of the plot. Returns a list of the form {ext string}, where
469	# "ext" is the file extension (indicating the type of data) and
470	# "string" is the data itself.
471	# ----------------------------------------------------------------------
472	itcl::body Rappture::HeightmapViewer::download {option args} {
473	switch $option {
474	coming {
475	if {[catch {$_image(download) snap $itk_component(plotarea)}]} {
476	$_image(download) blank #000000
477	}
478	}
479	controls {
480	# no controls for this download yet
481	return ""
482	}
483	now {
484	$_image(download) export jpg -quality 100 -data bytes
485	return [list .jpg $bytes]
486	}
487	default {
488	error "bad option \"$option\": should be coming, controls, now"
489	}
490	}
491	}
492
493	#
494	# isconnected --
495	#
496	# Indicates if we are currently connected to the visualization server.
497	#
498	itcl::body Rappture::HeightmapViewer::isconnected {} {
499	return [VisViewer::IsConnected]
500	}
501
502	# ----------------------------------------------------------------------
503	# USAGE: Connect ?<host:port>,<host:port>...?
504	#
505	# Clients use this method to establish a connection to a new
506	# server, or to reestablish a connection to the previous server.
507	# Any existing connection is automatically closed.
508	# ----------------------------------------------------------------------
509	itcl::body Rappture::HeightmapViewer::Connect {} {
510	Disconnect
511	set _hosts [GetServerList "nanovis"]
512	if { "" == $_hosts } {
513	return 0
514	}
515	catch {unset _serverObjs}
516	set result [VisViewer::Connect $_hosts]
517	return $result
518	}
519
520	# ----------------------------------------------------------------------
521	# USAGE: Disconnect
522	#
523	# Clients use this method to disconnect from the current rendering
524	# server.
525	# ----------------------------------------------------------------------
526	itcl::body Rappture::HeightmapViewer::Disconnect {} {
527	VisViewer::Disconnect
528
529	set _outbuf ""
530	# disconnected -- no more data sitting on server
531	}
532
533	#
534	# SendCmd
535	#
536	# Send commands off to the rendering server. If we're currently
537	# sending data objects to the server, buffer the commands to be
538	# sent later.
539	#
540	itcl::body Rappture::HeightmapViewer::SendCmd {string} {
541	if { $_buffering } {
542	append _outbuf $string "\n"
543	} else {
544	foreach line [split $string \n] {
545	SendEcho >>line $line
546	}
547	SendBytes "$string\n"
548	}
549	}
550
551	# ----------------------------------------------------------------------
552	# USAGE: ReceiveImage -bytes <size>
553	#
554	# Invoked automatically whenever the "image" command comes in from
555	# the rendering server. Indicates that binary image data with the
556	# specified <size> will follow.
557	# ----------------------------------------------------------------------
558	itcl::body Rappture::HeightmapViewer::ReceiveImage { args } {
559	if {![IsConnected]} {
560	return
561	}
562	array set info {
563	-type image
564	}
565	array set info $args
566	set bytes [ReceiveBytes $info(-bytes)]
567	ReceiveEcho <<line "<read $info(-bytes) bytes"
568	if { $info(-type) == "image" } {
569	$_image(plot) configure -data $bytes
570	ReceiveEcho <<line "<read for [image width $_image(plot)]x[image height $_image(plot)] image>"
571	} elseif { $info(type) == "print" } {
572	set tag $this-print-$info(-token)
573	set _hardcopy($tag) $bytes
574	}
575	}
576
577	# ----------------------------------------------------------------------
578	# USAGE: ReceiveLegend <tf> <vmin> <vmax> <size>
579	#
580	# Invoked automatically whenever the "legend" command comes in from
581	# the rendering server. Indicates that binary image data with the
582	# specified <size> will follow.
583	# ----------------------------------------------------------------------
584	itcl::body Rappture::HeightmapViewer::ReceiveLegend {obj vmin vmax size} {
585	if { [IsConnected] } {
586	set bytes [ReceiveBytes $size]
587	if { ![info exists _image(legend)] } {
588	set _image(legend) [image create picture]
589	}
590	ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
591	set src [image create picture -data $bytes]
592	$_image(legend) rotate $src 90
593	image delete $src
594
595	set c $itk_component(3dview)
596	set w [winfo width $c]
597	set h [winfo height $c]
598	set lineht [font metrics $itk_option(-font) -linespace]
599
600	if { $_settings($this-legend) } {
601	if { [$c find withtag "legend"] == "" } {
602	$c create image [expr {$w-2}] [expr {$lineht+2}] -anchor ne \
603	-image $_image(legend) -tags "transfunc legend"
604	$c create text [expr {$w-2}] 2 -anchor ne \
605	-fill $itk_option(-plotforeground) -tags "vmax legend" \
606	-font "Arial 8 bold"
607	$c create text [expr {$w-2}] [expr {$h-2}] -anchor se \
608	-fill $itk_option(-plotforeground) -tags "vmin legend" \
609	-font "Arial 8 bold"
610	}
611	# Reset the item coordinates according the current size of the plot.
612	$c coords transfunc [expr {$w-2}] [expr {$lineht+2}]
613	$c itemconfigure vmin -text $vmin
614	$c itemconfigure vmax -text $vmax
615	$c coords vmin [expr {$w-2}] [expr {$h-2}]
616	$c coords vmax [expr {$w-2}] 2
617	}
618	}
619	}
620
621	# ----------------------------------------------------------------------
622	# USAGE: Rebuild
623	#
624	# Called automatically whenever something changes that affects the
625	# data in the widget. Clears any existing data and rebuilds the
626	# widget to display new data.
627	# ----------------------------------------------------------------------
628	itcl::body Rappture::HeightmapViewer::Rebuild {} {
629
630	# Turn on buffering of commands to the server. We don't want to
631	# be preempted by a server disconnect/reconnect (which automatically
632	# generates a new call to Rebuild).
633	set _buffering 1
634
635	# Reset the overall limits
636	set _limits(vmin) ""
637	set _limits(vmax) ""
638
639	set _first ""
640	# Turn on buffering of commands to the server. We don't want to
641	# be preempted by a server disconnect/reconnect (which automatically
642	# generates a new call to Rebuild).
643	set _buffering 1
644
645	set w [winfo width $itk_component(3dview)]
646	set h [winfo height $itk_component(3dview)]
647	EventuallyResize $w $h
648
649	foreach dataobj [get] {
650	foreach comp [$dataobj components] {
651	# Tell the engine to expect some data
652	set tag $dataobj-$comp
653	if { ![info exists _serverObjs($tag)] } {
654	set data [$dataobj blob $comp]
655	set nbytes [string length $data]
656	append _outbuf "heightmap data follows $nbytes $dataobj-$comp\n"
657	append _outbuf $data
658
659	set _serverObjs($tag) $tag
660
661	# Determine the transfer function needed for this surface
662	# and make sure that it's defined on the server.
663	foreach {sname cmap wmap} [GetTransfuncData $dataobj $comp] break
664	SendCmd [list "transfunc" "define" $sname $cmap $wmap]
665	set _obj2style($tag) $sname
666	}
667	}
668	}
669
670	# Nothing to send -- activate the proper surface
671	set _first [lindex [get] 0]
672	if {"" != $_first} {
673	set axis [$_first hints updir]
674	if {"" != $axis} {
675	SendCmd "up $axis"
676	}
677	# This is where the initial camera position is set.
678	set location [$_first hints camera]
679	if { $_location == "" && $location != "" } {
680	array set _view $location
681	set _location $location
682	}
683	}
684	SendCmd "heightmap data visible 0"
685	set heightmaps [CurrentSurfaces]
686	if { $heightmaps != "" && $_settings($this-surface) } {
687	SendCmd "heightmap data visible 1 $heightmaps"
688	}
689	set heightmaps [CurrentSurfaces -raise]
690	if { $heightmaps != "" } {
691	SendCmd "heightmap opacity 0.25"
692	SendCmd "heightmap opacity 0.95 $heightmaps"
693	} else {
694	SendCmd "heightmap opacity 0.85"
695	}
696	foreach key $heightmaps {
697	if {[info exists _obj2style($key)]} {
698	SendCmd "heightmap transfunc $_obj2style($key) $key"
699	}
700	}
701	$_dispatcher event -idle !legend
702
703	if {"" == $itk_option(-plotoutline)} {
704	SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
705	}
706	# Reset the camera and other view parameters
707	set _settings($this-theta) $_view(theta)
708	set _settings($this-phi) $_view(phi)
709	set _settings($this-psi) $_view(psi)
710	set _settings($this-pan-x) $_view(pan-x)
711	set _settings($this-pan-y) $_view(pan-y)
712	set _settings($this-zoom) $_view(zoom)
713
714	set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
715	SendCmd "camera angle $xyz"
716	PanCamera
717	SendCmd "camera zoom $_view(zoom)"
718
719	FixSettings wireframe
720	FixSettings grid
721	FixSettings axes
722	FixSettings contourlines
723
724	# Actually write the commands to the server socket. If it fails, we don't
725	# care. We're finished here.
726	blt::busy hold $itk_component(hull)
727	SendBytes $_outbuf;
728	blt::busy release $itk_component(hull)
729	set _buffering 0; # Turn off buffering.
730	set _outbuf ""; # Clear the buffer.
731	}
732
733	# ----------------------------------------------------------------------
734	# USAGE: Zoom in
735	# USAGE: Zoom out
736	# USAGE: Zoom reset
737	#
738	# Called automatically when the user clicks on one of the zoom
739	# controls for this widget. Changes the zoom for the current view.
740	# ----------------------------------------------------------------------
741	itcl::body Rappture::HeightmapViewer::Zoom {option} {
742	switch -- $option {
743	"in" {
744	set _view(zoom) [expr {$_view(zoom)*1.25}]
745	set _settings($this-zoom) $_view(zoom)
746	}
747	"out" {
748	set _view(zoom) [expr {$_view(zoom)*0.8}]
749	set _settings($this-zoom) $_view(zoom)
750	}
751	"reset" {
752	array set _view {
753	theta 45
754	phi 45
755	psi 0
756	zoom 1.0
757	pan-x 0
758	pan-y 0
759	}
760	if { $_first != "" } {
761	set location [$_first hints camera]
762	if { $location != "" } {
763	array set _view $location
764	}
765	}
766	set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
767	SendCmd "camera angle $xyz"
768	PanCamera
769	set _settings($this-theta) $_view(theta)
770	set _settings($this-phi) $_view(phi)
771	set _settings($this-psi) $_view(psi)
772	set _settings($this-pan-x) $_view(pan-x)
773	set _settings($this-pan-y) $_view(pan-y)
774	set _settings($this-zoom) $_view(zoom)
775	}
776	}
777	SendCmd "camera zoom $_view(zoom)"
778	}
779
780	# ----------------------------------------------------------------------
781	# USAGE: $this Pan click x y
782	# $this Pan drag x y
783	# $this Pan release x y
784	#
785	# Called automatically when the user clicks on one of the zoom
786	# controls for this widget. Changes the zoom for the current view.
787	# ----------------------------------------------------------------------
788	itcl::body Rappture::HeightmapViewer::Pan {option x y} {
789	# Experimental stuff
790	set w [winfo width $itk_component(3dview)]
791	set h [winfo height $itk_component(3dview)]
792	if { $option == "set" } {
793	set x [expr ($x / double($w)) * $_limits(xrange)]
794	set y [expr ($y / double($h)) * $_limits(yrange)]
795	set _view(pan-x) [expr $_view(pan-x) + $x]
796	set _view(pan-y) [expr $_view(pan-y) + $y]
797	PanCamera
798	set _settings($this-pan-x) $_view(pan-x)
799	set _settings($this-pan-y) $_view(pan-y)
800	return
801	}
802	if { $option == "click" } {
803	set _click(x) $x
804	set _click(y) $y
805	$itk_component(3dview) configure -cursor hand1
806	}
807	if { $option == "drag" \|\| $option == "release" } {
808	set dx [expr (($_click(x) - $x)/double($w)) * $_limits(xrange)]
809	set dy [expr (($_click(y) - $y)/double($h)) * $_limits(yrange)]
810	set _click(x) $x
811	set _click(y) $y
812	set _view(pan-x) [expr $_view(pan-x) - $dx]
813	set _view(pan-y) [expr $_view(pan-y) - $dy]
814	PanCamera
815	set _settings($this-pan-x) $_view(pan-x)
816	set _settings($this-pan-y) $_view(pan-y)
817	}
818	if { $option == "release" } {
819	$itk_component(3dview) configure -cursor ""
820	}
821	}
822
823	itcl::body Rappture::HeightmapViewer::PanCamera {} {
824	set x [expr ($_view(pan-x)) / $_limits(xrange)]
825	set y [expr ($_view(pan-y)) / $_limits(yrange)]
826	SendCmd "camera pan $x $y"
827	}
828
829	# ----------------------------------------------------------------------
830	# USAGE: Rotate click <x> <y>
831	# USAGE: Rotate drag <x> <y>
832	# USAGE: Rotate release <x> <y>
833	#
834	# Called automatically when the user clicks/drags/releases in the
835	# plot area. Moves the plot according to the user's actions.
836	# ----------------------------------------------------------------------
837	itcl::body Rappture::HeightmapViewer::Rotate {option x y} {
838	switch -- $option {
839	click {
840	$itk_component(3dview) configure -cursor fleur
841	array set _click [subst {
842	x $x
843	y $y
844	theta $_view(theta)
845	phi $_view(phi)
846	}]
847	}
848	drag {
849	if {[array size _click] == 0} {
850	Rotate click $x $y
851	} else {
852	set w [winfo width $itk_component(3dview)]
853	set h [winfo height $itk_component(3dview)]
854	if {$w <= 0 \|\| $h <= 0} {
855	return
856	}
857
858	if {[catch {
859	# this fails sometimes for no apparent reason
860	set dx [expr {double($x-$_click(x))/$w}]
861	set dy [expr {double($y-$_click(y))/$h}]
862	}] != 0 } {
863	return
864	}
865
866	#
867	# Rotate the camera in 3D
868	#
869	if {$_view(psi) > 90 \|\| $_view(psi) < -90} {
870	# when psi is flipped around, theta moves backwards
871	set dy [expr {-$dy}]
872	}
873	set theta [expr {$_view(theta) - $dy*180}]
874	while {$theta < 0} { set theta [expr {$theta+180}] }
875	while {$theta > 180} { set theta [expr {$theta-180}] }
876
877	if {abs($theta) >= 30 && abs($theta) <= 160} {
878	set phi [expr {$_view(phi) - $dx*360}]
879	while {$phi < 0} { set phi [expr {$phi+360}] }
880	while {$phi > 360} { set phi [expr {$phi-360}] }
881	set psi $_view(psi)
882	} else {
883	set phi $_view(phi)
884	set psi [expr {$_view(psi) - $dx*360}]
885	while {$psi < -180} { set psi [expr {$psi+360}] }
886	while {$psi > 180} { set psi [expr {$psi-360}] }
887	}
888
889	set _view(theta) $theta
890	set _view(phi) $phi
891	set _view(psi) $psi
892	set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
893	set _settings($this-theta) $_view(theta)
894	set _settings($this-phi) $_view(phi)
895	set _settings($this-psi) $_view(psi)
896	SendCmd "camera angle $xyz"
897	set _click(x) $x
898	set _click(y) $y
899	}
900	}
901	release {
902	Rotate drag $x $y
903	$itk_component(3dview) configure -cursor ""
904	catch {unset _click}
905	}
906	default {
907	error "bad option \"$option\": should be click, drag, release"
908	}
909	}
910	}
911
912	# ----------------------------------------------------------------------
913	# USAGE: State <component>
914	#
915	# Used internally to determine the state of a toggle button.
916	# The <component> is the itk component name of the button.
917	# Returns on/off for the state of the button.
918	# ----------------------------------------------------------------------
919	itcl::body Rappture::HeightmapViewer::State {comp} {
920	if {[$itk_component($comp) cget -relief] == "sunken"} {
921	return "on"
922	}
923	return "off"
924	}
925
926	# ----------------------------------------------------------------------
927	# USAGE: FixSettings <what> ?<value>?
928	#
929	# Used internally to update rendering settings whenever parameters
930	# change in the popup settings panel. Sends the new settings off
931	# to the back end.
932	# ----------------------------------------------------------------------
933	itcl::body Rappture::HeightmapViewer::FixSettings { what {value ""} } {
934	switch -- $what {
935	"legend" {
936	if { !$_settings($this-legend) } {
937	$itk_component(3dview) delete "legend"
938	}
939	set lineht [font metrics $itk_option(-font) -linespace]
940	set w [winfo height $itk_component(3dview)]
941	set h [winfo width $itk_component(3dview)]
942	set w [expr {$w - 2*$lineht - 4}]
943	set h 12
944	set tag ""
945	if {"" != $_first} {
946	set comp [lindex [$_first components] 0]
947	set tag $_first-$comp
948	}
949	if {$w > 0 && $h > 0 && "" != $tag} {
950	SendCmd "heightmap legend $tag $w $h"
951	} else {
952	#$itk_component(legend) delete all
953	}
954	}
955	"surface" {
956	if { [isconnected] } {
957	SendCmd "heightmap data visible $_settings($this-surface)"
958	}
959	}
960	"grid" {
961	if { [IsConnected] } {
962	SendCmd "grid visible $_settings($this-grid)"
963	}
964	}
965	"axes" {
966	if { [IsConnected] } {
967	SendCmd "axis visible $_settings($this-axes)"
968	}
969	}
970	"wireframe" {
971	if { [IsConnected] } {
972	SendCmd "heightmap polygon $_settings($this-wireframe)"
973	}
974	}
975	"contourlines" {
976	if {[IsConnected]} {
977	if {"" != $_first} {
978	set comp [lindex [$_first components] 0]
979	if { $comp != "" } {
980	set tag $_first-$comp
981	set bool $_settings($this-contourlines)
982	SendCmd "heightmap linecontour visible $bool $tag"
983	}
984	}
985	}
986	}
987	default {
988	error "don't know how to fix $what: should be grid, axes, contourlines, or legend"
989	}
990	}
991	}
992
993	# ----------------------------------------------------------------------
994	# USAGE: GetTransfuncData <dataobj> <comp>
995	#
996	# Used internally to compute the colormap and alpha map used to define
997	# a transfer function for the specified component in a data object.
998	# Returns: name {v r g b ...} {v w ...}
999	# ----------------------------------------------------------------------
1000	itcl::body Rappture::HeightmapViewer::GetTransfuncData {dataobj comp} {
1001	array set style {
1002	-color rainbow
1003	-levels 6
1004	-opacity 0.5
1005	}
1006	array set style [lindex [$dataobj components -style $comp] 0]
1007	set sname "$style(-color):$style(-levels):$style(-opacity)"
1008
1009	if {$style(-color) == "rainbow"} {
1010	set style(-color) "white:yellow:green:cyan:blue:magenta"
1011	}
1012	if { [info exists style(-nonuniformcolors)] } {
1013	foreach { value color } $style(-nonuniformcolors) {
1014	append cmap "$value [Color2RGB $color] "
1015	}
1016	} else {
1017	set clist [split $style(-color) :]
1018	set cmap "0.0 [Color2RGB white] "
1019	for {set i 0} {$i < [llength $clist]} {incr i} {
1020	set x [expr {double($i+1)/([llength $clist]+1)}]
1021	set color [lindex $clist $i]
1022	append cmap "$x [Color2RGB $color] "
1023	}
1024	append cmap "1.0 [Color2RGB $color]"
1025	}
1026	set opacity $style(-opacity)
1027	set levels $style(-levels)
1028	set wmap {}
1029	if {[string is int $levels]} {
1030	lappend wmap 0.0 0.0
1031	set delta [expr {0.125/($levels+1)}]
1032	for {set i 1} {$i <= $levels} {incr i} {
1033	# add spikes in the middle
1034	set xval [expr {double($i)/($levels+1)}]
1035	lappend wmap [expr {$xval-$delta-0.01}] 0.0
1036	lappend wmap [expr {$xval-$delta}] $opacity
1037	lappend wmap [expr {$xval+$delta}] $opacity
1038	lappend wmap [expr {$xval+$delta+0.01}] 0.0
1039	}
1040	lappend wmap 1.0 0.0
1041	} else {
1042	lappend wmap 0.0 0.0
1043	set delta 0.05
1044	foreach xval [split $levels ,] {
1045	lappend wmap [expr {$xval-$delta}] 0.0
1046	lappend $xval $opacity
1047	lappend [expr {$xval+$delta}] 0.0
1048	}
1049	lappend wmap 1.0 0.0
1050	}
1051	return [list $sname $cmap $wmap]
1052	}
1053
1054	# ----------------------------------------------------------------------
1055	# CONFIGURATION OPTION: -plotbackground
1056	# ----------------------------------------------------------------------
1057	itcl::configbody Rappture::HeightmapViewer::plotbackground {
1058	foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1059	#fix this!
1060	#SendCmd "color background $r $g $b"
1061	}
1062
1063	# ----------------------------------------------------------------------
1064	# CONFIGURATION OPTION: -plotforeground
1065	# ----------------------------------------------------------------------
1066	itcl::configbody Rappture::HeightmapViewer::plotforeground {
1067	foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1068	#fix this!
1069	#SendCmd "color background $r $g $b"
1070	}
1071
1072	# ----------------------------------------------------------------------
1073	# CONFIGURATION OPTION: -plotoutline
1074	# ----------------------------------------------------------------------
1075	itcl::configbody Rappture::HeightmapViewer::plotoutline {
1076	if {[IsConnected]} {
1077	SendCmd "grid linecolor [Color2RGB $itk_option(-plotoutline)]"
1078	}
1079	}
1080
1081
1082
1083	# camera --
1084	#
1085	itcl::body Rappture::HeightmapViewer::camera {option args} {
1086	switch -- $option {
1087	"show" {
1088	puts [array get _view]
1089	}
1090	"set" {
1091	set who [lindex $args 0]
1092	set x $_settings($this-$who)
1093	set code [catch { string is double $x } result]
1094	if { $code != 0 \|\| !$result } {
1095	set _settings($this-$who) $_view($who)
1096	return
1097	}
1098	switch -- $who {
1099	"pan-x" - "pan-y" {
1100	set _view($who) $_settings($this-$who)
1101	PanCamera
1102	}
1103	"phi" - "theta" - "psi" {
1104	set _view($who) $_settings($this-$who)
1105	set xyz [Euler2XYZ $_view(theta) $_view(phi) $_view(psi)]
1106	SendCmd "camera angle $xyz"
1107	}
1108	"zoom" {
1109	set _view($who) $_settings($this-$who)
1110	SendCmd "camera zoom $_view(zoom)"
1111	}
1112	}
1113	}
1114	}
1115	}
1116
1117	itcl::body Rappture::HeightmapViewer::BuildViewTab {} {
1118	set fg [option get $itk_component(hull) font Font]
1119
1120	set tab [$itk_component(main) insert end \
1121	-title "View Settings" \
1122	-icon [Rappture::icon wrench]]
1123	blt::scrollset $tab.ss \
1124	-xscrollbar $tab.ss.xs \
1125	-yscrollbar $tab.ss.ys \
1126	-window $tab.ss.frame
1127	pack $tab.ss -fill both -expand yes
1128	blt::tk::scrollbar $tab.ss.xs
1129	blt::tk::scrollbar $tab.ss.ys
1130	set inner [blt::tk::frame $tab.ss.frame]
1131	$inner configure -borderwidth 4
1132
1133	foreach { key value } {
1134	grid 1
1135	axes 0
1136	contourlines 1
1137	wireframe fill
1138	legend 1
1139	} {
1140	set _settings($this-$key) $value
1141	}
1142
1143	checkbutton $inner.surface \
1144	-text "surface" \
1145	-variable [itcl::scope _settings($this-surface)] \
1146	-command [itcl::code $this FixSettings surface] \
1147	-font "Arial 9"
1148	checkbutton $inner.grid \
1149	-text "grid" \
1150	-variable [itcl::scope _settings($this-grid)] \
1151	-command [itcl::code $this FixSettings grid] \
1152	-font "Arial 9"
1153	checkbutton $inner.axes \
1154	-text "axes" \
1155	-variable ::Rappture::HeightmapViewer::_settings($this-axes) \
1156	-command [itcl::code $this FixSettings axes] \
1157	-font "Arial 9"
1158	checkbutton $inner.contourlines \
1159	-text "contour lines" \
1160	-variable ::Rappture::HeightmapViewer::_settings($this-contourlines) \
1161	-command [itcl::code $this FixSettings contourlines]\
1162	-font "Arial 9"
1163	checkbutton $inner.wireframe \
1164	-text "wireframe" \
1165	-onvalue "wireframe" -offvalue "fill" \
1166	-variable ::Rappture::HeightmapViewer::_settings($this-wireframe) \
1167	-command [itcl::code $this FixSettings wireframe]\
1168	-font "Arial 9"
1169	checkbutton $inner.legend \
1170	-text "legend" \
1171	-variable ::Rappture::HeightmapViewer::_settings($this-legend) \
1172	-command [itcl::code $this FixSettings legend]\
1173	-font "Arial 9"
1174
1175	blt::table $inner \
1176	0,1 $inner.surface -anchor w \
1177	1,1 $inner.grid -anchor w \
1178	2,1 $inner.axes -anchor w \
1179	3,1 $inner.contourlines -anchor w \
1180	4,1 $inner.wireframe -anchor w \
1181	5,1 $inner.legend -anchor w
1182
1183	blt::table configure $inner c2 -resize expand
1184	blt::table configure $inner c1 -resize none
1185	blt::table configure $inner r* -resize none
1186	blt::table configure $inner r6 -resize expand
1187	}
1188
1189	itcl::body Rappture::HeightmapViewer::BuildCameraTab {} {
1190	set fg [option get $itk_component(hull) font Font]
1191
1192	set tab [$itk_component(main) insert end \
1193	-title "Camera Settings" \
1194	-icon [Rappture::icon camera]]
1195	blt::scrollset $tab.ss \
1196	-xscrollbar $tab.ss.xs \
1197	-yscrollbar $tab.ss.ys \
1198	-window $tab.ss.frame
1199	pack $tab.ss -fill both -expand yes
1200	blt::tk::scrollbar $tab.ss.xs
1201	blt::tk::scrollbar $tab.ss.ys
1202	set inner [blt::tk::frame $tab.ss.frame]
1203	$inner configure -borderwidth 4
1204
1205	set labels { phi theta psi pan-x pan-y zoom }
1206	set row 1
1207	foreach tag $labels {
1208	label $inner.${tag}label -text $tag -font "Arial 9"
1209	entry $inner.${tag} -font "Arial 9" -bg white -width 10 \
1210	-textvariable [itcl::scope _settings($this-$tag)]
1211	bind $inner.${tag} <KeyPress-Return> \
1212	[itcl::code $this camera set ${tag}]
1213	blt::table $inner \
1214	$row,1 $inner.${tag}label -anchor e \
1215	$row,2 $inner.${tag} -anchor w
1216	blt::table configure $inner r$row -resize none
1217	incr row
1218	}
1219	blt::table configure $inner c1 c2 -resize none
1220	blt::table configure $inner c3 -resize expand
1221	blt::table configure $inner r$row -resize expand
1222	}
1223
1224	itcl::body Rappture::HeightmapViewer::Resize {} {
1225	SendCmd "screen $_width $_height"
1226	set _resizePending 0
1227	$_dispatcher event -idle !legend
1228	}
1229
1230	itcl::body Rappture::HeightmapViewer::EventuallyResize { w h } {
1231	set _width $w
1232	set _height $h
1233	if { !$_resizePending } {
1234	$_dispatcher event -after 200 !resize
1235	set _resizePending 1
1236	}
1237	}
1238
1239	# ----------------------------------------------------------------------
1240	# USAGE: CurrentVolumes ?-cutplanes?
1241	#
1242	# Returns a list of volume server IDs for the current volume being
1243	# displayed. This is normally a single ID, but it might be a list
1244	# of IDs if the current data object has multiple components.
1245	# ----------------------------------------------------------------------
1246	itcl::body Rappture::HeightmapViewer::CurrentSurfaces {{what -all}} {
1247	set list {}
1248	if { $what == "-all" } {
1249	foreach key [array names _serverObjs] {
1250	foreach {dataobj comp} [split $key -] break
1251	if { [info exists _obj2ovride($dataobj-raise)] } {
1252	lappend list $dataobj-$comp
1253	}
1254	}
1255	} else {
1256	foreach key [array names _serverObjs] {
1257	foreach {dataobj comp} [split $key -] break
1258	if { [info exists _obj2ovride($dataobj$what)] &&
1259	$_obj2ovride($dataobj$what) } {
1260	lappend list $dataobj-$comp
1261	}
1262	}
1263	}
1264	return $list
1265	}
1266
1267	itcl::body Rappture::HeightmapViewer::snap { w h } {
1268	if { $w <= 0 \|\| $h <= 0 } {
1269	set w [image width $_image(plot)]
1270	set h [image height $_image(plot)]
1271	}
1272	set img [image create picture -width $w -height $h]
1273	$img resample $_image(plot)
1274	return $img
1275	}

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

Download in other formats: