Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

vtkimageviewer.tcl

Last change on this file was 6377, checked in by ldelgass, 8 years ago
VTK (XML) files can have field names with spaces, so fix protocol to quote field names.
File size: 77.6 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: vtkimageviewer - Vtk image viewer
4	#
5	# It connects to the Vtkvis server running on a rendering farm,
6	# transmits data, and displays the results.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2016 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 *VtkImageViewer.width 4i widgetDefault
19	option add VtkImageViewercursor crosshair widgetDefault
20	option add *VtkImageViewer.height 4i widgetDefault
21	option add *VtkImageViewer.foreground black widgetDefault
22	option add *VtkImageViewer.controlBackground gray widgetDefault
23	option add *VtkImageViewer.controlDarkBackground #999999 widgetDefault
24	option add *VtkImageViewer.plotBackground black widgetDefault
25	option add *VtkImageViewer.plotForeground white widgetDefault
26	option add *VtkImageViewer.font \
27	--helvetica-medium-r-normal--12-* widgetDefault
28
29	# must use this name -- plugs into Rappture::resources::load
30	proc VtkImageViewer_init_resources {} {
31	Rappture::resources::register \
32	vtkvis_server Rappture::VtkImageViewer::SetServerList
33	}
34
35	itcl::class Rappture::VtkImageViewer {
36	inherit Rappture::VisViewer
37
38	itk_option define -plotforeground plotForeground Foreground ""
39	itk_option define -plotbackground plotBackground Background ""
40	itk_option define -mode mode Mode "vtkimage"
41
42	constructor { args } {
43	Rappture::VisViewer::constructor
44	} {
45	# defined below
46	}
47	destructor {
48	# defined below
49	}
50	public proc SetServerList { namelist } {
51	Rappture::VisViewer::SetServerList "vtkvis" $namelist
52	}
53	public method add {dataobj {settings ""}}
54	public method camera {option args}
55	public method delete {args}
56	public method disconnect {}
57	public method download {option args}
58	public method get {args}
59	public method isconnected {}
60	public method parameters {title args} {
61	# do nothing
62	}
63	public method scale {args}
64
65	# The following methods are only used by this class.
66	private method AdjustSetting {what {value ""}}
67	private method BuildAxisTab {}
68	private method BuildCameraTab {}
69	private method BuildColormap { name }
70	private method BuildImageTab {}
71	private method BuildDownloadPopup { widget command }
72	private method Connect {}
73	private method CurrentDatasets {args}
74	private method Disconnect {}
75	private method DoResize {}
76	private method DoRotate {}
77	private method DrawLegend {}
78	private method EnterLegend { x y }
79	private method EventuallyRequestLegend {}
80	private method EventuallyResize { w h }
81	private method EventuallyRotate { q }
82	private method GetImage { args }
83	private method GetVtkData { args }
84	private method InitSettings { args }
85	private method IsValidObject { dataobj }
86	private method LeaveLegend {}
87	private method LegendTitleAction { option }
88	private method MotionLegend { x y }
89	private method Pan {option x y}
90	private method PanCamera {}
91	private method Pick {x y}
92	private method QuaternionToView { q } {
93	foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
94	}
95	private method Rebuild {}
96	private method ReceiveDataset { args }
97	private method ReceiveImage { args }
98	private method ReceiveLegend { colormap title min max size }
99	private method RequestLegend {}
100	private method Rotate {option x y}
101	private method SetCurrentColormap { color }
102	private method SetCurrentFieldName { dataobj }
103	private method SetLegendTip { x y }
104	private method SetObjectStyle { dataobj comp }
105	private method SetOrientation { side }
106	private method ViewToQuaternion {} {
107	return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
108	}
109	private method Zoom {option}
110
111	private variable _arcball ""
112	private variable _dlist ""; # list of data objects
113	private variable _obj2ovride; # maps dataobj => style override
114	private variable _datasets; # contains all the dataobj-component
115	# datasets in the server
116	private variable _colormaps; # contains all the colormaps
117	# in the server.
118
119	# The name of the current colormap used. The colormap is global to all
120	# images displayed.
121	private variable _currentColormap ""
122	private variable _currentNumIsolines -1
123
124	private variable _maxScale 100; # This is the # of times the x-axis
125	# and y-axis ranges can differ before
126	# automatically turning on
127	# -stretchtofit
128
129	private variable _click; # info used for rotate operations
130	private variable _limits; # Holds overall limits for all dataobjs
131	# using the viewer.
132	private variable _view; # view params for 3D view
133	private variable _settings
134	private variable _changed
135	private variable _reset 1; # Connection to server has been reset.
136
137	private variable _first ""; # This is the topmost dataset.
138	private variable _start 0
139	private variable _isolines
140	private variable _contourList ""
141	private variable _width 0
142	private variable _height 0
143	private variable _legendWidth 0
144	private variable _legendHeight 0
145	private variable _resizePending 0
146	private variable _legendPending 0
147	private variable _rotatePending 0
148	private variable _fields
149	private variable _curFldName ""
150	private variable _curFldLabel ""
151	private variable _colorMode "scalar"; # Mode of colormap (vmag or scalar)
152
153	private common _downloadPopup; # download options from popup
154	private common _hardcopy
155	}
156
157	itk::usual VtkImageViewer {
158	keep -background -foreground -cursor -font
159	keep -plotbackground -plotforeground -mode
160	}
161
162	# ----------------------------------------------------------------------
163	# CONSTRUCTOR
164	# ----------------------------------------------------------------------
165	itcl::body Rappture::VtkImageViewer::constructor {args} {
166	set _serverType "vtkvis"
167
168	#DebugOn
169	EnableWaitDialog 900
170
171	# Rebuild event
172	$_dispatcher register !rebuild
173	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
174
175	# Resize event
176	$_dispatcher register !resize
177	$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
178
179	# Legend event
180	$_dispatcher register !legend
181	$_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
182
183	# Rotate event
184	$_dispatcher register !rotate
185	$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
186
187	#
188	# Populate parser with commands handle incoming requests
189	#
190	$_parser alias image [itcl::code $this ReceiveImage]
191	$_parser alias legend [itcl::code $this ReceiveLegend]
192	$_parser alias dataset [itcl::code $this ReceiveDataset]
193
194	# Create image for legend colorbar.
195	set _image(legend) [image create photo]
196
197	# Initialize the view to some default parameters.
198	array set _view {
199	-ortho 0
200	-qw 0.36
201	-qx 0.25
202	-qy 0.50
203	-qz 0.70
204	-xpan 0
205	-ypan 0
206	-zoom 1.0
207	}
208	set _arcball [blt::arcball create 100 100]
209	$_arcball quaternion [ViewToQuaternion]
210
211	array set _settings {
212	-axesvisible 1
213	-axislabels 1
214	-axisminorticks 1
215	-axismode "static"
216	-backingcolor white
217	-backingvisible 1
218	-colormapdiscrete 0
219	-field "Default"
220	-legendvisible 0
221	-level 127.5
222	-numcolors 256
223	-opacity 100
224	-outline 0
225	-saveopacity 100
226	-stretchtofit 0
227	-view3d 0
228	-window 255.0
229	-xgrid 0
230	-ygrid 0
231	-zgrid 0
232	}
233	array set _changed {
234	-colormap 0
235	-opacity 0
236	}
237	itk_component add view {
238	canvas $itk_component(plotarea).view \
239	-highlightthickness 0 -borderwidth 0
240	} {
241	usual
242	ignore -highlightthickness -borderwidth -background
243	}
244
245	itk_component add fieldmenu {
246	menu $itk_component(plotarea).menu -relief flat -tearoff 0
247	} {
248	usual
249	ignore -background -foreground -relief -tearoff
250	}
251	set c $itk_component(view)
252	bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
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 Zoom reset]
270	} {
271	usual
272	ignore -highlightthickness
273	}
274	pack $itk_component(reset) -side top -padx 2 -pady { 2 0 }
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 0 }
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 0 }
300	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
301
302	itk_component add mode {
303	Rappture::PushButton $f.mode \
304	-onimage [Rappture::icon surface] \
305	-offimage [Rappture::icon surface] \
306	-variable [itcl::scope _settings(-view3d)] \
307	-command [itcl::code $this AdjustSetting -view3d] \
308	}
309	Rappture::Tooltip::for $itk_component(mode) \
310	"Toggle the surface/contour on/off"
311	pack $itk_component(mode) -padx 2 -pady { 2 0 }
312
313	itk_component add stretchtofit {
314	Rappture::PushButton $f.stretchtofit \
315	-onimage [Rappture::icon stretchtofit] \
316	-offimage [Rappture::icon stretchtofit] \
317	-variable [itcl::scope _settings(-stretchtofit)] \
318	-command [itcl::code $this AdjustSetting -stretchtofit] \
319	}
320	Rappture::Tooltip::for $itk_component(stretchtofit) \
321	"Stretch plot to fit window on/off"
322	pack $itk_component(stretchtofit) -padx 2 -pady 2
323
324	if { [catch {
325	BuildImageTab
326	BuildAxisTab
327	BuildCameraTab
328	} errs] != 0 } {
329	global errorInfo
330	puts stderr "errs=$errs errorInfo=$errorInfo"
331	}
332
333	# Hack around the Tk panewindow. The problem is that the requested
334	# size of the 3d view isn't set until an image is retrieved from
335	# the server. So the panewindow uses the tiny size.
336	set w 10000
337	pack forget $itk_component(view)
338	blt::table $itk_component(plotarea) \
339	0,0 $itk_component(view) -fill both -reqwidth $w
340	blt::table configure $itk_component(plotarea) c1 -resize none
341
342	# Bindings for panning via mouse
343	bind $itk_component(view) <ButtonPress-2> \
344	[itcl::code $this Pan click %x %y]
345	bind $itk_component(view) <B2-Motion> \
346	[itcl::code $this Pan drag %x %y]
347	bind $itk_component(view) <ButtonRelease-2> \
348	[itcl::code $this Pan release %x %y]
349
350	#bind $itk_component(view) <ButtonRelease-3> \
351	# [itcl::code $this Pick %x %y]
352
353	# Bindings for panning via keyboard
354	bind $itk_component(view) <KeyPress-Left> \
355	[itcl::code $this Pan set -10 0]
356	bind $itk_component(view) <KeyPress-Right> \
357	[itcl::code $this Pan set 10 0]
358	bind $itk_component(view) <KeyPress-Up> \
359	[itcl::code $this Pan set 0 -10]
360	bind $itk_component(view) <KeyPress-Down> \
361	[itcl::code $this Pan set 0 10]
362	bind $itk_component(view) <Shift-KeyPress-Left> \
363	[itcl::code $this Pan set -2 0]
364	bind $itk_component(view) <Shift-KeyPress-Right> \
365	[itcl::code $this Pan set 2 0]
366	bind $itk_component(view) <Shift-KeyPress-Up> \
367	[itcl::code $this Pan set 0 -2]
368	bind $itk_component(view) <Shift-KeyPress-Down> \
369	[itcl::code $this Pan set 0 2]
370
371	# Bindings for zoom via keyboard
372	bind $itk_component(view) <KeyPress-Prior> \
373	[itcl::code $this Zoom out]
374	bind $itk_component(view) <KeyPress-Next> \
375	[itcl::code $this Zoom in]
376
377	bind $itk_component(view) <Enter> "focus $itk_component(view)"
378
379	if {[string equal "x11" [tk windowingsystem]]} {
380	# Bindings for zoom via mouse
381	bind $itk_component(view) <4> [itcl::code $this Zoom out]
382	bind $itk_component(view) <5> [itcl::code $this Zoom in]
383	}
384
385	set _image(download) [image create photo]
386
387	eval itk_initialize $args
388
389	Connect
390	}
391
392	# ----------------------------------------------------------------------
393	# DESTRUCTOR
394	# ----------------------------------------------------------------------
395	itcl::body Rappture::VtkImageViewer::destructor {} {
396	Disconnect
397	image delete $_image(plot)
398	image delete $_image(download)
399	catch { blt::arcball destroy $_arcball }
400	}
401
402	itcl::body Rappture::VtkImageViewer::DoResize {} {
403	if { $_width < 2 } {
404	set _width 500
405	}
406	if { $_height < 2 } {
407	set _height 500
408	}
409	set _start [clock clicks -milliseconds]
410	SendCmd "screen size [expr $_width - 20] $_height"
411
412	set font "Arial 8"
413	set lh [font metrics $font -linespace]
414	set h [expr {$_height - 2 * ($lh + 2)}]
415	if { $h != $_legendHeight } {
416	EventuallyRequestLegend
417	} else {
418	DrawLegend
419	}
420	set _resizePending 0
421	}
422
423	itcl::body Rappture::VtkImageViewer::DoRotate {} {
424	SendCmd "camera orient [ViewToQuaternion]"
425	set _rotatePending 0
426	}
427
428	itcl::body Rappture::VtkImageViewer::EventuallyRequestLegend {} {
429	if { !$_legendPending } {
430	set _legendPending 1
431	$_dispatcher event -idle !legend
432	}
433	}
434
435	itcl::body Rappture::VtkImageViewer::EventuallyResize { w h } {
436	set _width $w
437	set _height $h
438	$_arcball resize $w $h
439	if { !$_resizePending } {
440	set _resizePending 1
441	$_dispatcher event -after 250 !resize
442	}
443	}
444
445	itcl::body Rappture::VtkImageViewer::EventuallyRotate { q } {
446	QuaternionToView $q
447	if { !$_rotatePending } {
448	set _rotatePending 1
449	$_dispatcher event -after 100 !rotate
450	}
451	}
452
453	# ----------------------------------------------------------------------
454	# USAGE: add <dataobj> ?<settings>?
455	#
456	# Clients use this to add a data object to the plot. The optional
457	# <settings> are used to configure the plot. Allowed settings are
458	# -color, -brightness, -width, -linestyle, and -raise.
459	# ----------------------------------------------------------------------
460	itcl::body Rappture::VtkImageViewer::add {dataobj {settings ""}} {
461	if { ![$dataobj isvalid] } {
462	return; # Object doesn't contain valid data.
463	}
464	array set params {
465	-color auto
466	-width 1
467	-linestyle solid
468	-brightness 0
469	-raise 0
470	-description ""
471	-param ""
472	-type ""
473	}
474	array set params $settings
475
476	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
477	# can't handle -autocolors yet
478	set params(-color) white
479	}
480	set pos [lsearch -exact $_dlist $dataobj]
481	if {$pos < 0} {
482	lappend _dlist $dataobj
483	}
484	set _obj2ovride($dataobj-color) $params(-color)
485	set _obj2ovride($dataobj-width) $params(-width)
486	set _obj2ovride($dataobj-raise) $params(-raise)
487	$_dispatcher event -idle !rebuild
488	}
489
490
491	# ----------------------------------------------------------------------
492	# USAGE: delete ?<dataobj1> <dataobj2> ...?
493	#
494	# Clients use this to delete a dataobj from the plot. If no dataobjs
495	# are specified, then all dataobjs are deleted. No data objects are
496	# deleted. They are only removed from the display list.
497	# ----------------------------------------------------------------------
498	itcl::body Rappture::VtkImageViewer::delete {args} {
499	if { [llength $args] == 0} {
500	set args $_dlist
501	}
502	# Delete all specified dataobjs
503	set changed 0
504	foreach dataobj $args {
505	set pos [lsearch -exact $_dlist $dataobj]
506	if { $pos < 0 } {
507	continue; # Don't know anything about it.
508	}
509	# Remove it from the dataobj list.
510	set _dlist [lreplace $_dlist $pos $pos]
511	array unset _obj2ovride $dataobj-*
512	set changed 1
513	}
514	# If anything changed, then rebuild the plot
515	if { $changed } {
516	$_dispatcher event -idle !rebuild
517	}
518	}
519
520	# ----------------------------------------------------------------------
521	# USAGE: get ?-objects?
522	# USAGE: get ?-visible?
523	# USAGE: get ?-image view?
524	#
525	# Clients use this to query the list of objects being plotted, in
526	# order from bottom to top of this result. The optional "-image"
527	# flag can also request the internal images being shown.
528	# ----------------------------------------------------------------------
529	itcl::body Rappture::VtkImageViewer::get {args} {
530	if {[llength $args] == 0} {
531	set args "-objects"
532	}
533	set op [lindex $args 0]
534	switch -- $op {
535	"-objects" {
536	# put the dataobj list in order according to -raise options
537	set dlist {}
538	foreach dataobj $_dlist {
539	if { ![IsValidObject $dataobj] } {
540	continue
541	}
542	if {[info exists _obj2ovride($dataobj-raise)] &&
543	$_obj2ovride($dataobj-raise)} {
544	set dlist [linsert $dlist 0 $dataobj]
545	} else {
546	lappend dlist $dataobj
547	}
548	}
549	return $dlist
550	}
551	"-visible" {
552	set dlist {}
553	foreach dataobj $_dlist {
554	if { ![IsValidObject $dataobj] } {
555	continue
556	}
557	if { ![info exists _obj2ovride($dataobj-raise)] } {
558	# No setting indicates that the object isn't visible.
559	continue
560	}
561	# Otherwise use the -raise parameter to put the object to
562	# the front of the list.
563	if { $_obj2ovride($dataobj-raise) } {
564	set dlist [linsert $dlist 0 $dataobj]
565	} else {
566	lappend dlist $dataobj
567	}
568	}
569	return $dlist
570	}
571	"-image" {
572	if {[llength $args] != 2} {
573	error "wrong # args: should be \"get -image view\""
574	}
575	switch -- [lindex $args end] {
576	view {
577	return $_image(plot)
578	}
579	default {
580	error "bad image name \"[lindex $args end]\": should be view"
581	}
582	}
583	}
584	default {
585	error "bad option \"$op\": should be -objects, -visible or -image"
586	}
587	}
588	}
589
590	#
591	# scale --
592	#
593	# This gets called either incrementally as new simulations are
594	# added or all at once as a sequence of images.
595	# This accounts for all objects--even those not showing on the
596	# screen. Because of this, the limits are appropriate for all
597	# objects as the user scans through data in the ResultSet viewer.
598	#
599	itcl::body Rappture::VtkImageViewer::scale {args} {
600	foreach dataobj $args {
601	if { ![$dataobj isvalid] } {
602	continue; # Object doesn't contain valid data.
603	}
604	foreach axis { x y } {
605	set units [$dataobj hints ${axis}units]
606	set found($units) 1
607	set lim [$dataobj limits $axis]
608	if { ![info exists _limits($axis)] } {
609	set _limits($axis) $lim
610	continue
611	}
612	foreach {min max} $lim break
613	foreach {amin amax} $_limits($axis) break
614	if { $amin > $min } {
615	set amin $min
616	}
617	if { $amax < $max } {
618	set amax $max
619	}
620	set _limits($axis) [list $amin $amax]
621	}
622	foreach { fname lim } [$dataobj fieldlimits] {
623	if { ![info exists _limits($fname)] } {
624	set _limits($fname) $lim
625	continue
626	}
627	foreach {min max} $lim break
628	foreach {fmin fmax} $_limits($fname) break
629	if { $fmin > $min } {
630	set fmin $min
631	}
632	if { $fmax < $max } {
633	set fmax $max
634	}
635	set _limits($fname) [list $fmin $fmax]
636	}
637	}
638	if { [array size found] > 1 } {
639	set _settings(-stretchtofit) 1
640	} else {
641	# Check if the range of the x and y axes requires that we stretch
642	# the contour to fit the plotting area. This can happen when the
643	# x and y scales differ greatly (> 100x)
644	foreach {xmin xmax} $_limits(x) break
645	foreach {ymin ymax} $_limits(y) break
646	if { (($xmax - $xmin) > (($ymax -$ymin) * $_maxScale)) \|\|
647	((($xmax - $xmin) * $_maxScale) < ($ymax -$ymin)) } {
648	set _settings(-stretchtofit) 1
649	}
650	}
651	}
652
653	# ----------------------------------------------------------------------
654	# USAGE: download coming
655	# USAGE: download controls <downloadCommand>
656	# USAGE: download now
657	#
658	# Clients use this method to create a downloadable representation
659	# of the plot. Returns a list of the form {ext string}, where
660	# "ext" is the file extension (indicating the type of data) and
661	# "string" is the data itself.
662	# ----------------------------------------------------------------------
663	itcl::body Rappture::VtkImageViewer::download {option args} {
664	switch $option {
665	coming {
666	if {[catch {
667	blt::winop snap $itk_component(plotarea) $_image(download)
668	}]} {
669	$_image(download) configure -width 1 -height 1
670	$_image(download) put #000000
671	}
672	}
673	controls {
674	set popup .vtkviewerdownload
675	if { ![winfo exists .vtkviewerdownload] } {
676	set inner [BuildDownloadPopup $popup [lindex $args 0]]
677	} else {
678	set inner [$popup component inner]
679	}
680	set _downloadPopup(image_controls) $inner.image_frame
681	set num [llength [get]]
682	set num [expr {($num == 1) ? "1 result" : "$num results"}]
683	set word [Rappture::filexfer::label downloadWord]
684	$inner.summary configure -text "$word $num in the following format:"
685	update idletasks ;# Fix initial sizes
686	return $popup
687	}
688	now {
689	set popup .vtkviewerdownload
690	if {[winfo exists .vtkviewerdownload]} {
691	$popup deactivate
692	}
693	switch -- $_downloadPopup(format) {
694	"image" {
695	return [$this GetImage [lindex $args 0]]
696	}
697	"vtk" {
698	return [$this GetVtkData [lindex $args 0]]
699	}
700	}
701	return ""
702	}
703	default {
704	error "bad option \"$option\": should be coming, controls, now"
705	}
706	}
707	}
708
709	# ----------------------------------------------------------------------
710	# USAGE: Connect ?<host:port>,<host:port>...?
711	#
712	# Clients use this method to establish a connection to a new
713	# server, or to reestablish a connection to the previous server.
714	# Any existing connection is automatically closed.
715	# ----------------------------------------------------------------------
716	itcl::body Rappture::VtkImageViewer::Connect {} {
717	global readyForNextFrame
718	set readyForNextFrame 1
719	set _hosts [GetServerList "vtkvis"]
720	if { "" == $_hosts } {
721	return 0
722	}
723	set _reset 1
724	set result [VisViewer::Connect $_hosts]
725	if { $result } {
726	if { $_reportClientInfo } {
727	# Tell the server the viewer, hub, user and session.
728	# Do this immediately on connect before buffering any commands
729	global env
730
731	set info {}
732	set user "???"
733	if { [info exists env(USER)] } {
734	set user $env(USER)
735	}
736	set session "???"
737	if { [info exists env(SESSION)] } {
738	set session $env(SESSION)
739	}
740	lappend info "version" "$Rappture::version"
741	lappend info "build" "$Rappture::build"
742	lappend info "svnurl" "$Rappture::svnurl"
743	lappend info "installdir" "$Rappture::installdir"
744	lappend info "hub" [exec hostname]
745	lappend info "client" "vtkimageviewer"
746	lappend info "user" $user
747	lappend info "session" $session
748	SendCmd "clientinfo [list $info]"
749	}
750	set w [winfo width $itk_component(view)]
751	set h [winfo height $itk_component(view)]
752	EventuallyResize $w $h
753	}
754	return $result
755	}
756
757	#
758	# isconnected --
759	#
760	# Indicates if we are currently connected to the visualization server.
761	#
762	itcl::body Rappture::VtkImageViewer::isconnected {} {
763	return [VisViewer::IsConnected]
764	}
765
766	#
767	# disconnect --
768	#
769	itcl::body Rappture::VtkImageViewer::disconnect {} {
770	Disconnect
771	set _reset 1
772	}
773
774	#
775	# Disconnect --
776	#
777	# Clients use this method to disconnect from the current rendering server.
778	#
779	itcl::body Rappture::VtkImageViewer::Disconnect {} {
780	VisViewer::Disconnect
781
782	$_dispatcher cancel !rebuild
783	$_dispatcher cancel !resize
784	$_dispatcher cancel !rotate
785	$_dispatcher cancel !legend
786	# disconnected -- no more data sitting on server
787	array unset _datasets
788	array unset _colormaps
789	global readyForNextFrame
790	set readyForNextFrame 1
791	}
792
793	# ----------------------------------------------------------------------
794	# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
795	#
796	# Invoked automatically whenever the "image" command comes in from
797	# the rendering server. Indicates that binary image data with the
798	# specified <size> will follow.
799	# ----------------------------------------------------------------------
800	itcl::body Rappture::VtkImageViewer::ReceiveImage { args } {
801	global readyForNextFrame
802	set readyForNextFrame 1
803	array set info {
804	-token "???"
805	-bytes 0
806	-type image
807	}
808	array set info $args
809	set bytes [ReceiveBytes $info(-bytes)]
810	if { $info(-type) == "image" } {
811	if 0 {
812	set f [open "last.ppm" "w"]
813	fconfigure $f -encoding binary
814	puts -nonewline $f $bytes
815	close $f
816	}
817	$_image(plot) configure -data $bytes
818	set time [clock seconds]
819	set date [clock format $time]
820	#puts stderr "$date: received image [image width $_image(plot)]x[image height $_image(plot)] image>"
821	if { $_start > 0 } {
822	set finish [clock clicks -milliseconds]
823	#puts stderr "round trip time [expr $finish -$_start] milliseconds"
824	set _start 0
825	}
826	} elseif { $info(type) == "print" } {
827	set tag $this-print-$info(-token)
828	set _hardcopy($tag) $bytes
829	}
830	}
831
832	#
833	# ReceiveDataset --
834	#
835	itcl::body Rappture::VtkImageViewer::ReceiveDataset { args } {
836	if { ![isconnected] } {
837	return
838	}
839	set option [lindex $args 0]
840	switch -- $option {
841	"scalar" {
842	set option [lindex $args 1]
843	switch -- $option {
844	"world" {
845	foreach { x y z value tag } [lrange $args 2 end] break
846	}
847	"pixel" {
848	foreach { x y value tag } [lrange $args 2 end] break
849	}
850	}
851	}
852	"vector" {
853	set option [lindex $args 1]
854	switch -- $option {
855	"world" {
856	foreach { x y z vx vy vz tag } [lrange $args 2 end] break
857	}
858	"pixel" {
859	foreach { x y vx vy vz tag } [lrange $args 2 end] break
860	}
861	}
862	}
863	"names" {
864	foreach { name } [lindex $args 1] {
865	#puts stderr "Dataset: $name"
866	}
867	}
868	default {
869	error "unknown dataset option \"$option\" from server"
870	}
871	}
872	}
873
874	# ----------------------------------------------------------------------
875	# USAGE: Rebuild
876	#
877	# Called automatically whenever something changes that affects the
878	# data in the widget. Clears any existing data and rebuilds the
879	# widget to display new data.
880	# ----------------------------------------------------------------------
881	itcl::body Rappture::VtkImageViewer::Rebuild {} {
882	set w [winfo width $itk_component(view)]
883	set h [winfo height $itk_component(view)]
884	if { $w < 2 \|\| $h < 2 } {
885	update
886	$_dispatcher event -idle !rebuild
887	return
888	}
889
890	# Turn on buffering of commands to the server. We don't want to
891	# be preempted by a server disconnect/reconnect (which automatically
892	# generates a new call to Rebuild).
893	StartBufferingCommands
894
895	if { $_width != $w \|\| $_height != $h \|\| $_reset } {
896	set _width $w
897	set _height $h
898	$_arcball resize $w $h
899	DoResize
900	if { $_settings(-stretchtofit) } {
901	AdjustSetting -stretchtofit
902	}
903	}
904	if { $_reset } {
905	#
906	# Reset the camera and other view parameters
907	#
908	InitSettings -view3d -background \
909	-xgrid -ygrid -zgrid -axismode \
910	-axesvisible -axislabels -axisminorticks
911
912	SendCmd "axis tickpos outside"
913	SendCmd "axis lrot z 90"
914	$_arcball quaternion [ViewToQuaternion]
915	if {$_settings(-view3d) } {
916	if { $_view(-ortho)} {
917	SendCmd "camera mode ortho"
918	} else {
919	SendCmd "camera mode persp"
920	}
921	DoRotate
922	SendCmd "camera reset"
923	}
924	PanCamera
925	StopBufferingCommands
926	SendCmd "imgflush"
927	StartBufferingCommands
928	}
929
930	set _first ""
931	# Start off with no datasets visible.
932	SendCmd "dataset visible 0"
933	foreach dataobj [get -objects] {
934	if { [info exists _obj2ovride($dataobj-raise)] && $_first == "" } {
935	set _first $dataobj
936	SetCurrentFieldName $dataobj
937	}
938	foreach comp [$dataobj components] {
939	set tag $dataobj-$comp
940	if { ![info exists _datasets($tag)] } {
941	set bytes [$dataobj vtkdata $comp]
942	if 0 {
943	set f [open /tmp/vtkimage.vtk "w"]
944	fconfigure $f -translation binary -encoding binary
945	puts -nonewline $f $bytes
946	close $f
947	}
948	set length [string length $bytes]
949	if { $_reportClientInfo } {
950	set info {}
951	lappend info "tool_id" [$dataobj hints toolid]
952	lappend info "tool_name" [$dataobj hints toolname]
953	lappend info "tool_title" [$dataobj hints tooltitle]
954	lappend info "tool_command" [$dataobj hints toolcommand]
955	lappend info "tool_revision" [$dataobj hints toolrevision]
956	lappend info "dataset_label" [$dataobj hints label]
957	lappend info "dataset_size" $length
958	lappend info "dataset_tag" $tag
959	SendCmd "clientinfo [list $info]"
960	}
961	SendCmd "dataset add $tag data follows $length"
962	SendData $bytes
963	set _datasets($tag) 1
964	SetObjectStyle $dataobj $comp
965	}
966	if { [info exists _obj2ovride($dataobj-raise)] } {
967	# Setting dataset visible enables outline
968	# and image
969	SendCmd "dataset visible 1 $tag"
970	}
971	}
972	}
973
974	InitSettings -stretchtofit -outline
975	if { $_reset } {
976	foreach axis { x y z } {
977	set label ""
978	if { $_first != "" } {
979	set label [$_first hints ${axis}label]
980	}
981	if { $label == "" } {
982	set label [string toupper $axis]
983	}
984	# May be a space in the axis label.
985	SendCmd [list axis name $axis $label]
986
987	set units ""
988	if { $_first != "" } {
989	if {$axis == "z" && [$_first hints ${axis}units] == ""} {
990	if {$_curFldName != ""} {
991	set units [lindex $_fields($_curFldName) 1]
992	}
993	} else {
994	set units [$_first hints ${axis}units]
995	}
996	}
997	if { $units != "" } {
998	# May be a space in the axis units.
999	SendCmd [list axis units $axis $units]
1000	}
1001	}
1002	#
1003	# Reset the camera and other view parameters
1004	#
1005	$_arcball quaternion [ViewToQuaternion]
1006	if {$_settings(-view3d) } {
1007	if { $_view(-ortho)} {
1008	SendCmd "camera mode ortho"
1009	} else {
1010	SendCmd "camera mode persp"
1011	}
1012	DoRotate
1013	SendCmd "camera reset"
1014	}
1015	PanCamera
1016	InitSettings -field -view3d
1017	if { [array size _fields] < 2 } {
1018	catch {blt::table forget $itk_component(field) $itk_component(field_l)}
1019	}
1020	RequestLegend
1021	set _reset 0
1022	}
1023	global readyForNextFrame
1024	set readyForNextFrame 0; # Don't advance to the next frame
1025
1026	# Actually write the commands to the server socket. If it fails, we don't
1027	# care. We're finished here.
1028	blt::busy hold $itk_component(hull)
1029	StopBufferingCommands
1030	blt::busy release $itk_component(hull)
1031	}
1032
1033	# ----------------------------------------------------------------------
1034	# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1035	#
1036	# Returns a list of server IDs for the current datasets being displayed. This
1037	# is normally a single ID, but it might be a list of IDs if the current data
1038	# object has multiple components.
1039	# ----------------------------------------------------------------------
1040	itcl::body Rappture::VtkImageViewer::CurrentDatasets {args} {
1041	set flag [lindex $args 0]
1042	switch -- $flag {
1043	"-all" {
1044	if { [llength $args] > 1 } {
1045	error "CurrentDatasets: can't specify dataobj after \"-all\""
1046	}
1047	set dlist [get -objects]
1048	}
1049	"-visible" {
1050	if { [llength $args] > 1 } {
1051	set dlist {}
1052	set args [lrange $args 1 end]
1053	foreach dataobj $args {
1054	if { [info exists _obj2ovride($dataobj-raise)] } {
1055	lappend dlist $dataobj
1056	}
1057	}
1058	} else {
1059	set dlist [get -visible]
1060	}
1061	}
1062	default {
1063	set dlist $args
1064	}
1065	}
1066	set rlist ""
1067	foreach dataobj $dlist {
1068	foreach comp [$dataobj components] {
1069	set tag $dataobj-$comp
1070	if { [info exists _datasets($tag)] && $_datasets($tag) } {
1071	lappend rlist $tag
1072	}
1073	}
1074	}
1075	return $rlist
1076	}
1077
1078	# ----------------------------------------------------------------------
1079	# USAGE: Zoom in
1080	# USAGE: Zoom out
1081	# USAGE: Zoom reset
1082	#
1083	# Called automatically when the user clicks on one of the zoom
1084	# controls for this widget. Changes the zoom for the current view.
1085	# ----------------------------------------------------------------------
1086	itcl::body Rappture::VtkImageViewer::Zoom {option} {
1087	switch -- $option {
1088	"in" {
1089	set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1090	SendCmd "camera zoom $_view(-zoom)"
1091	}
1092	"out" {
1093	set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1094	SendCmd "camera zoom $_view(-zoom)"
1095	}
1096	"reset" {
1097	array set _view {
1098	-qw 0.36
1099	-qx 0.25
1100	-qy 0.50
1101	-qz 0.70
1102	-xpan 0
1103	-ypan 0
1104	-zoom 1.0
1105	}
1106	if { $_first != "" } {
1107	set location [$_first hints camera]
1108	if { $location != "" } {
1109	array set _view $location
1110	}
1111	}
1112	$_arcball quaternion [ViewToQuaternion]
1113	if {$_settings(-view3d) } {
1114	DoRotate
1115	}
1116	SendCmd "camera reset"
1117	}
1118	}
1119	}
1120
1121	itcl::body Rappture::VtkImageViewer::PanCamera {} {
1122	set x $_view(-xpan)
1123	set y $_view(-ypan)
1124	SendCmd "camera pan $x $y"
1125	}
1126
1127
1128	# ----------------------------------------------------------------------
1129	# USAGE: Rotate click <x> <y>
1130	# USAGE: Rotate drag <x> <y>
1131	# USAGE: Rotate release <x> <y>
1132	#
1133	# Called automatically when the user clicks/drags/releases in the
1134	# plot area. Moves the plot according to the user's actions.
1135	# ----------------------------------------------------------------------
1136	itcl::body Rappture::VtkImageViewer::Rotate {option x y} {
1137	switch -- $option {
1138	"click" {
1139	$itk_component(view) configure -cursor fleur
1140	set _click(x) $x
1141	set _click(y) $y
1142	}
1143	"drag" {
1144	if {[array size _click] == 0} {
1145	Rotate click $x $y
1146	} else {
1147	set w [winfo width $itk_component(view)]
1148	set h [winfo height $itk_component(view)]
1149	if {$w <= 0 \|\| $h <= 0} {
1150	return
1151	}
1152
1153	if {[catch {
1154	# this fails sometimes for no apparent reason
1155	set dx [expr {double($x-$_click(x))/$w}]
1156	set dy [expr {double($y-$_click(y))/$h}]
1157	}]} {
1158	return
1159	}
1160	if { $dx == 0 && $dy == 0 } {
1161	return
1162	}
1163	set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1164	EventuallyRotate $q
1165	set _click(x) $x
1166	set _click(y) $y
1167	}
1168	}
1169	"release" {
1170	Rotate drag $x $y
1171	$itk_component(view) configure -cursor ""
1172	catch {unset _click}
1173	}
1174	default {
1175	error "bad option \"$option\": should be click, drag, release"
1176	}
1177	}
1178	}
1179
1180	itcl::body Rappture::VtkImageViewer::Pick {x y} {
1181	foreach tag [CurrentDatasets -visible] {
1182	SendCmd "dataset getscalar pixel $x $y $tag"
1183	}
1184	}
1185
1186	# ----------------------------------------------------------------------
1187	# USAGE: $this Pan click x y
1188	# $this Pan drag x y
1189	# $this Pan release x y
1190	#
1191	# Called automatically when the user clicks on one of the zoom
1192	# controls for this widget. Changes the zoom for the current view.
1193	# ----------------------------------------------------------------------
1194	itcl::body Rappture::VtkImageViewer::Pan {option x y} {
1195	switch -- $option {
1196	"set" {
1197	set w [winfo width $itk_component(view)]
1198	set h [winfo height $itk_component(view)]
1199	set x [expr $x / double($w)]
1200	set y [expr $y / double($h)]
1201	set _view(-xpan) [expr $_view(-xpan) + $x]
1202	set _view(-ypan) [expr $_view(-ypan) + $y]
1203	PanCamera
1204	return
1205	}
1206	"click" {
1207	set _click(x) $x
1208	set _click(y) $y
1209	$itk_component(view) configure -cursor hand1
1210	}
1211	"drag" {
1212	if { ![info exists _click(x)] } {
1213	set _click(x) $x
1214	}
1215	if { ![info exists _click(y)] } {
1216	set _click(y) $y
1217	}
1218	set w [winfo width $itk_component(view)]
1219	set h [winfo height $itk_component(view)]
1220	set dx [expr ($_click(x) - $x)/double($w)]
1221	set dy [expr ($_click(y) - $y)/double($h)]
1222	set _click(x) $x
1223	set _click(y) $y
1224	set _view(-xpan) [expr $_view(-xpan) - $dx]
1225	set _view(-ypan) [expr $_view(-ypan) - $dy]
1226	PanCamera
1227	}
1228	"release" {
1229	Pan drag $x $y
1230	$itk_component(view) configure -cursor ""
1231	}
1232	default {
1233	error "unknown option \"$option\": should set, click, drag, or release"
1234	}
1235	}
1236	}
1237
1238	# ----------------------------------------------------------------------
1239	# USAGE: InitSettings <what> ?<value>?
1240	#
1241	# Used internally to update rendering settings whenever parameters
1242	# change in the popup settings panel. Sends the new settings off
1243	# to the back end.
1244	# ----------------------------------------------------------------------
1245	itcl::body Rappture::VtkImageViewer::InitSettings { args } {
1246	foreach spec $args {
1247	AdjustSetting $spec
1248	}
1249	}
1250
1251	#
1252	# AdjustSetting --
1253	#
1254	# Changes/updates a specific setting in the widget. There are
1255	# usually user-setable option. Commands are sent to the render
1256	# server.
1257	#
1258	itcl::body Rappture::VtkImageViewer::AdjustSetting {what {value ""}} {
1259	if { ![isconnected] } {
1260	return
1261	}
1262	switch -- $what {
1263	"-axesvisible" {
1264	set bool $_settings($what)
1265	SendCmd "axis visible all $bool"
1266	}
1267	"-axislabels" {
1268	set bool $_settings($what)
1269	SendCmd "axis labels all $bool"
1270	}
1271	"-axisminorticks" {
1272	set bool $_settings($what)
1273	SendCmd "axis minticks all $bool"
1274	}
1275	"-axismode" {
1276	set mode [$itk_component(axismode) value]
1277	set mode [$itk_component(axismode) translate $mode]
1278	set _settings($what) $mode
1279	SendCmd "axis flymode $mode"
1280	}
1281	"-background" {
1282	set bg [$itk_component(background) value]
1283	array set fgcolors {
1284	"black" "white"
1285	"white" "black"
1286	"grey" "black"
1287	}
1288	set fg $fgcolors($bg)
1289	configure -plotbackground $bg -plotforeground $fg
1290	$itk_component(view) delete "legend"
1291	SendCmd "screen bgcolor [Color2RGB $bg]"
1292	SendCmd "outline color [Color2RGB $fg]"
1293	SendCmd "axis color all [Color2RGB $fg]"
1294	DrawLegend
1295	}
1296	"-backingcolor" {
1297	set color [$itk_component(backingcolor) value]
1298	if { $color == "none" } {
1299	if { $_settings(-backingvisible) } {
1300	SendCmd "image backing 0"
1301	set _settings(-backingvisible) 0
1302	}
1303	} else {
1304	if { !$_settings(-backingvisible) } {
1305	SendCmd "image backing 1"
1306	set _settings(-backingvisible) 1
1307	}
1308	SendCmd "image color [Color2RGB $color]"
1309	}
1310	}
1311	"-backingvisible" {
1312	set bool $_settings($what)
1313	SendCmd "image backing $bool"
1314	}
1315	"-colormap" {
1316	set _changed($what) 1
1317	StartBufferingCommands
1318	set color [$itk_component(colormap) value]
1319	set _settings($what) $color
1320	SetCurrentColormap $color
1321	if {$_settings(-colormapdiscrete)} {
1322	SendCmd "colormap res $_settings(-numcolors) $color"
1323	}
1324	StopBufferingCommands
1325	EventuallyRequestLegend
1326	}
1327	"-colormapdiscrete" {
1328	set bool $_settings($what)
1329	StartBufferingCommands
1330	if {$bool} {
1331	SendCmd "colormap res $_settings(-numcolors)"
1332	} else {
1333	SendCmd "colormap res default"
1334	}
1335	StopBufferingCommands
1336	EventuallyRequestLegend
1337	}
1338	"-field" {
1339	set label [$itk_component(field) value]
1340	set fname [$itk_component(field) translate $label]
1341	set _settings($what) $fname
1342	if { [info exists _fields($fname)] } {
1343	foreach { label units components } $_fields($fname) break
1344	if { $components > 1 } {
1345	set _colorMode vmag
1346	} else {
1347	set _colorMode scalar
1348	}
1349	set _curFldName $fname
1350	set _curFldLabel $label
1351	} else {
1352	puts stderr "unknown field \"$fname\""
1353	return
1354	}
1355
1356	# Get the new limits because the field changed.
1357	SendCmd [list dataset scalar $_curFldName]
1358	#SendCmd [list image colormode scalar $_curFldName]
1359	SendCmd "camera reset"
1360	DrawLegend
1361	}
1362	"-legendvisible" {
1363	if { !$_settings($what) } {
1364	$itk_component(view) delete legend
1365	}
1366	DrawLegend
1367	}
1368	"-level" {
1369	set val $_settings($what)
1370	SendCmd "image level $val"
1371	}
1372	"-opacity" {
1373	set _changed($what) 1
1374	if { $_settings(-view3d) } {
1375	set _settings(-saveopacity) $_settings($what)
1376	set val [expr $_settings($what) * 0.01]
1377	SendCmd "image opacity $val"
1378	} else {
1379	SendCmd "image opacity 1.0"
1380	}
1381	}
1382	"-outline" {
1383	set bool $_settings($what)
1384	SendCmd "outline visible $bool"
1385	}
1386	"-stretchtofit" {
1387	set bool $_settings($what)
1388	if { $bool } {
1389	if { $_settings(-view3d) } {
1390	SendCmd "camera aspect native"
1391	} else {
1392	SendCmd "camera aspect window"
1393	}
1394	} else {
1395	SendCmd "camera aspect native"
1396	}
1397	}
1398	"-view3d" {
1399	set bool $_settings($what)
1400	set c $itk_component(view)
1401	StartBufferingCommands
1402	# Fix image scale: 0 for contours, 1 for images.
1403	if { $bool } {
1404	set _settings(-opacity) $_settings(-saveopacity)
1405	} else {
1406	set _settings(-opacity) 100
1407	}
1408	AdjustSetting -opacity
1409	if { $bool } {
1410	$itk_component(opacity) configure -state normal
1411	$itk_component(opacity_l) configure -state normal
1412	if {$_view(-ortho)} {
1413	SendCmd "camera mode ortho"
1414	} else {
1415	SendCmd "camera mode persp"
1416	}
1417	SendCmd "camera aspect native"
1418	} else {
1419	$itk_component(opacity) configure -state disabled
1420	$itk_component(opacity_l) configure -state disabled
1421	SendCmd "camera mode image"
1422	if {$_settings(-stretchtofit)} {
1423	SendCmd "camera aspect window"
1424	}
1425	}
1426	if { $bool } {
1427	set q [ViewToQuaternion]
1428	$_arcball quaternion $q
1429	SendCmd "camera orient $q"
1430	} else {
1431	bind $c <ButtonPress-1> {}
1432	bind $c <B1-Motion> {}
1433	bind $c <ButtonRelease-1> {}
1434	}
1435	SendCmd "camera reset"
1436	# Fix the mouse bindings for rotation/panning and the
1437	# camera mode. Ideally we'd create a bindtag for these.
1438	if { $bool } {
1439	# Bindings for rotation via mouse
1440	bind $c <ButtonPress-1> \
1441	[itcl::code $this Rotate click %x %y]
1442	bind $c <B1-Motion> \
1443	[itcl::code $this Rotate drag %x %y]
1444	bind $c <ButtonRelease-1> \
1445	[itcl::code $this Rotate release %x %y]
1446	}
1447	StopBufferingCommands
1448	}
1449	"-window" {
1450	set val $_settings($what)
1451	SendCmd "image window $val"
1452	}
1453	"-xgrid" - "-ygrid" - "-zgrid" {
1454	set axis [string tolower [string range $what 1 1]]
1455	set bool $_settings($what)
1456	SendCmd "axis grid $axis $bool"
1457	}
1458	default {
1459	error "don't know how to fix $what"
1460	}
1461	}
1462	}
1463
1464	#
1465	# RequestLegend --
1466	#
1467	# Request a new legend from the server. The size of the legend
1468	# is determined from the height of the canvas.
1469	#
1470	# This should be called when
1471	# 1. A new current colormap is set.
1472	# 2. Window is resized.
1473	# 3. The limits of the data have changed. (Just need a redraw).
1474	# 4. Number of isolines have changed. (Just need a redraw).
1475	# 5. Legend becomes visible (Just need a redraw).
1476	#
1477	itcl::body Rappture::VtkImageViewer::RequestLegend {} {
1478	set _legendPending 0
1479	set font "Arial 8"
1480	set w 12
1481	set lineht [font metrics $font -linespace]
1482	# color ramp height = (canvas height) - (min and max value lines) - 2
1483	set h [expr {$_height - 2 * ($lineht + 2)}]
1484	set _legendHeight $h
1485
1486	set fname $_curFldName
1487	if { [string match "component*" $fname] } {
1488	set title ""
1489	} else {
1490	if { [info exists _fields($fname)] } {
1491	foreach { title units } $_fields($fname) break
1492	if { $units != "" } {
1493	set title [format "%s (%s)" $title $units]
1494	}
1495	} else {
1496	set title $fname
1497	}
1498	}
1499	# If there's a title too, subtract one more line
1500	if { $title != "" } {
1501	incr h -$lineht
1502	}
1503	if { $h < 1 } {
1504	return
1505	}
1506	# Set the legend on the first dataset.
1507	if { $_currentColormap != "" && $_currentColormap != "none" } {
1508	set cmap $_currentColormap
1509	if { ![info exists _colormaps($cmap)] } {
1510	BuildColormap $cmap
1511	set _colormaps($cmap) 1
1512	}
1513	#SendCmd [list legend $cmap scalar $_curFldName {} $w $h 0]
1514	SendCmd "legend2 $cmap $w $h"
1515	}
1516	}
1517
1518	#
1519	# SetCurrentColormap --
1520	#
1521	itcl::body Rappture::VtkImageViewer::SetCurrentColormap { name } {
1522	# Keep track of the colormaps that we build.
1523	if { $name != "none" && ![info exists _colormaps($name)] } {
1524	BuildColormap $name
1525	set _colormaps($name) 1
1526	}
1527	set _currentColormap $name
1528	SendCmd "image colormap $_currentColormap"
1529	}
1530
1531
1532	#
1533	# BuildColormap --
1534	#
1535	# Build the designated colormap on the server.
1536	#
1537	itcl::body Rappture::VtkImageViewer::BuildColormap { name } {
1538	set cmap [ColorsToColormap $name]
1539	if { [llength $cmap] == 0 } {
1540	set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1541	}
1542	set amap "0.0 1.0 1.0 1.0"
1543	SendCmd "colormap add $name { $cmap } { $amap }"
1544	}
1545
1546	# ----------------------------------------------------------------------
1547	# CONFIGURATION OPTION: -mode
1548	# ----------------------------------------------------------------------
1549	itcl::configbody Rappture::VtkImageViewer::mode {
1550	switch -- $itk_option(-mode) {
1551	"volume" {
1552	set _settings(-view3d) 1
1553	}
1554	"vtkimage" {
1555	set _settings(-view3d) 0
1556	}
1557	default {
1558	error "unknown mode settings \"$itk_option(-mode)\""
1559	}
1560	}
1561	if { !$_reset } {
1562	AdjustSetting -view3d
1563	}
1564	}
1565
1566	# ----------------------------------------------------------------------
1567	# CONFIGURATION OPTION: -plotbackground
1568	# ----------------------------------------------------------------------
1569	itcl::configbody Rappture::VtkImageViewer::plotbackground {
1570	if { [isconnected] } {
1571	set rgb [Color2RGB $itk_option(-plotbackground)]
1572	if { !$_reset } {
1573	SendCmd "screen bgcolor $rgb"
1574	}
1575	$itk_component(view) configure -background $itk_option(-plotbackground)
1576	}
1577	}
1578
1579	# ----------------------------------------------------------------------
1580	# CONFIGURATION OPTION: -plotforeground
1581	# ----------------------------------------------------------------------
1582	itcl::configbody Rappture::VtkImageViewer::plotforeground {
1583	if { [isconnected] } {
1584	set rgb [Color2RGB $itk_option(-plotforeground)]
1585	if { !$_reset } {
1586	SendCmd "axis color all $rgb"
1587	SendCmd "outline color $rgb"
1588	}
1589	}
1590	}
1591
1592	itcl::body Rappture::VtkImageViewer::BuildImageTab {} {
1593
1594	set fg [option get $itk_component(hull) font Font]
1595	#set bfg [option get $itk_component(hull) boldFont Font]
1596
1597	set inner [$itk_component(main) insert end \
1598	-title "Image Settings" \
1599	-icon [Rappture::icon contour2]]
1600	$inner configure -borderwidth 4
1601
1602	checkbutton $inner.legend \
1603	-text "Legend" \
1604	-variable [itcl::scope _settings(-legendvisible)] \
1605	-command [itcl::code $this AdjustSetting -legendvisible] \
1606	-font "Arial 9"
1607
1608	checkbutton $inner.outline \
1609	-text "Outline" \
1610	-variable [itcl::scope _settings(-outline)] \
1611	-command [itcl::code $this AdjustSetting -outline] \
1612	-font "Arial 9"
1613
1614	checkbutton $inner.backing \
1615	-text "Backing" \
1616	-variable [itcl::scope _settings(-backingvisible)] \
1617	-command [itcl::code $this AdjustSetting -backingvisible] \
1618	-font "Arial 9"
1619
1620	checkbutton $inner.stretch \
1621	-text "Stretch to fit" \
1622	-variable [itcl::scope _settings(-stretchtofit)] \
1623	-command [itcl::code $this AdjustSetting -stretchtofit] \
1624	-font "Arial 9"
1625
1626	checkbutton $inner.colormapDiscrete \
1627	-text "Discrete Colormap" \
1628	-variable [itcl::scope _settings(-colormapdiscrete)] \
1629	-command [itcl::code $this AdjustSetting -colormapdiscrete] \
1630	-font "Arial 9"
1631
1632	itk_component add field_l {
1633	label $inner.field_l -text "Field" -font "Arial 9"
1634	} {
1635	ignore -font
1636	}
1637	itk_component add field {
1638	Rappture::Combobox $inner.field -width 10 -editable 0
1639	}
1640	bind $inner.field <<Value>> \
1641	[itcl::code $this AdjustSetting -field]
1642
1643	label $inner.colormap_l -text "Colormap" -font "Arial 9"
1644	itk_component add colormap {
1645	Rappture::Combobox $inner.colormap -width 10 -editable 0
1646	}
1647	$inner.colormap choices insert end [GetColormapList -includeNone]
1648
1649	$itk_component(colormap) value "BCGYR"
1650	bind $inner.colormap <<Value>> \
1651	[itcl::code $this AdjustSetting -colormap]
1652
1653	label $inner.backingcolor_l -text "Backing Color" -font "Arial 9"
1654	itk_component add backingcolor {
1655	Rappture::Combobox $inner.backingcolor -width 10 -editable 0
1656	}
1657	$inner.backingcolor choices insert end \
1658	"black" "black" \
1659	"blue" "blue" \
1660	"cyan" "cyan" \
1661	"green" "green" \
1662	"grey" "grey" \
1663	"magenta" "magenta" \
1664	"orange" "orange" \
1665	"red" "red" \
1666	"white" "white" \
1667	"none" "none"
1668
1669	$itk_component(backingcolor) value $_settings(-backingcolor)
1670	bind $inner.backingcolor <<Value>> \
1671	[itcl::code $this AdjustSetting -backingcolor]
1672
1673	label $inner.background_l -text "Background Color" -font "Arial 9"
1674	itk_component add background {
1675	Rappture::Combobox $inner.background -width 10 -editable 0
1676	}
1677	$inner.background choices insert end \
1678	"black" "black" \
1679	"white" "white" \
1680	"grey" "grey"
1681
1682	$itk_component(background) value "white"
1683	bind $inner.background <<Value>> \
1684	[itcl::code $this AdjustSetting -background]
1685
1686	itk_component add opacity_l {
1687	label $inner.opacity_l -text "Opacity" -font "Arial 9"
1688	} {
1689	ignore -font
1690	}
1691	itk_component add opacity {
1692	::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1693	-variable [itcl::scope _settings(-opacity)] \
1694	-showvalue off \
1695	-command [itcl::code $this AdjustSetting -opacity]
1696	}
1697
1698	itk_component add window_l {
1699	label $inner.window_l -text "Window" -font "Arial 9"
1700	} {
1701	ignore -font
1702	}
1703	itk_component add window {
1704	::scale $inner.window -from 0 -to 255 -orient horizontal \
1705	-variable [itcl::scope _settings(-window)] \
1706	-showvalue off \
1707	-command [itcl::code $this AdjustSetting -window]
1708	}
1709	itk_component add level_l {
1710	label $inner.level_l -text "Level" -font "Arial 9"
1711	} {
1712	ignore -font
1713	}
1714	itk_component add level {
1715	::scale $inner.level -from 0 -to 255 -orient horizontal \
1716	-variable [itcl::scope _settings(-level)] \
1717	-showvalue off \
1718	-command [itcl::code $this AdjustSetting -level]
1719	}
1720
1721	frame $inner.separator1 -height 2 -relief sunken -bd 1
1722	frame $inner.separator2 -height 2 -relief sunken -bd 1
1723
1724	blt::table $inner \
1725	0,0 $inner.field_l -anchor w -pady 2 \
1726	0,1 $inner.field -anchor w -pady 2 -fill x \
1727	1,0 $inner.colormap_l -anchor w -pady 2 \
1728	1,1 $inner.colormap -anchor w -pady 2 -fill x \
1729	2,0 $inner.backingcolor_l -anchor w -pady 2 \
1730	2,1 $inner.backingcolor -anchor w -pady 2 -fill x \
1731	3,0 $inner.background_l -anchor w -pady 2 \
1732	3,1 $inner.background -anchor w -pady 2 -fill x \
1733	4,0 $inner.backing -anchor w -pady 2 -cspan 2 \
1734	5,0 $inner.stretch -anchor w -pady 2 -cspan 2 \
1735	7,0 $inner.legend -anchor w -pady 2 -cspan 2 \
1736	8,0 $inner.colormapDiscrete -anchor w -pady 2 -cspan 2 \
1737	11,0 $inner.separator1 -padx 2 -fill x -cspan 2 \
1738	12,0 $inner.outline -anchor w -pady 2 -cspan 2 \
1739	13,0 $inner.separator2 -padx 2 -fill x -cspan 2 \
1740	15,0 $inner.opacity_l -anchor w -pady 2 \
1741	15,1 $inner.opacity -fill x -pady 2 \
1742	16,0 $inner.window_l -anchor w -pady 2 \
1743	16,1 $inner.window -fill x -pady 2 \
1744	17,0 $inner.level_l -anchor w -pady 2 \
1745	17,1 $inner.level -fill x -pady 2
1746
1747	blt::table configure $inner r* c* -resize none
1748	blt::table configure $inner r19 c1 -resize expand
1749	}
1750
1751	itcl::body Rappture::VtkImageViewer::BuildAxisTab {} {
1752
1753	set fg [option get $itk_component(hull) font Font]
1754	#set bfg [option get $itk_component(hull) boldFont Font]
1755
1756	set inner [$itk_component(main) insert end \
1757	-title "Axis Settings" \
1758	-icon [Rappture::icon axis2]]
1759	$inner configure -borderwidth 4
1760
1761	checkbutton $inner.visible \
1762	-text "Axes" \
1763	-variable [itcl::scope _settings(-axesvisible)] \
1764	-command [itcl::code $this AdjustSetting -axesvisible] \
1765	-font "Arial 9"
1766	checkbutton $inner.labels \
1767	-text "Axis Labels" \
1768	-variable [itcl::scope _settings(-axislabels)] \
1769	-command [itcl::code $this AdjustSetting -axislabels] \
1770	-font "Arial 9"
1771	label $inner.grid_l -text "Grid" -font "Arial 9"
1772	checkbutton $inner.xgrid \
1773	-text "X" \
1774	-variable [itcl::scope _settings(-xgrid)] \
1775	-command [itcl::code $this AdjustSetting -xgrid] \
1776	-font "Arial 9"
1777	checkbutton $inner.ygrid \
1778	-text "Y" \
1779	-variable [itcl::scope _settings(-ygrid)] \
1780	-command [itcl::code $this AdjustSetting -ygrid] \
1781	-font "Arial 9"
1782	checkbutton $inner.zgrid \
1783	-text "Z" \
1784	-variable [itcl::scope _settings(-zgrid)] \
1785	-command [itcl::code $this AdjustSetting -zgrid] \
1786	-font "Arial 9"
1787	checkbutton $inner.minorticks \
1788	-text "Minor Ticks" \
1789	-variable [itcl::scope _settings(-axisminorticks)] \
1790	-command [itcl::code $this AdjustSetting -axisminorticks] \
1791	-font "Arial 9"
1792
1793	label $inner.mode_l -text "Mode" -font "Arial 9"
1794
1795	itk_component add axismode {
1796	Rappture::Combobox $inner.mode -width 10 -editable 0
1797	}
1798	$inner.mode choices insert end \
1799	"static_triad" "static" \
1800	"closest_triad" "closest" \
1801	"furthest_triad" "farthest" \
1802	"outer_edges" "outer"
1803	$itk_component(axismode) value $_settings(-axismode)
1804	bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode]
1805
1806	blt::table $inner \
1807	0,0 $inner.visible -anchor w -cspan 4 \
1808	1,0 $inner.labels -anchor w -cspan 4 \
1809	2,0 $inner.minorticks -anchor w -cspan 4 \
1810	4,0 $inner.grid_l -anchor w \
1811	4,1 $inner.xgrid -anchor w \
1812	4,2 $inner.ygrid -anchor w \
1813	4,3 $inner.zgrid -anchor w \
1814	5,0 $inner.mode_l -anchor w -padx { 2 0 } \
1815	5,1 $inner.mode -fill x -cspan 3
1816
1817	blt::table configure $inner r* c* -resize none
1818	blt::table configure $inner r7 c6 -resize expand
1819	blt::table configure $inner r3 -height 0.125i
1820	}
1821
1822	itcl::body Rappture::VtkImageViewer::BuildCameraTab {} {
1823	set inner [$itk_component(main) insert end \
1824	-title "Camera Settings" \
1825	-icon [Rappture::icon camera]]
1826	$inner configure -borderwidth 4
1827
1828	label $inner.view_l -text "view" -font "Arial 9"
1829	set f [frame $inner.view]
1830	foreach side { front back left right top bottom } {
1831	button $f.$side -image [Rappture::icon view$side] \
1832	-command [itcl::code $this SetOrientation $side]
1833	Rappture::Tooltip::for $f.$side "Change the view to $side"
1834	pack $f.$side -side left
1835	}
1836
1837	blt::table $inner \
1838	0,0 $inner.view_l -anchor e -pady 2 \
1839	0,1 $inner.view -anchor w -pady 2
1840	blt::table configure $inner r0 -resize none
1841
1842	set labels { qx qy qz qw xpan ypan zoom }
1843	set row 1
1844	foreach tag $labels {
1845	label $inner.${tag}label -text $tag -font "Arial 9"
1846	entry $inner.${tag} -font "Arial 9" -bg white \
1847	-textvariable [itcl::scope _view(-$tag)]
1848	bind $inner.${tag} <Return> \
1849	[itcl::code $this camera set -${tag}]
1850	bind $inner.${tag} <KP_Enter> \
1851	[itcl::code $this camera set -${tag}]
1852	blt::table $inner \
1853	$row,0 $inner.${tag}label -anchor e -pady 2 \
1854	$row,1 $inner.${tag} -anchor w -pady 2
1855	blt::table configure $inner r$row -resize none
1856	incr row
1857	}
1858	checkbutton $inner.ortho \
1859	-text "Orthographic Projection" \
1860	-variable [itcl::scope _view(-ortho)] \
1861	-command [itcl::code $this camera set -ortho] \
1862	-font "Arial 9"
1863	blt::table $inner \
1864	$row,0 $inner.ortho -cspan 2 -anchor w -pady 2
1865	blt::table configure $inner r$row -resize none
1866	incr row
1867
1868	blt::table configure $inner c* -resize none
1869	blt::table configure $inner c2 -resize expand
1870	blt::table configure $inner r$row -resize expand
1871	}
1872
1873	#
1874	# camera --
1875	#
1876	itcl::body Rappture::VtkImageViewer::camera {option args} {
1877	switch -- $option {
1878	"show" {
1879	puts [array get _view]
1880	}
1881	"set" {
1882	set what [lindex $args 0]
1883	set x $_view($what)
1884	set code [catch { string is double $x } result]
1885	if { $code != 0 \|\| !$result } {
1886	return
1887	}
1888	switch -- $what {
1889	"-ortho" {
1890	if {$_view($what)} {
1891	SendCmd "camera mode ortho"
1892	} else {
1893	SendCmd "camera mode persp"
1894	}
1895	}
1896	"-xpan" - "-ypan" {
1897	PanCamera
1898	}
1899	"-qx" - "-qy" - "-qz" - "-qw" {
1900	set q [ViewToQuaternion]
1901	$_arcball quaternion $q
1902	EventuallyRotate $q
1903	}
1904	"-zoom" {
1905	SendCmd "camera zoom $_view($what)"
1906	}
1907	}
1908	}
1909	}
1910	}
1911
1912	itcl::body Rappture::VtkImageViewer::GetVtkData { args } {
1913	set bytes ""
1914	foreach dataobj [get] {
1915	foreach comp [$dataobj components] {
1916	set tag $dataobj-$comp
1917	set contents [$dataobj vtkdata $comp]
1918	append bytes "$contents\n"
1919	}
1920	}
1921	return [list .vtk $bytes]
1922	}
1923
1924	itcl::body Rappture::VtkImageViewer::GetImage { args } {
1925	if { [image width $_image(download)] > 0 &&
1926	[image height $_image(download)] > 0 } {
1927	set bytes [$_image(download) data -format "jpeg -quality 100"]
1928	set bytes [Rappture::encoding::decode -as b64 $bytes]
1929	return [list .jpg $bytes]
1930	}
1931	return ""
1932	}
1933
1934	itcl::body Rappture::VtkImageViewer::BuildDownloadPopup { popup command } {
1935	Rappture::Balloon $popup \
1936	-title "[Rappture::filexfer::label downloadWord] as..."
1937	set inner [$popup component inner]
1938	label $inner.summary -text "" -anchor w
1939	radiobutton $inner.vtk_button -text "VTK data file" \
1940	-variable [itcl::scope _downloadPopup(format)] \
1941	-font "Arial 9" \
1942	-value vtk
1943	Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
1944	radiobutton $inner.image_button -text "Image File" \
1945	-variable [itcl::scope _downloadPopup(format)] \
1946	-font "Arial 9" \
1947	-value image
1948	Rappture::Tooltip::for $inner.image_button \
1949	"Save as digital image."
1950
1951	button $inner.ok -text "Save" \
1952	-highlightthickness 0 -pady 2 -padx 3 \
1953	-command $command \
1954	-compound left \
1955	-image [Rappture::icon download]
1956
1957	button $inner.cancel -text "Cancel" \
1958	-highlightthickness 0 -pady 2 -padx 3 \
1959	-command [list $popup deactivate] \
1960	-compound left \
1961	-image [Rappture::icon cancel]
1962
1963	blt::table $inner \
1964	0,0 $inner.summary -cspan 2 \
1965	1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
1966	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1967	4,1 $inner.cancel -width .9i -fill y \
1968	4,0 $inner.ok -padx 2 -width .9i -fill y
1969	blt::table configure $inner r3 -height 4
1970	blt::table configure $inner r4 -pady 4
1971	raise $inner.image_button
1972	$inner.vtk_button invoke
1973	return $inner
1974	}
1975
1976	#
1977	# SetObjectStyle --
1978	#
1979	# Set the style of the image/contour object. This gets calls
1980	# for each dataset once as it is loaded. It can overridden by
1981	# the user controls.
1982	#
1983	itcl::body Rappture::VtkImageViewer::SetObjectStyle { dataobj comp } {
1984	# Parse style string.
1985	set tag $dataobj-$comp
1986	array set style {
1987	-color none
1988	-opacity 1.0
1989	}
1990	set stylelist [$dataobj style $comp]
1991	if { $stylelist != "" } {
1992	array set style $stylelist
1993	}
1994	# This is too complicated. We want to set the colormap, number of
1995	# isolines and opacity for the dataset. They can be the default values,
1996	# the style hints loaded with the dataset, or set by user controls. As
1997	# datasets get loaded, they first use the defaults that are overidden
1998	# by the style hints. If the user changes the global controls, then that
1999	# overrides everything else. I don't know what it means when global
2000	# controls are specified as style hints by each dataset. It complicates
2001	# the code to handle aberrant cases.
2002
2003	if { $_changed(-opacity) } {
2004	set style(-opacity) [expr $_settings(-opacity) * 0.01]
2005	}
2006	if { $_changed(-colormap) } {
2007	set style(-color) $_settings(-colormap)
2008	}
2009	if { $_currentColormap == "" } {
2010	$itk_component(colormap) value $style(-color)
2011	}
2012	if { [info exists style(-stretchtofit)] } {
2013	set _settings(-stretchtofit) $style(-stretchtofit)
2014	AdjustSetting -stretchtofit
2015	}
2016	SendCmd "outline add $tag"
2017	SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag"
2018	SendCmd "outline visible $_settings(-outline) $tag"
2019	SendCmd "image add $tag"
2020	SetCurrentColormap $style(-color)
2021	set color [$itk_component(backingcolor) value]
2022	SendCmd "image color [Color2RGB $color] $tag"
2023	SendCmd "image opacity $style(-opacity) $tag"
2024	set _settings(-opacity) [expr $style(-opacity) * 100.0]
2025	}
2026
2027	itcl::body Rappture::VtkImageViewer::IsValidObject { dataobj } {
2028	if {[catch {$dataobj isa Rappture::Field} valid] != 0 \|\| !$valid} {
2029	return 0
2030	}
2031	return 1
2032	}
2033
2034	# ----------------------------------------------------------------------
2035	# USAGE: ReceiveLegend <colormap> <title> <min> <max> <size>
2036	#
2037	# Invoked automatically whenever the "legend" command comes in from
2038	# the rendering server. Indicates that binary image data with the
2039	# specified <size> will follow.
2040	# ----------------------------------------------------------------------
2041	itcl::body Rappture::VtkImageViewer::ReceiveLegend { colormap title min max size } {
2042	#puts stderr "ReceiveLegend colormap=$colormap title=$title range=$min,$max size=$size"
2043	if { [isconnected] } {
2044	set bytes [ReceiveBytes $size]
2045	if { ![info exists _image(legend)] } {
2046	set _image(legend) [image create photo]
2047	}
2048	$_image(legend) configure -data $bytes
2049	#puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2050	if { [catch {DrawLegend} errs] != 0 } {
2051	global errorInfo
2052	puts stderr "errs=$errs errorInfo=$errorInfo"
2053	}
2054	}
2055	}
2056
2057	#
2058	# DrawLegend --
2059	#
2060	# Draws the legend in its own canvas on the right side of the plot area.
2061	#
2062	itcl::body Rappture::VtkImageViewer::DrawLegend {} {
2063	set fname $_curFldName
2064	set c $itk_component(view)
2065	set w [winfo width $c]
2066	set h [winfo height $c]
2067	set font "Arial 8"
2068	set lineht [font metrics $font -linespace]
2069
2070	if { [string match "component*" $fname] } {
2071	set title ""
2072	} else {
2073	if { [info exists _fields($fname)] } {
2074	foreach { title units } $_fields($fname) break
2075	if { $units != "" } {
2076	set title [format "%s (%s)" $title $units]
2077	}
2078	} else {
2079	set title $fname
2080	}
2081	}
2082	set x [expr $w - 2]
2083	if { !$_settings(-legendvisible) } {
2084	$c delete legend
2085	return
2086	}
2087	if { [$c find withtag "legend"] == "" } {
2088	set y 2
2089	# If there's a legend title, create a text item for the title.
2090	$c create text $x $y \
2091	-anchor ne \
2092	-fill $itk_option(-plotforeground) -tags "title legend" \
2093	-font $font
2094	if { $title != "" } {
2095	incr y $lineht
2096	}
2097	$c create text $x $y \
2098	-anchor ne \
2099	-fill $itk_option(-plotforeground) -tags "vmax legend" \
2100	-font $font
2101	incr y $lineht
2102	$c create image $x $y \
2103	-anchor ne \
2104	-image $_image(legend) -tags "colormap legend"
2105	$c create rectangle $x $y 1 1 \
2106	-fill "" -outline "" -tags "sensor legend"
2107	$c create text $x [expr {$h-2}] \
2108	-anchor se \
2109	-fill $itk_option(-plotforeground) -tags "vmin legend" \
2110	-font $font
2111	$c bind sensor <Enter> [itcl::code $this EnterLegend %x %y]
2112	$c bind sensor <Leave> [itcl::code $this LeaveLegend]
2113	$c bind sensor <Motion> [itcl::code $this MotionLegend %x %y]
2114	}
2115
2116	set x2 $x
2117	set iw [image width $_image(legend)]
2118	set ih [image height $_image(legend)]
2119	set x1 [expr $x2 - ($iw*12)/10]
2120
2121	$c bind title <ButtonPress> [itcl::code $this LegendTitleAction post]
2122	$c bind title <Enter> [itcl::code $this LegendTitleAction enter]
2123	$c bind title <Leave> [itcl::code $this LegendTitleAction leave]
2124	# Reset the item coordinates according the current size of the plot.
2125	if { [info exists _limits($_curFldName)] } {
2126	foreach { vmin vmax } $_limits($_curFldName) break
2127	$c itemconfigure vmin -text [format %g $vmin]
2128	$c itemconfigure vmax -text [format %g $vmax]
2129	}
2130	set y 2
2131	# If there's a legend title, move the title to the correct position
2132	if { $title != "" } {
2133	$c itemconfigure title -text $title
2134	$c coords title $x $y
2135	incr y $lineht
2136	}
2137	$c coords vmax $x $y
2138	incr y $lineht
2139	$c coords colormap $x $y
2140	$c coords sensor [expr $x - $iw] $y $x [expr $y + $ih]
2141	$c raise sensor
2142	$c coords vmin $x [expr {$h - 2}]
2143	}
2144
2145	#
2146	# EnterLegend --
2147	#
2148	itcl::body Rappture::VtkImageViewer::EnterLegend { x y } {
2149	SetLegendTip $x $y
2150	}
2151
2152	#
2153	# MotionLegend --
2154	#
2155	itcl::body Rappture::VtkImageViewer::MotionLegend { x y } {
2156	Rappture::Tooltip::tooltip cancel
2157	set c $itk_component(view)
2158	set cw [winfo width $c]
2159	set ch [winfo height $c]
2160	if { $x >= 0 && $x < $cw && $y >= 0 && $y < $ch } {
2161	SetLegendTip $x $y
2162	}
2163	}
2164
2165	#
2166	# LeaveLegend --
2167	#
2168	itcl::body Rappture::VtkImageViewer::LeaveLegend { } {
2169	Rappture::Tooltip::tooltip cancel
2170	.rappturetooltip configure -icon ""
2171	}
2172
2173	#
2174	# SetLegendTip --
2175	#
2176	itcl::body Rappture::VtkImageViewer::SetLegendTip { x y } {
2177	set fname $_curFldName
2178	set c $itk_component(view)
2179	set w [winfo width $c]
2180	set h [winfo height $c]
2181	set font "Arial 8"
2182	set lineht [font metrics $font -linespace]
2183
2184	set ih [image height $_image(legend)]
2185	# Subtract off the offset of the color ramp from the top of the canvas
2186	set iy [expr $y - ($lineht + 2)]
2187
2188	if { [string match "component*" $fname] } {
2189	set title ""
2190	} else {
2191	if { [info exists _fields($fname)] } {
2192	foreach { title units } $_fields($fname) break
2193	if { $units != "" } {
2194	set title [format "%s (%s)" $title $units]
2195	}
2196	} else {
2197	set title $fname
2198	}
2199	}
2200	# If there's a legend title, increase the offset by the line height.
2201	if { $title != "" } {
2202	incr iy -$lineht
2203	}
2204
2205	# Make a swatch of the selected color
2206	if { [catch { $_image(legend) get 10 $iy } pixel] != 0 } {
2207	return
2208	}
2209
2210	if { ![info exists _image(swatch)] } {
2211	set _image(swatch) [image create photo -width 24 -height 24]
2212	}
2213	set color [eval format "\#%02x%02x%02x" $pixel]
2214	$_image(swatch) put black -to 0 0 23 23
2215	$_image(swatch) put $color -to 1 1 22 22
2216
2217	# Compute the value of the point
2218	if { [info exists _limits($fname)] } {
2219	foreach { vmin vmax } $_limits($fname) break
2220	set t [expr 1.0 - (double($iy) / double($ih-1))]
2221	set value [expr $t * ($vmax - $vmin) + $vmin]
2222	} else {
2223	set value 0.0
2224	}
2225	set tipx [expr $x + 15]
2226	set tipy [expr $y - 5]
2227	.rappturetooltip configure -icon $_image(swatch)
2228	if { [info exists _isolines($y)] } {
2229	Rappture::Tooltip::text $c [format "$title %g (isoline)" $_isolines($y)]
2230	} else {
2231	Rappture::Tooltip::text $c [format "$title %g" $value]
2232	}
2233	Rappture::Tooltip::tooltip show $c +$tipx,+$tipy
2234	}
2235
2236	# ----------------------------------------------------------------------
2237	# USAGE: LegendTitleAction post
2238	# USAGE: LegendTitleAction enter
2239	# USAGE: LegendTitleAction leave
2240	# USAGE: LegendTitleAction save
2241	#
2242	# Used internally to handle the dropdown list for the fields menu combobox.
2243	# The post option is invoked when the field title is pressed to launch the
2244	# dropdown. The enter option is invoked when the user mouses over the field
2245	# title. The leave option is invoked when the user moves the mouse away
2246	# from the field title. The save option is invoked whenever there is a
2247	# selection from the list, to alert the visualization server.
2248	# ----------------------------------------------------------------------
2249	itcl::body Rappture::VtkImageViewer::LegendTitleAction {option} {
2250	set c $itk_component(view)
2251	switch -- $option {
2252	post {
2253	foreach { x1 y1 x2 y2 } [$c bbox title] break
2254	set x1 [expr [winfo width $itk_component(view)] - [winfo reqwidth $itk_component(fieldmenu)]]
2255	set x [expr $x1 + [winfo rootx $itk_component(view)]]
2256	set y [expr $y2 + [winfo rooty $itk_component(view)]]
2257	tk_popup $itk_component(fieldmenu) $x $y
2258	}
2259	enter {
2260	$c itemconfigure title -fill red
2261	}
2262	leave {
2263	$c itemconfigure title -fill $itk_option(-plotforeground)
2264	}
2265	save {
2266	$itk_component(field) value $_curFldLabel
2267	AdjustSetting -field
2268	}
2269	default {
2270	error "bad option \"$option\": should be post, enter, leave or save"
2271	}
2272	}
2273	}
2274
2275	itcl::body Rappture::VtkImageViewer::SetOrientation { side } {
2276	array set positions {
2277	front "0.707107 0.707107 0 0"
2278	back "0 0 0.707107 0.707107"
2279	left "0.5 0.5 -0.5 -0.5"
2280	right "0.5 0.5 0.5 0.5"
2281	top "1 0 0 0"
2282	bottom "0 1 0 0"
2283	}
2284	foreach name { -qw -qx -qy -qz } value $positions($side) {
2285	set _view($name) $value
2286	}
2287	set q [ViewToQuaternion]
2288	$_arcball quaternion $q
2289	SendCmd "camera orient $q"
2290	SendCmd "camera reset"
2291	set _view(-xpan) 0
2292	set _view(-ypan) 0
2293	set _view(-zoom) 1.0
2294	}
2295
2296	itcl::body Rappture::VtkImageViewer::SetCurrentFieldName { dataobj } {
2297	set _first $dataobj
2298	$itk_component(field) choices delete 0 end
2299	$itk_component(fieldmenu) delete 0 end
2300	array unset _fields
2301	set _curFldName ""
2302	foreach cname [$_first components] {
2303	foreach fname [$_first fieldnames $cname] {
2304	if { [info exists _fields($fname)] } {
2305	continue
2306	}
2307	foreach { label units components } \
2308	[$_first fieldinfo $fname] break
2309	$itk_component(field) choices insert end "$fname" "$label"
2310	$itk_component(fieldmenu) add radiobutton -label "$label" \
2311	-value $label -variable [itcl::scope _curFldLabel] \
2312	-selectcolor red \
2313	-activebackground $itk_option(-plotbackground) \
2314	-activeforeground $itk_option(-plotforeground) \
2315	-font "Arial 8" \
2316	-command [itcl::code $this LegendTitleAction save]
2317	set _fields($fname) [list $label $units $components]
2318	if { $_curFldName == "" } {
2319	set _curFldName $fname
2320	set _curFldLabel $label
2321	}
2322	}
2323	}
2324	$itk_component(field) value $_curFldLabel
2325	}

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

Context Navigation

source: trunk/gui/scripts/vtkimageviewer.tcl

Download in other formats: