Context Navigation

source: trunk/gui/scripts/molvisviewer.tcl @ 2701

Last change on this file since 2701 was 2701, checked in by gah, 12 years ago

File size: 71.5 KB

Line
1
2	# ----------------------------------------------------------------------
3	# COMPONENT: molvisviewer - view a molecule in 3D
4	#
5	# This widget brings up a 3D representation of a molecule
6	# It connects to the Molvis 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	package require Itk
16	package require BLT
17	package require Img
18
19	option add *MolvisViewer.width 4i widgetDefault
20	option add *MolvisViewer.height 4i widgetDefault
21	option add *MolvisViewer.foreground black widgetDefault
22	option add MolvisViewer.font --helvetica-medium-r-normal--12- widgetDefault
23
24	# must use this name -- plugs into Rappture::resources::load
25	proc MolvisViewer_init_resources {} {
26	Rappture::resources::register \
27	molvis_server Rappture::MolvisViewer::SetServerList
28	}
29
30	set debug 0
31	proc debug { args } {
32	global debug
33	if { $debug } {
34	puts stderr "[info level -1]: $args"
35	}
36	}
37
38	itcl::class Rappture::MolvisViewer {
39	inherit Rappture::VisViewer
40
41	itk_option define -device device Device ""
42
43	private variable _icon 0
44	private variable _getimage 0
45	private variable _mevent; # info used for mouse event operations
46	private variable _rocker; # info used for rock operations
47	private variable _dlist ""; # list of dataobj objects
48	private variable _dataobjs; # data objects on server
49	private variable _dobj2transparency;# maps dataobj => transparency
50	private variable _dobj2raise; # maps dataobj => raise flag 0/1
51
52	private variable _active; # array of active models.
53	private variable _obj2models; # array containing list of models
54	# for each data object.
55	private variable _view
56	private variable _click
57
58	private variable _model
59	private variable _mlist
60	private variable _mrep "ballnstick"
61
62	private variable _imagecache
63	private variable _state
64	private variable _labels "default"
65	private variable _cacheid ""
66	private variable _cacheimage ""
67
68	private common _settings ; # Array of settings for all known
69	# widgets
70	private variable _initialized
71
72	private common _downloadPopup; # Download options from popup
73	private variable _pdbdata; # PDB data from run file sent to pymol
74	private common _hardcopy
75	private variable _nextToken 0
76	private variable _outbuf "";
77	private variable _buffering 0;
78	private variable _resizePending 0;
79	private variable _updatePending 0;
80	private variable _rotatePending 0;
81	private variable _width
82	private variable _height
83	private variable _reset 1; # Restore camera settings
84	private variable _cell 0; # Restore camera settings
85	private variable _flush 1
86
87	constructor { hostlist args } {
88	Rappture::VisViewer::constructor $hostlist
89	} {
90	# defined below
91	}
92	destructor {
93	# defined below
94	}
95	public proc SetServerList { namelist } {
96	Rappture::VisViewer::SetServerList "pymol" $namelist
97	}
98	private method BuildSettingsTab {}
99	private method DoResize {}
100	private method DoRotate {}
101	private method DoUpdate {}
102	private method EventuallyResize { w h }
103	private method EventuallyRotate { a b c }
104	private method EventuallyChangeSettings { args }
105	private method GetImage { widget }
106	private method ReceiveImage { size cacheid frame rock }
107	private method WaitIcon { option widget }
108	private method AddImageControls { frame widget }
109	private method SetWaitVariable { value } {
110	set _getimage $value
111	}
112	private method WaitForResponse {} {
113	tkwait variable [itcl::scope _getimage]
114	return $_getimage
115	}
116	protected method Map {}
117	protected method Pan {option x y}
118	protected method Rebuild { }
119	protected method Rotate {option x y}
120	protected method SendCmd { string }
121	protected method Unmap {}
122	protected method Vmouse {option b m x y}
123	protected method Vmouse2 {option b m x y}
124	protected method Zoom {option {factor 10}}
125
126	public method Connect {}
127	public method Disconnect {}
128	public method ResetView {}
129	public method add {dataobj {options ""}}
130	public method delete {args}
131	public method download {option args}
132	public method get {}
133	public method isconnected {}
134	public method labels {option {model "all"}}
135	public method parameters {title args} {
136	# do nothing
137	}
138
139	private method UpdateState { args }
140
141	public method snap { w h }
142	private method Opacity {option}
143	private method SphereScale {option {models "all"} }
144	private method StickRadius {option {models "all"} }
145	private method OrthoProjection {option}
146	private method Representation { {option ""} }
147	private method CartoonTrace {option {model "all"}}
148	private method ComputeParallelepipedVertices { dataobj }
149	private method Cell {option}
150	private method Rock {option}
151	}
152
153	itk::usual MolvisViewer {
154	keep -background -foreground -cursor -font
155	}
156
157	# ----------------------------------------------------------------------
158	# CONSTRUCTOR
159	# ----------------------------------------------------------------------
160	itcl::body Rappture::MolvisViewer::constructor {hostlist args} {
161	set _serverType "pymol"
162
163	# Register events to the dispatcher. Base class expects !rebuild
164	# event to be registered.
165
166	# Rebuild
167	$_dispatcher register !rebuild
168	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
169
170	# Resize event
171	$_dispatcher register !resize
172	$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
173
174	# Update state event
175	$_dispatcher register !update
176	$_dispatcher dispatch $this !update "[itcl::code $this DoUpdate]; list"
177
178	# Rotate event
179	$_dispatcher register !rotate
180	$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
181
182	# Rocker
183	$_dispatcher register !rocker
184	$_dispatcher dispatch $this !rocker "[itcl::code $this Rock step]; list"
185	# Mouse Event
186	$_dispatcher register !mevent
187	$_dispatcher dispatch $this !mevent "[itcl::code $this _mevent]; list"
188	$_dispatcher register !pngtimeout
189	$_dispatcher register !waiticon
190
191	array set _downloadPopup {
192	format draft
193	}
194
195	# Populate the slave interpreter with commands to handle responses from
196	# the visualization server.
197	$_parser alias image [itcl::code $this ReceiveImage]
198
199	set _rocker(dir) 1
200	set _rocker(client) 0
201	set _rocker(server) 0
202	set _rocker(on) 0
203	set _state(server) 1
204	set _state(client) 1
205	set _hostlist $hostlist
206	set _reset 1
207
208	array set _view {
209	theta 45
210	phi 45
211	psi 0
212	vx 0
213	vy 0
214	vz 0
215	zoom 0
216	mx 0
217	my 0
218	mz 0
219	x 0
220	y 0
221	z 0
222	width 0
223	height 0
224	}
225
226	# Setup default settings for widget.
227	array set _settings [subst {
228	$this-spherescale 0.25
229	$this-stickradius 0.14
230	$this-cartoontrace no
231	$this-model ballnstick
232	$this-modelimg [Rappture::icon ballnstick]
233	$this-opacity 1.0
234	$this-ortho no
235	$this-rock no
236	$this-showlabels no
237	$this-showcell yes
238	$this-showlabels-initialized no
239	}]
240
241	itk_component add 3dview {
242	label $itk_component(plotarea).view -image $_image(plot) \
243	-highlightthickness 0 -borderwidth 0
244	} {
245	usual
246	ignore -highlightthickness -borderwidth -background
247	}
248
249	set f [$itk_component(main) component controls]
250	itk_component add reset {
251	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
252	-highlightthickness 0 \
253	-image [Rappture::icon reset-view] \
254	-command [itcl::code $this ResetView]
255	} {
256	usual
257	ignore -highlightthickness
258	}
259	pack $itk_component(reset) -padx 1 -pady 2
260	Rappture::Tooltip::for $itk_component(reset) \
261	"Reset the view to the default zoom level"
262
263	itk_component add zoomin {
264	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
265	-highlightthickness 0 \
266	-image [Rappture::icon zoom-in] \
267	-command [itcl::code $this Zoom in]
268	} {
269	usual
270	ignore -highlightthickness
271	}
272	pack $itk_component(zoomin) -padx 2 -pady 2
273	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
274
275	itk_component add zoomout {
276	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
277	-highlightthickness 0 \
278	-image [Rappture::icon zoom-out] \
279	-command [itcl::code $this Zoom out]
280	} {
281	usual
282	ignore -highlightthickness
283	}
284	pack $itk_component(zoomout) -padx 2 -pady 2
285	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
286
287	itk_component add labels {
288	Rappture::PushButton $f.labels \
289	-onimage [Rappture::icon molvis-labels-view] \
290	-offimage [Rappture::icon molvis-labels-view] \
291	-command [itcl::code $this labels update] \
292	-variable [itcl::scope _settings($this-showlabels)]
293	}
294	$itk_component(labels) deselect
295	Rappture::Tooltip::for $itk_component(labels) \
296	"Show/hide the labels on atoms"
297	pack $itk_component(labels) -padx 2 -pady {6 2}
298
299	itk_component add rock {
300	Rappture::PushButton $f.rock \
301	-onimage [Rappture::icon molvis-rock-view] \
302	-offimage [Rappture::icon molvis-rock-view] \
303	-command [itcl::code $this Rock toggle] \
304	-variable [itcl::scope _settings($this-rock)]
305	}
306	pack $itk_component(rock) -padx 2 -pady 2
307	Rappture::Tooltip::for $itk_component(rock) "Rock model back and forth"
308
309	itk_component add ortho {
310	label $f.ortho -borderwidth 1 -padx 1 -pady 1 \
311	-relief "raised" -image [Rappture::icon molvis-3dpers]
312	}
313	pack $itk_component(ortho) -padx 2 -pady 2 -ipadx 1 -ipady 1
314	Rappture::Tooltip::for $itk_component(ortho) \
315	"Use orthoscopic projection"
316
317	bind $itk_component(ortho) <ButtonPress> \
318	[itcl::code $this OrthoProjection toggle]
319
320	BuildSettingsTab
321
322	# HACK ALERT. Initially force a requested width of the 3dview label.
323
324	# It's a chicken-and-the-egg problem. The size of the 3dview label is set
325	# from the size of the image retrieved from the server. But the size of
326	# the image is specified by the viewport which is the size of the label.
327	# The fly-in-the-ointment is that it takes a non-trival amount of time to
328	# get the first image back from the server. In the meantime the idletasks
329	# have already kicked in. We end up with a 1x1 viewport and image.
330
331	# So the idea is to force a ridiculously big requested width on the label
332	# (that's why we're using the blt::table to manage the geometry). It has
333	# to be big, because we don't know how big the user may want to stretch
334	# the window. This at least forces the sidebarframe to give the 3dview
335	# the maximum size available, which is perfect for an initially closed
336	# sidebar.
337
338	blt::table $itk_component(plotarea) \
339	0,0 $itk_component(3dview) -fill both -reqwidth 10000
340	#
341	# RENDERING AREA
342	#
343
344	set _image(id) ""
345
346	# set up bindings for rotation
347	if 0 {
348	bind $itk_component(3dview) <ButtonPress-1> \
349	[itcl::code $this Rotate click %x %y]
350	bind $itk_component(3dview) <B1-Motion> \
351	[itcl::code $this Rotate drag %x %y]
352	bind $itk_component(3dview) <ButtonRelease-1> \
353	[itcl::code $this Rotate release %x %y]
354	} else {
355	bind $itk_component(3dview) <ButtonPress-1> \
356	[itcl::code $this Vmouse click %b %s %x %y]
357	bind $itk_component(3dview) <B1-Motion> \
358	[itcl::code $this Vmouse drag 1 %s %x %y]
359	bind $itk_component(3dview) <ButtonRelease-1> \
360	[itcl::code $this Vmouse release %b %s %x %y]
361	}
362
363	bind $itk_component(3dview) <ButtonPress-2> \
364	[itcl::code $this Pan click %x %y]
365	bind $itk_component(3dview) <B2-Motion> \
366	[itcl::code $this Pan drag %x %y]
367	bind $itk_component(3dview) <ButtonRelease-2> \
368	[itcl::code $this Pan release %x %y]
369
370	bind $itk_component(3dview) <KeyPress-Left> \
371	[itcl::code $this Pan set -10 0]
372	bind $itk_component(3dview) <KeyPress-Right> \
373	[itcl::code $this Pan set 10 0]
374	bind $itk_component(3dview) <KeyPress-Up> \
375	[itcl::code $this Pan set 0 -10]
376	bind $itk_component(3dview) <KeyPress-Down> \
377	[itcl::code $this Pan set 0 10]
378	bind $itk_component(3dview) <Shift-KeyPress-Left> \
379	[itcl::code $this Pan set -50 0]
380	bind $itk_component(3dview) <Shift-KeyPress-Right> \
381	[itcl::code $this Pan set 50 0]
382	bind $itk_component(3dview) <Shift-KeyPress-Up> \
383	[itcl::code $this Pan set 0 -50]
384	bind $itk_component(3dview) <Shift-KeyPress-Down> \
385	[itcl::code $this Pan set 0 50]
386	bind $itk_component(3dview) <KeyPress-Prior> \
387	[itcl::code $this Zoom out 2]
388	bind $itk_component(3dview) <KeyPress-Next> \
389	[itcl::code $this Zoom in 2]
390
391	bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
392
393
394	if {[string equal "x11" [tk windowingsystem]]} {
395	bind $itk_component(3dview) <4> [itcl::code $this Zoom out 2]
396	bind $itk_component(3dview) <5> [itcl::code $this Zoom in 2]
397	}
398
399	# set up bindings to bridge mouse events to server
400	#bind $itk_component(3dview) <ButtonPress> \
401	# [itcl::code $this Vmouse2 click %b %s %x %y]
402	#bind $itk_component(3dview) <ButtonRelease> \
403	# [itcl::code $this Vmouse2 release %b %s %x %y]
404	#bind $itk_component(3dview) <B1-Motion> \
405	# [itcl::code $this Vmouse2 drag 1 %s %x %y]
406	#bind $itk_component(3dview) <B2-Motion> \
407	# [itcl::code $this Vmouse2 drag 2 %s %x %y]
408	#bind $itk_component(3dview) <B3-Motion> \
409	# [itcl::code $this Vmouse2 drag 3 %s %x %y]
410	#bind $itk_component(3dview) <Motion> \
411	# [itcl::code $this Vmouse2 move 0 %s %x %y]
412
413	bind $itk_component(3dview) <Configure> \
414	[itcl::code $this EventuallyResize %w %h]
415	bind $itk_component(3dview) <Unmap> \
416	[itcl::code $this Unmap]
417	bind $itk_component(3dview) <Map> \
418	[itcl::code $this Map]
419
420	eval itk_initialize $args
421	Connect
422	}
423
424	# ----------------------------------------------------------------------
425	# DESTRUCTOR
426	# ----------------------------------------------------------------------
427	itcl::body Rappture::MolvisViewer::destructor {} {
428	VisViewer::Disconnect
429
430	image delete $_image(plot)
431	array unset _settings $this-*
432	}
433
434
435	# ----------------------------------------------------------------------
436	# USAGE: add <dataobj> ?<settings>?
437	#
438	# Clients use this to add a data object to the plot. The optional
439	# <settings> are used to configure the plot. Allowed settings are
440	# -color, -brightness, -width, -linestyle, and -raise. Only
441	# -brightness and -raise do anything.
442	# ----------------------------------------------------------------------
443	itcl::body Rappture::MolvisViewer::add { dataobj {options ""}} {
444	array set params {
445	-color auto
446	-brightness 0
447	-width 1
448	-raise 0
449	-linestyle solid
450	-description ""
451	-param ""
452	}
453
454	foreach {opt val} $options {
455	if {![info exists params($opt)]} {
456	error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
457	}
458	set params($opt) $val
459	}
460
461	set pos [lsearch -exact $dataobj $_dlist]
462
463	if {$pos < 0} {
464	if {![Rappture::library isvalid $dataobj]} {
465	error "bad value \"$dataobj\": should be Rappture::library object"
466	}
467
468	if { !$_settings($this-showlabels-initialized) } {
469	set showlabels [$dataobj get components.molecule.about.emblems]
470	if { $showlabels != "" && [string is boolean $showlabels] } {
471	set _settings($this-showlabels) $showlabels
472	}
473	}
474
475	lappend _dlist $dataobj
476	if { $params(-brightness) >= 0.5 } {
477	set _dobj2transparency($dataobj) "ghost"
478	} else {
479	set _dobj2transparency($dataobj) "normal"
480	}
481	set _dobj2raise($dataobj) $params(-raise)
482	debug "setting parameters for $dataobj\n"
483
484	if { [isconnected] } {
485	$_dispatcher event -idle !rebuild
486	}
487	}
488	}
489
490	# ----------------------------------------------------------------------
491	# USAGE: delete ?<dataobj> <dataobj> ...?
492	#
493	# Clients use this to delete a dataobj from the plot. If no dataobjs
494	# are specified, then all dataobjs are deleted.
495	# ----------------------------------------------------------------------
496	itcl::body Rappture::MolvisViewer::delete { args } {
497	if {[llength $args] == 0} {
498	set args $_dlist
499	}
500
501	# delete all specified dataobjs
502	set changed 0
503	set _flush 1
504	foreach dataobj $args {
505	set pos [lsearch -exact $_dlist $dataobj]
506	if {$pos >= 0} {
507	set _dlist [lreplace $_dlist $pos $pos]
508	if { [info exists _obj2models($dataobj)] } {
509	foreach model $_obj2models($dataobj) {
510	array unset _active $model
511	}
512	}
513	array unset _obj2models $dataobj
514	array unset _dobj2transparency $dataobj
515	array unset _dobj2color $dataobj
516	array unset _dobj2width $dataobj
517	array unset _dobj2dashes $dataobj
518	array unset _dobj2raise $dataobj
519	set changed 1
520	}
521	}
522
523	# if anything changed, then rebuild the plot
524	if {$changed} {
525	if { [isconnected] } {
526	$_dispatcher event -idle !rebuild
527	}
528	}
529	}
530
531	# ----------------------------------------------------------------------
532	# USAGE: get
533	#
534	# Clients use this to query the list of objects being plotted, in
535	# order from bottom to top of this result.
536	# ----------------------------------------------------------------------
537	itcl::body Rappture::MolvisViewer::get {} {
538	# put the dataobj list in order according to -raise options
539	set dlist $_dlist
540	foreach obj $dlist {
541	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
542	set i [lsearch -exact $dlist $obj]
543	if {$i >= 0} {
544	set dlist [lreplace $dlist $i $i]
545	lappend dlist $obj
546	}
547	}
548	}
549	return $dlist
550	}
551
552	# ----------------------------------------------------------------------
553	# USAGE: download coming
554	# USAGE: download controls <downloadCommand>
555	# USAGE: download now
556	#
557	# Clients use this method to create a downloadable representation
558	# of the plot. Returns a list of the form {ext string}, where
559	# "ext" is the file extension (indicating the type of data) and
560	# "string" is the data itself.
561	# ----------------------------------------------------------------------
562	itcl::body Rappture::MolvisViewer::download {option args} {
563	switch $option {
564	coming {}
565	controls {
566	set popup .molvisviewerdownload
567	if {![winfo exists $popup]} {
568	# if we haven't created the popup yet, do it now
569	Rappture::Balloon $popup \
570	-title "[Rappture::filexfer::label downloadWord] as..."
571	set inner [$popup component inner]
572	label $inner.summary -text "" -anchor w
573	radiobutton $inner.pdb \
574	-text "PDB Protein Data Bank Format File" \
575	-variable [itcl::scope _downloadPopup(format)] \
576	-font "Arial 10 " \
577	-value pdb
578	Rappture::Tooltip::for $inner.pdb \
579	"Save as PDB Protein Data Bank format file."
580	radiobutton $inner.image -text "Image (PNG/JPEG/GIF)" \
581	-variable [itcl::scope _downloadPopup(format)] \
582	-font "Arial 10 " \
583	-value image
584	Rappture::Tooltip::for $inner.image \
585	"Save as image."
586	set f [frame $inner.frame]
587	button $f.ok -text "Save" \
588	-highlightthickness 0 -pady 3 -padx 3 \
589	-command [lindex $args 0] \
590	-compound left \
591	-image [Rappture::icon download]
592	button $f.cancel -text "Cancel" \
593	-highlightthickness 0 -pady 3 -padx 3 \
594	-command [list $popup deactivate] \
595	-compound left \
596	-image [Rappture::icon cancel]
597	blt::table $f \
598	0,0 $f.ok \
599	0,1 $f.cancel
600	blt::table $inner \
601	0,0 $inner.summary -anchor w \
602	1,0 $inner.pdb -anchor w \
603	2,0 $inner.image -anchor w \
604	3,0 $f -fill x -pady 4
605	$inner.pdb select
606	} else {
607	set inner [$popup component inner]
608	}
609	set num [llength [get]]
610	set num [expr {($num == 1) ? "1 result" : "$num results"}]
611	set word [Rappture::filexfer::label downloadWord]
612	$inner.summary configure -text "$word $num in the following format:"
613	update idletasks ; # Fix initial sizes
614	return $popup
615	}
616	now {
617	set popup .molvisviewerdownload
618	if {[winfo exists $popup]} {
619	$popup deactivate
620	}
621	switch -- $_downloadPopup(format) {
622	"pdb" {
623	return [list .pdb $_pdbdata]
624	}
625	"image" {
626	set popup .molvisviewerimage
627	if { ![winfo exists $popup] } {
628	# Create the balloon popup and and the print image
629	# dialog widget to it.
630	Rappture::Balloon $popup -title "Save as image..." \
631	-deactivatecommand \
632	[itcl::code $this SetWaitVariable 0]
633	set inner [$popup component inner]
634	# Add image controls to the ballon popup
635	AddImageControls $inner [lindex $args 0]
636	} else {
637	set inner [$popup component inner]
638	}
639	update
640	# Activate the popup and call for the output.
641	foreach { widget toolName plotName } $args break
642	SetWaitVariable 0
643	$popup activate $widget left
644	set bool [WaitForResponse]
645	$popup deactivate
646	if { $bool } {
647	return [GetImage $widget]
648	}
649	return ""
650	}
651	}
652	}
653	default {
654	error "bad option \"$option\": should be coming, controls, now"
655	}
656	}
657	}
658
659	#
660	# isconnected --
661	#
662	# Indicates if we are currently connected to the visualization server.
663	#
664	itcl::body Rappture::MolvisViewer::isconnected {} {
665	return [VisViewer::IsConnected]
666	}
667
668
669	#
670	# Connect --
671	#
672	# Establishes a connection to a new visualization server.
673	#
674	itcl::body Rappture::MolvisViewer::Connect {} {
675	global readyForNextFrame
676	set readyForNextFrame 1
677	if { [isconnected] } {
678	return 1
679	}
680	set hosts [GetServerList "pymol"]
681	if { "" == $hosts } {
682	return 0
683	}
684	set _reset 1
685	set result [VisViewer::Connect $hosts]
686	if { $result } {
687	$_dispatcher event -idle !rebuild
688	}
689	return $result
690	}
691
692	#
693	# Disconnect --
694	#
695	# Clients use this method to disconnect from the current rendering
696	# server.
697	#
698	itcl::body Rappture::MolvisViewer::Disconnect {} {
699	VisViewer::Disconnect
700
701	# disconnected -- no more data sitting on server
702	catch { after cancel $_rocker(afterid) }
703	catch { after cancel $_mevent(afterid) }
704	array unset _dataobjs
705	array unset _model
706	array unset _mlist
707	array unset _imagecache
708
709	set _state(server) 1
710	set _state(client) 1
711	set _outbuf ""
712	global readyForNextFrame
713	set readyForNextFrame 1
714	}
715
716	itcl::body Rappture::MolvisViewer::SendCmd { cmd } {
717	debug "in SendCmd ($cmd)\n"
718
719	if { $_buffering } {
720	# Just buffer the commands. Don't send them yet.
721	if { $_state(server) != $_state(client) } {
722	append _outbuf "frame -defer $_state(client)\n"
723	set _state(server) $_state(client)
724	}
725	if { $_rocker(server) != $_rocker(client) } {
726	append _outbuf "rock -defer $_rocker(client)\n"
727	set _rocker(server) $_rocker(client)
728	}
729	append _outbuf "$cmd\n"
730	} else {
731	if { $_state(server) != $_state(client) } {
732	if { ![SendBytes "frame -defer $_state(client)\n"] } {
733	set _state(server) $_state(client)
734	}
735	}
736	if { $_rocker(server) != $_rocker(client) } {
737	if { ![SendBytes "rock -defer $_rocker(client)\n"] } {
738	set _rocker(server) $_rocker(client)
739	}
740	}
741	SendBytes "$cmd\n"
742	}
743	}
744
745	#
746	# ReceiveImage -bytes <size>
747	#
748	# Invoked automatically whenever the "image" command comes in from
749	# the rendering server. Indicates that binary image data with the
750	# specified <size> will follow.
751	#
752	set count 0
753	itcl::body Rappture::MolvisViewer::ReceiveImage { size cacheid frame rock } {
754	global readyForNextFrame
755	set readyForNextFrame 1
756	set tag "$frame,$rock"
757	global count
758	incr count
759	if { $cacheid != $_cacheid } {
760	array unset _imagecache
761	set _cacheid $cacheid
762	}
763	#debug "reading $size bytes from proxy\n"
764	set data [ReceiveBytes $size]
765	#debug "success: reading $size bytes from proxy\n"
766	if { [string match "print*" $cacheid] } {
767	# $frame is the token that we sent to the proxy.
768	set _hardcopy($this-$cacheid) $data
769	puts stderr "setting _hardcopy($this-$cacheid)"
770	} else {
771	set _imagecache($tag) $data
772	#debug "CACHED: $tag,$cacheid"
773	$_image(plot) configure -data $data
774	set _image(id) $tag
775	}
776	}
777
778	itcl::body Rappture::MolvisViewer::BuildSettingsTab {} {
779	set fg [option get $itk_component(hull) font Font]
780
781	set inner [$itk_component(main) insert end \
782	-title "Settings" \
783	-icon [Rappture::icon wrench]]
784	$inner configure -borderwidth 4
785
786	label $inner.pict -image $_settings($this-modelimg)
787
788	label $inner.rep_l -text "Molecule Representation" \
789	-font "Arial 9"
790
791	itk_component add representation {
792	Rappture::Combobox $inner.rep -width 20 -editable no
793	}
794	$inner.rep choices insert end \
795	"ballnstick" "ball and stick" \
796	"spheres" "spheres" \
797	"sticks" "sticks" \
798	"lines" "lines" \
799	"cartoon" "cartoon"
800
801	bind $inner.rep <<Value>> [itcl::code $this Representation]
802	$inner.rep value "ball and stick"
803
804	scale $inner.spherescale -width 10 -font "Arial 9" \
805	-from 0.1 -to 2.0 -resolution 0.05 -label "Sphere Scale" \
806	-showvalue true -orient horizontal \
807	-command [itcl::code $this EventuallyChangeSettings] \
808	-variable Rappture::MolvisViewer::_settings($this-spherescale)
809	$inner.spherescale set $_settings($this-spherescale)
810	Rappture::Tooltip::for $inner.spherescale \
811	"Adjust scale of atoms (spheres or balls). 1.0 is the full VDW radius."
812
813	scale $inner.stickradius -width 10 -font "Arial 9" \
814	-from 0.1 -to 1.0 -resolution 0.025 -label "Stick Radius" \
815	-showvalue true -orient horizontal \
816	-command [itcl::code $this EventuallyChangeSettings] \
817	-variable Rappture::MolvisViewer::_settings($this-stickradius)
818	Rappture::Tooltip::for $inner.stickradius \
819	"Adjust scale of bonds (sticks)."
820	$inner.stickradius set $_settings($this-stickradius)
821
822	checkbutton $inner.labels -text "Show labels on atoms" \
823	-command [itcl::code $this labels update] \
824	-variable [itcl::scope _settings($this-showlabels)] \
825	-font "Arial 9"
826	Rappture::Tooltip::for $inner.labels \
827	"Display atom symbol and serial number."
828
829	checkbutton $inner.rock -text "Rock model back and forth" \
830	-command [itcl::code $this Rock toggle] \
831	-variable Rappture::MolvisViewer::_settings($this-rock) \
832	-font "Arial 9"
833	Rappture::Tooltip::for $inner.rock \
834	"Rotate the object back and forth around the y-axis."
835
836	checkbutton $inner.ortho -text "Orthoscopic projection" \
837	-command [itcl::code $this OrthoProjection update] \
838	-variable Rappture::MolvisViewer::_settings($this-ortho) \
839	-font "Arial 9"
840	Rappture::Tooltip::for $inner.ortho \
841	"Toggle between orthoscopic/perspective projection modes."
842
843	checkbutton $inner.cartoontrace -text "Cartoon Trace" \
844	-command [itcl::code $this CartoonTrace update] \
845	-variable [itcl::scope _settings($this-cartoontrace)] \
846	-font "Arial 9"
847	Rappture::Tooltip::for $inner.cartoontrace \
848	"Set cartoon representation of bonds (sticks)."
849
850	checkbutton $inner.cell -text "Parallelepiped" \
851	-command [itcl::code $this Cell toggle] \
852	-font "Arial 9"
853	$inner.cell select
854
855	label $inner.spacer
856	blt::table $inner \
857	0,0 $inner.labels -anchor w -pady {1 0} \
858	1,0 $inner.rock -anchor w -pady {1 0} \
859	2,0 $inner.ortho -anchor w -pady {1 0} \
860	3,0 $inner.cartoontrace -anchor w -pady {1 0} \
861	4,0 $inner.cell -anchor w -pady {1 0} \
862	5,0 $inner.rep_l -anchor w -pady { 2 0 } \
863	6,0 $inner.rep -anchor w \
864	7,0 $inner.spherescale -fill x -pady {3 0} \
865	8,0 $inner.stickradius -fill x -pady {1 0} \
866
867	blt::table configure $inner r* -resize none
868	blt::table configure $inner r10 -resize expand
869	}
870
871	# ----------------------------------------------------------------------
872	# USAGE: Rebuild
873	#
874	# Called automatically whenever something changes that affects the
875	# data in the widget. Clears any existing data and rebuilds the
876	# widget to display new data.
877	# ----------------------------------------------------------------------
878	itcl::body Rappture::MolvisViewer::Rebuild {} {
879	debug "in rebuild"
880	set changed 0
881
882	# Turn on buffering of commands to the server. We don't want to
883	# be preempted by a server disconnect/reconnect (that automatically
884	# generates a new call to Rebuild).
885	#blt::bltdebug 100
886	set _buffering 1
887	set _cell 0
888
889	if { $_reset } {
890	set _rocker(server) 0
891	set _cacheid 0
892	SendCmd "raw -defer {set auto_color,0}"
893	SendCmd "raw -defer {set auto_show_lines,0}"
894	}
895	set dlist [get]
896	foreach dataobj $dlist {
897	set model [$dataobj get components.molecule.model]
898	if {"" == $model } {
899	set model "molecule"
900	scan $dataobj "::libraryObj%d" suffix
901	set model $model$suffix
902	}
903	lappend _obj2models($dataobj) $model
904	set state [$dataobj get components.molecule.state]
905	if {"" == $state} {
906	set state $_state(server)
907	}
908	if { ![info exists _mlist($model)] } { # new, turn on
909	set _mlist($model) 2
910	} elseif { $_mlist($model) == 1 } { # on, leave on
911	set _mlist($model) 3
912	} elseif { $_mlist($model) == 0 } { # off, turn on
913	set _mlist($model) 2
914	}
915	if { ![info exists _dataobjs($model-$state)] } {
916	set data1 ""
917	set serial 1
918
919	foreach _atom [$dataobj children -type atom components.molecule] {
920	set symbol [$dataobj get components.molecule.$_atom.symbol]
921	set xyz [$dataobj get components.molecule.$_atom.xyz]
922	regsub {,} $xyz {} xyz
923	scan $xyz "%f %f %f" x y z
924	set recname "ATOM "
925	set altLoc ""
926	set resName ""
927	set chainID ""
928	set Seqno ""
929	set occupancy 1
930	set tempFactor 0
931	set recID ""
932	set segID ""
933	set element ""
934	set charge ""
935	set atom $symbol
936	set line [format "%6s%5d %4s%1s%3s %1s%5s %8.3f%8.3f%8.3f%6.2f%6.2f%8s\n" $recname $serial $atom $altLoc $resName $chainID $Seqno $x $y $z $occupancy $tempFactor $recID]
937	append data1 $line
938	incr serial
939	}
940	if {"" != $data1} {
941	# Save the PDB data in case the user wants to later save it.
942	set _pdbdata $data1
943	set nBytes [string length $data1]
944
945	# We know we're buffered here, so append the "loadpdb" command
946	# with the data payload immediately afterwards.
947	SendCmd "loadpdb -defer follows $model $state $nBytes"
948	append _outbuf $data1
949	set _dataobjs($model-$state) 1
950	}
951	# note that pdb files always overwrite xyz files
952	set data2 [$dataobj get components.molecule.pdb]
953	if {"" != $data2} {
954	# Save the PDB data in case the user wants to later save it.
955	set _pdbdata $data2
956	set nBytes [string length $data2]
957
958	# We know we're buffered here, so append the "loadpdb" command
959	# with the data payload immediately afterwards.
960	SendCmd "loadpdb -defer follows $model $state $nBytes"
961	append _outbuf $data2
962	set _dataobjs($model-$state) 1
963	}
964	# lammps dump file overwrites pdb file (change this?)
965	set lammpstypemap [$dataobj get components.molecule.lammpstypemap]
966	set lammpsdata [$dataobj get components.molecule.lammps]
967	if {"" != $lammpsdata} {
968	set data3 ""
969	set modelcount 0
970	foreach lammpsline [split $lammpsdata "\n"] {
971	if {[scan $lammpsline "%d %d %f %f %f" id type x y z] == 5} {
972	set recname "ATOM "
973	set altLoc ""
974	set resName ""
975	set chainID ""
976	set Seqno ""
977	set occupancy 1
978	set tempFactor 0
979	set recID ""
980	set segID ""
981	set element ""
982	set charge ""
983	if { "" == $lammpstypemap} {
984	set atom $type
985	} else {
986	set atom [lindex $lammpstypemap [expr {$type - 1}]]
987	if { "" == $atom} {
988	set atom $type
989	}
990	}
991	set pdbline [format "%6s%5d %4s%1s%3s %1s%5s %8.3f%8.3f%8.3f%6.2f%6.2f%8s\n" $recname $id $atom $altLoc $resName $chainID $Seqno $x $y $z $occupancy $tempFactor $recID]
992	append data3 $pdbline
993	}
994	# only read first model
995	if {[regexp "^ITEM: ATOMS" $lammpsline]} {
996	incr modelcount
997	if {$modelcount > 1} {
998	break
999	}
1000	}
1001	}
1002	if {"" != $data3} {
1003	# Save the PDB data in case the user wants to later save it.
1004	set _pdbdata $data3
1005	set nBytes [string length $data3]
1006
1007	# We know we're buffered here, so append the "loadpdb"
1008	# command with the data payload immediately afterwards.
1009	SendCmd "loadpdb -defer follows $model $state $nBytes"
1010	append _outbuf $data3
1011	}
1012	set _dataobjs($model-$state) 1
1013	}
1014	}
1015	if { ![info exists _model($model-transparency)] } {
1016	set _model($model-transparency) ""
1017	}
1018	if { ![info exists _model($model-rep)] } {
1019	set _model($model-rep) ""
1020	set _model($model-newrep) $_mrep
1021	}
1022	if { $_model($model-transparency) != $_dobj2transparency($dataobj) } {
1023	set _model($model-newtransparency) $_dobj2transparency($dataobj)
1024	}
1025	if { $_dobj2transparency($dataobj) == "ghost"} {
1026	array unset _active $model
1027	} else {
1028	set _active($model) $dataobj
1029	}
1030	set vector [$dataobj get components.parallelepiped.vector]
1031	if { $vector != "" } {
1032	set vertices [ComputeParallelepipedVertices $dataobj]
1033	SendCmd "raw -defer {verts = \[$vertices\]\n}"
1034	SendCmd "raw -defer {run \$PYMOL_SITE_PATH/rappture/box.py\n}"
1035	SendCmd "raw -defer {draw_box(verts)\n}"
1036	set _cell 1
1037	}
1038	}
1039
1040	# enable/disable models as required (0=off->off, 1=on->off, 2=off->on,
1041	# 3=on->on)
1042
1043	foreach model [array names _mlist] {
1044	if { $_mlist($model) == 1 } {
1045	SendCmd "disable -defer $model"
1046	set _mlist($model) 0
1047	set changed 1
1048	} elseif { $_mlist($model) == 2 } {
1049	set _mlist($model) 1
1050	SendCmd "enable -defer $model"
1051	set changed 1
1052	} elseif { $_mlist($model) == 3 } {
1053	set _mlist($model) 1
1054	}
1055	if { $_mlist($model) == 1 } {
1056	if { [info exists _model($model-newtransparency)] \|\|
1057	[info exists _model($model-newrep)] } {
1058	if { ![info exists _model($model-newrep)] } {
1059	set _model($model-newrep) $_model($model-rep)
1060	}
1061	if { ![info exists _model($model-newtransparency)] } {
1062	set _model($model-newtransparency) $_model($model-transparency)
1063	}
1064	set rep $_model($model-newrep)
1065	set transp $_model($model-newtransparency)
1066	SendCmd "representation -defer -model $model $rep"
1067	set changed 1
1068	set _model($model-transparency) $_model($model-newtransparency)
1069	set _model($model-rep) $_model($model-newrep)
1070	catch {
1071	unset _model($model-newtransparency)
1072	unset _model($model-newrep)
1073	}
1074	}
1075	}
1076
1077	}
1078
1079	if { $changed } {
1080	array unset _imagecache
1081	}
1082	if { $dlist == "" } {
1083	set _state(server) 1
1084	set _state(client) 1
1085	SendCmd "frame 1"
1086	set flush 1
1087	} elseif { ![info exists _imagecache($state,$_rocker(client))] } {
1088	set _state(server) $state
1089	set _state(client) $state
1090	SendCmd "frame $state"
1091	set flush 1
1092	} else {
1093	set _state(client) $state
1094	UpdateState
1095	set flush 0
1096	}
1097	if { $_reset } {
1098	# Set or restore viewing parameters. We do this for the first
1099	# model and assume this works for everything else.
1100	set w [winfo width $itk_component(3dview)]
1101	set h [winfo height $itk_component(3dview)]
1102	SendCmd [subst {
1103	reset
1104	screen $w $h
1105	rotate $_view(mx) $_view(my) $_view(mz)
1106	pan $_view(x) $_view(y)
1107	zoom $_view(zoom)
1108	}]
1109	debug "rebuild: rotate $_view(mx) $_view(my) $_view(mz)"
1110
1111	SendCmd "raw -defer {zoom complete=1}"
1112	set _reset 0
1113	}
1114	if { $changed } {
1115	# Default settings for all models.
1116	SphereScale update
1117	StickRadius update
1118	labels update
1119	Opacity update
1120	CartoonTrace update
1121	Cell update
1122	OrthoProjection update
1123	Representation update
1124	}
1125	set inner [$itk_component(main) panel "Settings"]
1126	if { $_cell } {
1127	$inner.cell configure -state normal
1128	} else {
1129	$inner.cell configure -state disabled
1130	}
1131	if { $flush } {
1132	global readyForNextFrame
1133	set readyForNextFrame 0; # Don't advance to the next frame
1134	# until we get an image.
1135	#SendCmd "ppm"; # Flush the results.
1136	set _flush 0
1137	}
1138	set _buffering 0; # Turn off buffering.
1139
1140	blt::busy hold $itk_component(hull)
1141
1142	# Actually write the commands to the server socket.
1143	# If it fails, we don't care. We're finished here.
1144	SendBytes $_outbuf;
1145	set _outbuf ""; # Clear the buffer.
1146	blt::busy release $itk_component(hull)
1147
1148	debug "exiting rebuild"
1149	}
1150
1151	itcl::body Rappture::MolvisViewer::Unmap { } {
1152	# Pause rocking loop while unmapped (saves CPU time)
1153	Rock pause
1154
1155	# Blank image, mark current image dirty
1156	# This will force reload from cache, or remain blank if cache is cleared
1157	# This prevents old image from briefly appearing when a new result is added
1158	# by result viewer
1159
1160	#$_image(plot) blank
1161	set _image(id) ""
1162	}
1163
1164	itcl::body Rappture::MolvisViewer::Map { } {
1165	if { [isconnected] } {
1166	# Resume rocking loop if it was on
1167	Rock unpause
1168	# Rebuild image if modified, or redisplay cached image if not
1169	$_dispatcher event -idle !rebuild
1170	}
1171	}
1172
1173	itcl::body Rappture::MolvisViewer::DoResize { } {
1174	SendCmd "screen $_width $_height"
1175	$_image(plot) configure -width $_width -height $_height
1176	# Immediately invalidate cache, defer update until mapped
1177	array unset _imagecache
1178	set _resizePending 0
1179	}
1180
1181	itcl::body Rappture::MolvisViewer::EventuallyResize { w h } {
1182	set _width $w
1183	set _height $h
1184	if { !$_resizePending } {
1185	$_dispatcher event -after 400 !resize
1186	set _resizePending 1
1187	}
1188	}
1189
1190	itcl::body Rappture::MolvisViewer::DoRotate {} {
1191	SendCmd "rotate $_view(a) $_view(b) $_view(c)"
1192	array unset _imagecache
1193	set _rotatePending 0
1194	}
1195
1196	itcl::body Rappture::MolvisViewer::EventuallyRotate { a b c } {
1197	set _view(a) $a
1198	set _view(b) $b
1199	set _view(c) $c
1200	if { !$_rotatePending } {
1201	$_dispatcher event -after 100 !rotate
1202	set _rotatePending 1
1203	}
1204	}
1205
1206	itcl::body Rappture::MolvisViewer::DoUpdate { } {
1207	array unset _imagecache
1208	set models [array names _mlist]
1209	SphereScale $_settings($this-spherescale) $models
1210	StickRadius $_settings($this-stickradius) $models
1211	set _updatePending 0
1212	}
1213
1214	itcl::body Rappture::MolvisViewer::EventuallyChangeSettings { args } {
1215	if { !$_updatePending } {
1216	$_dispatcher event -after 400 !update
1217	set _updatePending 1
1218	}
1219	}
1220
1221	# ----------------------------------------------------------------------
1222	# USAGE: $this Pan click x y
1223	# $this Pan drag x y
1224	# $this Pan release x y
1225	#
1226	# Called automatically when the user clicks on one of the zoom
1227	# controls for this widget. Changes the zoom for the current view.
1228	# ----------------------------------------------------------------------
1229	itcl::body Rappture::MolvisViewer::Pan {option x y} {
1230	if { $option == "set" } {
1231	set dx $x
1232	set dy $y
1233	set _view(x) [expr $_view(x) + $dx]
1234	set _view(y) [expr $_view(y) + $dy]
1235	array unset _imagecache
1236	SendCmd "pan $dx $dy"
1237	return
1238	}
1239	if { ![info exists _mevent(x)] } {
1240	set option "click"
1241	}
1242	if { $option == "click" } {
1243	$itk_component(3dview) configure -cursor hand1
1244	}
1245	if { $option == "drag" \|\| $option == "release" } {
1246	set dx [expr $x - $_mevent(x)]
1247	set dy [expr $y - $_mevent(y)]
1248	set _view(x) [expr $_view(x) + $dx]
1249	set _view(y) [expr $_view(y) + $dy]
1250	array unset _imagecache
1251	SendCmd "pan $dx $dy"
1252	}
1253	set _mevent(x) $x
1254	set _mevent(y) $y
1255	if { $option == "release" } {
1256	$itk_component(3dview) configure -cursor ""
1257	}
1258	}
1259
1260	# ----------------------------------------------------------------------
1261	# USAGE: Zoom in
1262	# USAGE: Zoom out
1263	# USAGE: Zoom reset
1264	#
1265	# Called automatically when the user clicks on one of the zoom
1266	# controls for this widget. Changes the zoom for the current view.
1267	# ----------------------------------------------------------------------
1268	itcl::body Rappture::MolvisViewer::Zoom {option {factor 10}} {
1269	switch -- $option {
1270	"in" {
1271	set _view(zoom) [expr $_view(zoom) + $factor]
1272	SendCmd "zoom $factor"
1273	}
1274	"out" {
1275	set _view(zoom) [expr $_view(zoom) - $factor]
1276	SendCmd "zoom -$factor"
1277	}
1278	"reset" {
1279	set _view(zoom) 0
1280	SendCmd "reset"
1281	}
1282	}
1283	array unset _imagecache
1284	}
1285
1286	itcl::body Rappture::MolvisViewer::UpdateState { args } {
1287	set tag "$_state(client),$_rocker(client)"
1288	if { $_image(id) != "$tag" } {
1289	if { [info exists _imagecache($tag)] } {
1290	$_image(plot) configure -data $_imagecache($tag)
1291	set _image(id) "$tag"
1292	}
1293	}
1294	}
1295
1296	# ----------------------------------------------------------------------
1297	# USAGE: Rock on\|off\|toggle
1298	# USAGE: Rock pause\|unpause\|step
1299	#
1300	# Used to control the "rocking" model for the molecule being displayed.
1301	# Clients should use only the on/off/toggle options; the rest are for
1302	# internal control of the rocking motion.
1303	# ----------------------------------------------------------------------
1304	itcl::body Rappture::MolvisViewer::Rock { option } {
1305	# cancel any pending rocks
1306	if { [info exists _rocker(afterid)] } {
1307	after cancel $_rocker(afterid)
1308	unset _rocker(afterid)
1309	}
1310	if { ![winfo viewable $itk_component(3dview)] } {
1311	return
1312	}
1313	set _rocker(on) $_settings($this-rock)
1314	if { $option == "step"} {
1315	if { $_rocker(client) >= 10 } {
1316	set _rocker(dir) -1
1317	} elseif { $_rocker(client) <= -10 } {
1318	set _rocker(dir) 1
1319	}
1320	set _rocker(client) [expr {$_rocker(client) + $_rocker(dir)}]
1321	if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
1322	set _rocker(server) $_rocker(client)
1323	SendCmd "rock $_rocker(client)"
1324	}
1325	UpdateState
1326	}
1327	if { $_rocker(on) && $option != "pause" } {
1328	set _rocker(afterid) [after 200 [itcl::code $this Rock step]]
1329	}
1330	}
1331
1332
1333	itcl::body Rappture::MolvisViewer::Vmouse2 {option b m x y} {
1334	set now [clock clicks -milliseconds]
1335	set vButton [expr $b - 1]
1336	set vModifier 0
1337	set vState 1
1338
1339	if { $m & 1 } { set vModifier [expr $vModifier \| 1 ] }
1340	if { $m & 4 } { set vModifier [expr $vModifier \| 2 ] }
1341	if { $m & 131072 } { set vModifier [expr $vModifier \| 4 ] }
1342
1343	if { $option == "click" } { set vState 0 }
1344	if { $option == "release" } { set vState 1 }
1345	if { $option == "drag" } { set vState 2 }
1346	if { $option == "move" } { set vState 3 }
1347
1348	if { $vState == 2 \|\| $vState == 3} {
1349	set diff 0
1350
1351	catch { set diff [expr $now - $_mevent(time)] }
1352	if {$diff < 75} { # 75ms between motion updates
1353	return
1354	}
1355	}
1356	SendCmd "vmouse $vButton $vModifier $vState $x $y"
1357	set _mevent(time) $now
1358	}
1359
1360	itcl::body Rappture::MolvisViewer::Vmouse {option b m x y} {
1361	set now [clock clicks -milliseconds]
1362	# cancel any pending delayed dragging events
1363	if { [info exists _mevent(afterid)] } {
1364	after cancel $_mevent(afterid)
1365	unset _mevent(afterid)
1366	}
1367
1368	if { ![info exists _mevent(x)] } {
1369	set option "click"
1370	}
1371	if { $option == "click" } {
1372	$itk_component(3dview) configure -cursor fleur
1373	}
1374	if { $option == "drag" \|\| $option == "release" } {
1375	set diff 0
1376	catch { set diff [expr $now - $_mevent(time) ] }
1377	if {$diff < 25 && $option == "drag" } { # 75ms between motion updates
1378	set _mevent(afterid) [after [expr 25 - $diff] [itcl::code $this Vmouse drag $b $m $x $y]]
1379	return
1380	}
1381	set w [winfo width $itk_component(3dview)]
1382	set h [winfo height $itk_component(3dview)]
1383	if {$w <= 0 \|\| $h <= 0} {
1384	return
1385	}
1386	set x1 [expr double($w) / 3]
1387	set x2 [expr $x1 * 2]
1388	set y1 [expr double($h) / 3]
1389	set y2 [expr $y1 * 2]
1390	set dx [expr $x - $_mevent(x)]
1391	set dy [expr $y - $_mevent(y)]
1392	set mx 0
1393	set my 0
1394	set mz 0
1395
1396	if { $_mevent(x) < $x1 } {
1397	set mz $dy
1398	} elseif { $_mevent(x) < $x2 } {
1399	set mx $dy
1400	} else {
1401	set mz [expr -$dy]
1402	}
1403
1404	if { $_mevent(y) < $y1 } {
1405	set mz [expr -$dx]
1406	} elseif { $_mevent(y) < $y2 } {
1407	set my $dx
1408	} else {
1409	set mz $dx
1410	}
1411	# Accumlate movements
1412	set _view(mx) [expr {$_view(mx) + $mx}]
1413	set _view(my) [expr {$_view(my) + $my}]
1414	set _view(mz) [expr {$_view(mz) + $mz}]
1415	#SendCmd "rotate $mx $my $mz"
1416	EventuallyRotate $mx $my $mz
1417	debug "_vmmouse: rotate $_view(mx) $_view(my) $_view(mz)"
1418	}
1419	set _mevent(x) $x
1420	set _mevent(y) $y
1421	set _mevent(time) $now
1422	if { $option == "release" } {
1423	$itk_component(3dview) configure -cursor ""
1424	}
1425	}
1426
1427	# ----------------------------------------------------------------------
1428	# USAGE: Rotate click <x> <y>
1429	# USAGE: Rotate drag <x> <y>
1430	# USAGE: Rotate release <x> <y>
1431	#
1432	# Called automatically when the user clicks/drags/releases in the
1433	# plot area. Moves the plot according to the user's actions.
1434	# ----------------------------------------------------------------------
1435	itcl::body Rappture::MolvisViewer::Rotate {option x y} {
1436	set now [clock clicks -milliseconds]
1437	#update idletasks
1438	# cancel any pending delayed dragging events
1439	if { [info exists _mevent(afterid)] } {
1440	after cancel $_mevent(afterid)
1441	unset _mevent(afterid)
1442	}
1443	switch -- $option {
1444	click {
1445	$itk_component(3dview) configure -cursor fleur
1446	set _click(x) $x
1447	set _click(y) $y
1448	set _click(theta) $_view(theta)
1449	set _click(phi) $_view(phi)
1450	}
1451	drag {
1452	if {[array size _click] == 0} {
1453	Rotate click $x $y
1454	} else {
1455	set w [winfo width $itk_component(3dview)]
1456	set h [winfo height $itk_component(3dview)]
1457	if {$w <= 0 \|\| $h <= 0} {
1458	return
1459	}
1460	# set diff 0
1461	# catch { set diff [expr $now - $_mevent(time) ] }
1462	# if {$diff < 175 && $option == "drag" } { # 75ms between motion updates
1463	# set _mevent(afterid) [after [expr 175 - $diff] [itcl::code $this Rotate drag $x $y]]
1464	# return
1465	# }
1466
1467	if {[catch {
1468	# this fails sometimes for no apparent reason
1469	set dx [expr {double($x-$_click(x))/$w}]
1470	set dy [expr {double($y-$_click(y))/$h}]
1471	}]} {
1472	return
1473	}
1474
1475	#
1476	# Rotate the camera in 3D
1477	#
1478	if {$_view(psi) > 90 \|\| $_view(psi) < -90} {
1479	# when psi is flipped around, theta moves backwards
1480	set dy [expr {-$dy}]
1481	}
1482	set theta [expr {$_view(theta) - $dy*180}]
1483	while {$theta < 0} { set theta [expr {$theta+180}] }
1484	while {$theta > 180} { set theta [expr {$theta-180}] }
1485
1486	if {abs($theta) >= 30 && abs($theta) <= 160} {
1487	set phi [expr {$_view(phi) - $dx*360}]
1488	while {$phi < 0} { set phi [expr {$phi+360}] }
1489	while {$phi > 360} { set phi [expr {$phi-360}] }
1490	set psi $_view(psi)
1491	} else {
1492	set phi $_view(phi)
1493	set psi [expr {$_view(psi) - $dx*360}]
1494	while {$psi < -180} { set psi [expr {$psi+360}] }
1495	while {$psi > 180} { set psi [expr {$psi-360}] }
1496	}
1497	array set _view [subst {
1498	theta $theta
1499	phi $phi
1500	psi $psi
1501	}]
1502	foreach { vx vy vz } [Euler2XYZ $theta $phi $psi] break
1503	set a [expr $vx - $_view(vx)]
1504	set a [expr -$a]
1505	set b [expr $vy - $_view(vy)]
1506	set c [expr $vz - $_view(vz)]
1507	array set _view [subst {
1508	vx $vx
1509	vy $vy
1510	vz $vz
1511	}]
1512	EventuallyRotate $a $b $c
1513	#SendCmd "rotate $a $b $c"
1514	debug "Rotate $x $y: rotate $_view(vx) $_view(vy) $_view(vz)"
1515	set _click(x) $x
1516	set _click(y) $y
1517	}
1518	}
1519	release {
1520	Rotate drag $x $y
1521	$itk_component(3dview) configure -cursor ""
1522	catch {unset _click}
1523	}
1524	default {
1525	error "bad option \"$option\": should be click, drag, release"
1526	}
1527	}
1528	set _mevent(time) $now
1529	}
1530
1531	# ----------------------------------------------------------------------
1532	# USAGE: Representation spheres\|ballnstick\|lines\|sticks
1533	#
1534	# Used internally to change the molecular representation used to render
1535	# our scene.
1536	# ----------------------------------------------------------------------
1537	itcl::body Rappture::MolvisViewer::Representation { { option "" } } {
1538	if { $option == "" } {
1539	set value [$itk_component(representation) value]
1540	set option [$itk_component(representation) translate $value]
1541	}
1542	if { $option == $_mrep } {
1543	return
1544	}
1545	if { $option == "update" } {
1546	set option $_settings($this-model)
1547	}
1548	array unset _imagecache
1549	if { $option == "sticks" } {
1550	set _settings($this-modelimg) [Rappture::icon lines]
1551	} else {
1552	set _settings($this-modelimg) [Rappture::icon $option]
1553	}
1554	set inner [$itk_component(main) panel "Settings"]
1555	$inner.pict configure -image $_settings($this-modelimg)
1556
1557	# Save the current option to set all radiobuttons -- just in case.
1558	# This method gets called without the user clicking on a radiobutton.
1559	set _settings($this-model) $option
1560	set _mrep $option
1561
1562	foreach model [array names _mlist] {
1563	if { [info exists _model($model-rep)] } {
1564	if { $_model($model-rep) != $option } {
1565	set _model($model-newrep) $option
1566	} else {
1567	catch { unset _model($model-newrep) }
1568	}
1569	}
1570	}
1571	if { [isconnected] } {
1572	SendCmd "representation -model $model $option"
1573	#$_dispatcher event -idle !rebuild
1574	}
1575	}
1576
1577
1578	# ----------------------------------------------------------------------
1579	# USAGE: OrthoProjection on\|off\|toggle
1580	# USAGE: OrthoProjection update
1581	#
1582	# Used internally to turn labels associated with atoms on/off, and to
1583	# update the positions of the labels so they sit on top of each atom.
1584	# ----------------------------------------------------------------------
1585	itcl::body Rappture::MolvisViewer::OrthoProjection {option} {
1586	array unset _imagecache
1587	switch -- $option {
1588	"orthoscopic" {
1589	set ortho 1
1590	}
1591	"perspective" {
1592	set ortho 0
1593	}
1594	"toggle" {
1595	set ortho [expr {$_settings($this-ortho) == 0}]
1596	}
1597	"update" {
1598	set ortho $_settings($this-ortho)
1599	}
1600	default {
1601	error "bad option \"$option\": should be on, off, toggle, or update"
1602	}
1603	}
1604	if { $ortho == $_settings($this-ortho) && $option != "update"} {
1605	# nothing to do
1606	return
1607	}
1608	if { $ortho } {
1609	$itk_component(ortho) configure -image [Rappture::icon molvis-3dorth]
1610	Rappture::Tooltip::for $itk_component(ortho) \
1611	"Use perspective projection"
1612	set _settings($this-ortho) 1
1613	SendCmd "orthoscopic on"
1614	} else {
1615	$itk_component(ortho) configure -image [Rappture::icon molvis-3dpers]
1616	Rappture::Tooltip::for $itk_component(ortho) \
1617	"Use orthoscopic projection"
1618	set _settings($this-ortho) 0
1619	SendCmd "orthoscopic off"
1620	}
1621	}
1622
1623	# ----------------------------------------------------------------------
1624	# USAGE: Cell on\|off\|toggle
1625	#
1626	# Used internally to turn labels associated with atoms on/off, and to
1627	# update the positions of the labels so they sit on top of each atom.
1628	# ----------------------------------------------------------------------
1629	itcl::body Rappture::MolvisViewer::Cell {option} {
1630	switch -- $option {
1631	"on" - "off" {
1632	set cell $option
1633	}
1634	"toggle" {
1635	set cell [expr {$_settings($this-showcell) == 0}]
1636	}
1637	"update" {
1638	set cell $_settings($this-showcell)
1639	}
1640	default {
1641	error "bad option \"$option\": should be on, off, toggle, or update"
1642	}
1643	}
1644	if { $cell == $_settings($this-showcell) && $option != "update"} {
1645	# nothing to do
1646	return
1647	}
1648	array unset _imagecache
1649	if { $cell } {
1650	Rappture::Tooltip::for $itk_component(ortho) \
1651	"Hide the cell."
1652	set _settings($this-showcell) 1
1653	SendCmd "raw {show everything,unitcell}"
1654	} else {
1655	Rappture::Tooltip::for $itk_component(ortho) \
1656	"Show the cell."
1657	set _settings($this-showcell) 0
1658	SendCmd "raw {hide everything,unitcell}"
1659	}
1660	}
1661
1662
1663	#
1664	# ResetView
1665	#
1666	itcl::body Rappture::MolvisViewer::ResetView {} {
1667	array set _view {
1668	theta 45
1669	phi 45
1670	psi 0
1671	mx 0
1672	my 0
1673	mz 0
1674	x 0
1675	y 0
1676	z 0
1677	zoom 0
1678	width 0
1679	height 0
1680	}
1681	SendCmd "reset"
1682	DoResize
1683	SendCmd "rotate $_view(mx) $_view(my) $_view(mz)"
1684	debug "ResetView: rotate $_view(mx) $_view(my) $_view(mz)"
1685	SendCmd "pan $_view(x) $_view(y)"
1686	SendCmd "zoom $_view(zoom)"
1687	}
1688
1689
1690	itcl::body Rappture::MolvisViewer::WaitIcon { option widget } {
1691	switch -- $option {
1692	"start" {
1693	$_dispatcher dispatch $this !waiticon \
1694	"[itcl::code $this WaitIcon "next" $widget] ; list"
1695	set _icon 0
1696	$widget configure -image [Rappture::icon bigroller${_icon}]
1697	$_dispatcher event -after 100 !waiticon
1698	}
1699	"next" {
1700	incr _icon
1701	if { $_icon >= 8 } {
1702	set _icon 0
1703	}
1704	$widget configure -image [Rappture::icon bigroller${_icon}]
1705	$_dispatcher event -after 100 !waiticon
1706	}
1707	"stop" {
1708	$_dispatcher cancel !waiticon
1709	}
1710	}
1711	}
1712
1713	itcl::body Rappture::MolvisViewer::GetImage { widget } {
1714	set token "print[incr _nextToken]"
1715	set var ::Rappture::MolvisViewer::_hardcopy($this-$token)
1716	set $var ""
1717
1718	set controls $_downloadPopup(image_controls)
1719	set combo $controls.size
1720	set size [$combo translate [$combo value]]
1721	switch -- $size {
1722	"standard" {
1723	set width 1200
1724	set height 1200
1725	}
1726	"highquality" {
1727	set width 2400
1728	set height 2400
1729	}
1730	"draft" {
1731	set width 400
1732	set height 400
1733	}
1734	default {
1735	error "unknown image size [$combo value]"
1736	}
1737	}
1738	# Setup an automatic timeout procedure.
1739	$_dispatcher dispatch $this !pngtimeout "set $var {} ; list"
1740
1741	set popup .molvisviewerimagedownload
1742	if { ![winfo exists $popup] } {
1743	Rappture::Balloon $popup -title "Generating file..."
1744	set inner [$popup component inner]
1745	label $inner.title -text "Generating hardcopy." -font "Arial 10 bold"
1746	label $inner.please -text "This may take a minute." -font "Arial 10"
1747	label $inner.icon -image [Rappture::icon bigroller0]
1748	button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
1749	-command [list set $var ""]
1750	blt::table $inner \
1751	0,0 $inner.title -columnspan 2 \
1752	1,0 $inner.please -anchor w \
1753	1,1 $inner.icon -anchor e \
1754	2,0 $inner.cancel -columnspan 2
1755	blt::table configure $inner r0 -pady 4
1756	blt::table configure $inner r2 -pady 4
1757	bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
1758	} else {
1759	set inner [$popup component inner]
1760	}
1761	set combo $controls.bgcolor
1762	set bgcolor [$combo translate [$combo value]]
1763
1764	$_dispatcher event -after 60000 !pngtimeout
1765	WaitIcon start $inner.icon
1766	grab set $inner
1767	focus $inner.cancel
1768
1769	SendCmd "print $token $width $height $bgcolor"
1770
1771	$popup activate $widget below
1772	# We wait here for either
1773	# 1) the png to be delivered or
1774	# 2) timeout or
1775	# 3) user cancels the operation.
1776	tkwait variable $var
1777
1778	# Clean up.
1779	$_dispatcher cancel !pngtimeout
1780	WaitIcon stop $inner.icon
1781	grab release $inner
1782	$popup deactivate
1783	update
1784
1785	if { $_hardcopy($this-$token) != "" } {
1786	set combo $controls.format
1787	set fmt [$combo translate [$combo value]]
1788	switch -- $fmt {
1789	"jpg" {
1790	set img [image create photo -data $_hardcopy($this-$token)]
1791	set bytes [$img data -format "jpeg -quality 100"]
1792	set bytes [Rappture::encoding::decode -as b64 $bytes]
1793	return [list .jpg $bytes]
1794	}
1795	"gif" {
1796	set img [image create photo -data $_hardcopy($this-$token)]
1797	set bytes [$img data -format "gif"]
1798	set bytes [Rappture::encoding::decode -as b64 $bytes]
1799	return [list .gif $bytes]
1800	}
1801	"png" {
1802	return [list .png $_hardcopy($this-$token)]
1803	}
1804	}
1805	}
1806	return ""
1807	}
1808
1809	# ----------------------------------------------------------------------
1810	# USAGE: SphereScale radius ?model?
1811	# SphereScale update ?model?
1812	#
1813	# Used internally to change the molecular atom scale used to render
1814	# our scene.
1815	#
1816	# Note: Only sets the specified radius for active models. If the model
1817	# is inactive, then it overridden with the value "0.1".
1818	# ----------------------------------------------------------------------
1819
1820	itcl::body Rappture::MolvisViewer::SphereScale { option {models "all"} } {
1821	if { $option == "update" } {
1822	set radius $_settings($this-spherescale)
1823	} elseif { [string is double $option] } {
1824	set radius $option
1825	if { ($radius < 0.1) \|\| ($radius > 2.0) } {
1826	error "bad atom size \"$radius\""
1827	}
1828	} else {
1829	error "bad option \"$option\""
1830	}
1831	set _settings($this-spherescale) $radius
1832	if { $models == "all" } {
1833	SendCmd "spherescale -model all $radius"
1834	return
1835	}
1836	set overrideradius [expr $radius * 0.8]
1837	SendCmd "spherescale -model all $overrideradius"
1838	foreach model $models {
1839	if { [info exists _active($model)] } {
1840	SendCmd "spherescale -model $model $radius"
1841	}
1842	}
1843	}
1844
1845	# ----------------------------------------------------------------------
1846	# USAGE: StickRadius radius ?models?
1847	# StickRadius update ?models?
1848	#
1849	# Used internally to change the stick radius used to render
1850	# our scene.
1851	#
1852	# Note: Only sets the specified radius for active models. If the model
1853	# is inactive, then it overridden with the value "0.25".
1854	# ----------------------------------------------------------------------
1855
1856	itcl::body Rappture::MolvisViewer::StickRadius { option {models "all"} } {
1857	if { $option == "update" } {
1858	set radius $_settings($this-stickradius)
1859	} elseif { [string is double $option] } {
1860	set radius $option
1861	if { ($radius < 0.1) \|\| ($radius > 2.0) } {
1862	error "bad stick radius \"$radius\""
1863	}
1864	} else {
1865	error "bad option \"$option\""
1866	}
1867	set _settings($this-stickradius) $radius
1868	if { $models == "all" } {
1869	SendCmd "stickradius -model all $radius"
1870	return
1871	}
1872	set overrideradius [expr $radius * 0.8]
1873	SendCmd "stickradius -model all $overrideradius"
1874	foreach model $models {
1875	if { [info exists _active($model)] } {
1876	SendCmd "stickradius -model $model $radius"
1877	}
1878	}
1879	}
1880
1881	# ----------------------------------------------------------------------
1882	# USAGE: Opacity value ?models?
1883	# Opacity update ?models?
1884	#
1885	# Used internally to change the opacity (transparency) used to render
1886	# our scene.
1887	#
1888	# Note: Only sets the specified transparency for active models. If the model
1889	# is inactive, then it overridden with the value "0.75".
1890	# ----------------------------------------------------------------------
1891
1892	itcl::body Rappture::MolvisViewer::Opacity { option } {
1893	array unset _imagecache
1894	if { $option == "update" } {
1895	set opacity $_settings($this-opacity)
1896	} elseif { [string is double $option] } {
1897	set opacity $option
1898	if { ($opacity < 0.0) \|\| ($opacity > 1.0) } {
1899	error "bad opacity \"$opacity\""
1900	}
1901	} else {
1902	error "bad option \"$option\""
1903	}
1904	set _settings($this-opacity) $opacity
1905	set transparency [expr 1.0 - $opacity]
1906	set models [array names _active]
1907	if { [llength $models] == 0 } {
1908	SendCmd "transparency -model all $transparency"
1909	return
1910	}
1911	set overridetransparency 0.60
1912	SendCmd "transparency -model all $overridetransparency"
1913	foreach model $models {
1914	SendCmd "transparency -model $model $transparency"
1915	}
1916	}
1917
1918	# ----------------------------------------------------------------------
1919	# USAGE: labels on\|off\|toggle
1920	# USAGE: labels update
1921	#
1922	# Used internally to turn labels associated with atoms on/off, and to
1923	# update the positions of the labels so they sit on top of each atom.
1924	# ----------------------------------------------------------------------
1925	itcl::body Rappture::MolvisViewer::labels {option {models "all"}} {
1926	set showlabels $_settings($this-showlabels)
1927	if { $option == "update" } {
1928	set showlabels $_settings($this-showlabels)
1929	} elseif { [string is boolean $option] } {
1930	set showlabels $option
1931	} else {
1932	error "bad option \"$option\""
1933	}
1934	# Clear the image cache
1935	array unset _imagecache
1936	set _settings($this-showlabels) $showlabels
1937	if { $models == "all" } {
1938	SendCmd "label -model all $showlabels"
1939	return
1940	}
1941	SendCmd "label -model all off"
1942	if { $showlabels } {
1943	foreach model $models {
1944	if { [info exists _active($model)] } {
1945	SendCmd "label -model $model $showlabels"
1946	}
1947	}
1948	}
1949	}
1950
1951	# ----------------------------------------------------------------------
1952	# USAGE: CartoonTrace on\|off\|toggle
1953	# USAGE: CartoonTrace update
1954	#
1955	# Used internally to turn labels associated with atoms on/off, and to
1956	# update the positions of the labels so they sit on top of each atom.
1957	# ----------------------------------------------------------------------
1958	itcl::body Rappture::MolvisViewer::CartoonTrace {option {models "all"}} {
1959	array unset _imagecache
1960	set trace $_settings($this-cartoontrace)
1961	if { $option == "update" } {
1962	set trace $_settings($this-cartoontrace)
1963	} elseif { [string is boolean $option] } {
1964	set trace $option
1965	} else {
1966	error "bad option \"$option\""
1967	}
1968	set _settings($this-cartoontrace) $trace
1969	if { $models == "all" } {
1970	SendCmd "cartoontrace -model all $trace"
1971	return
1972	}
1973	SendCmd "cartoontrace -model all off"
1974	if { $trace } {
1975	foreach model $models {
1976	if { [info exists _active($model)] } {
1977	SendCmd "cartoontrace -model $model $trace"
1978	}
1979	}
1980	}
1981	}
1982
1983	itcl::body Rappture::MolvisViewer::AddImageControls { inner widget } {
1984	label $inner.size_l -text "Size:" -font "Arial 9"
1985	set _downloadPopup(image_controls) $inner
1986	set img $_image(plot)
1987	set res "[image width $img]x[image height $img]"
1988	Rappture::Combobox $inner.size -width 30 -editable no
1989	$inner.size choices insert end \
1990	"draft" "Draft (400x400)" \
1991	"standard" "Standard (1200x1200)" \
1992	"highquality" "High Quality (2400x2400)"
1993
1994	label $inner.bgcolor_l -text "Background:" -font "Arial 9"
1995	Rappture::Combobox $inner.bgcolor -width 30 -editable no
1996	$inner.bgcolor choices insert end \
1997	"black" "Black" \
1998	"white" "White" \
1999	"none" "Transparent (PNG only)"
2000
2001	label $inner.format_l -text "Format:" -font "Arial 9"
2002	Rappture::Combobox $inner.format -width 30 -editable no
2003	$inner.format choices insert end \
2004	"png" "PNG (Portable Network Graphics format)" \
2005	"jpg" "JPEG (Joint Photographic Experts Group format)" \
2006	"gif" "GIF (GIF Graphics Interchange Format)"
2007
2008	set f [frame $inner.frame]
2009	button $f.ok -text "Save" \
2010	-highlightthickness 0 -pady 3 -padx 3 \
2011	-command [itcl::code $this SetWaitVariable 1] \
2012	-compound left \
2013	-image [Rappture::icon download
2014	]
2015	button $f.cancel -text "Cancel" \
2016	-highlightthickness 0 -pady 3 -padx 3 \
2017	-command [itcl::code $this SetWaitVariable 0] \
2018	-compound left \
2019	-image [Rappture::icon cancel]
2020	blt::table $f \
2021	0,0 $f.ok \
2022	0,1 $f.cancel
2023
2024	blt::table $inner \
2025	0,0 $inner.format_l -anchor e \
2026	0,1 $inner.format -anchor w -fill x \
2027	1,0 $inner.size_l -anchor e \
2028	1,1 $inner.size -anchor w -fill x \
2029	2,0 $inner.bgcolor_l -anchor e \
2030	2,1 $inner.bgcolor -anchor w -fill x \
2031	3,0 $f -cspan 2 -fill x
2032	blt::table configure $inner r0 r1 r2 r3 -pady { 4 0 }
2033	blt::table configure $inner r3 -pady { 4 4 }
2034	$inner.bgcolor value "Black"
2035	$inner.size value "Draft (400x400)"
2036	$inner.format value "PNG (Portable Network Graphics format)"
2037	}
2038
2039	itcl::body Rappture::MolvisViewer::snap { w h } {
2040	if { $w <= 0 \|\| $h <= 0 } {
2041	set w [image width $_image(plot)]
2042	set h [image height $_image(plot)]
2043	}
2044	set tag "$_state(client),$_rocker(client)"
2045	if { $_image(id) != "$tag" } {
2046	while { ![info exists _imagecache($tag)] } {
2047	update idletasks
2048	update
2049	after 100
2050	}
2051	if { [info exists _imagecache($tag)] } {
2052	$_image(plot) configure -data $_imagecache($tag)
2053	set _image(id) "$tag"
2054	}
2055	}
2056	set img [image create picture -width $w -height $h]
2057	$img resample $_image(plot)
2058	return $img
2059	}
2060
2061	# FIXME: Handle 2D vectors
2062	itcl::body Rappture::MolvisViewer::ComputeParallelepipedVertices { dataobj } {
2063	# Create a vector for every 3D point
2064	blt::vector point0(3) point1(3) point2(3) point3(3) point4(3) point5(3) \
2065	point6(3) point7(3) origin(3) scale(3)
2066
2067	set count 0
2068	set parent [$dataobj element -as object "components.parallelepiped"]
2069	foreach child [$parent children] {
2070	if { ![string match "vector*" $child] } {
2071	continue
2072	}
2073	incr count
2074	set values [$parent get $child]
2075	regexp -all {,} $values { } values
2076	point$count set $values
2077	}
2078	itcl::delete object $parent
2079	if { $count < 1 \|\| $count > 3 } {
2080	error "bad number of vectors supplied to parallelepiped"
2081	}
2082	point0 set { 0.0 0.0 0.0 }
2083	point4 expr {point2 + point1}
2084	point5 expr {point4 + point3}
2085	point6 expr {point2 + point3}
2086	point7 expr {point1 + point3}
2087
2088	set values [$dataobj get components.parallelepiped.scale]
2089	set n [llength $values]
2090	scale set { 1.0 1.0 1.0 }
2091	if { $n == 1 } {
2092	set scale(0:2) [lindex $values 0]
2093	} elseif { $n == 2 } {
2094	set scale(0:1) [lindex $values 0]
2095	} elseif { $n == 3 } {
2096	scale set $values
2097	}
2098	set values [$dataobj get components.parallelepiped.origin]
2099	set n [llength $values]
2100	origin set { 0.0 0.0 0.0 }
2101	if { $n == 1 } {
2102	set origin(0) [lindex $values 0]
2103	} elseif { $n == 2 } {
2104	set origin(0) [lindex $values 0]
2105	set origin(1) [lindex $values 1]
2106	} elseif { $n == 3 } {
2107	origin set $values
2108	}
2109
2110	# Scale and translate points
2111	for { set i 0 } { $i < 8 } { incr i } {
2112	point${i} expr "(point${i} * scale) + origin"
2113	}
2114
2115	# Generate vertices as a string for PyMOL
2116	set vertices ""
2117	foreach n { 0 1 0 2 0 3 1 4 2 4 2 6 1 7 3 7 5 7 4 5 3 6 5 } {
2118	set values [point${n} range 0 end]
2119	append vertices "\[ [join $values {, }] \], \\\n"
2120	}
2121	set values [point6 range 0 end]
2122	append vertices "\[ [join $values {, }] \] \\\n"
2123	blt::vector destroy point0 point1 point2 point3 point4 point5 point6 \
2124	point7 origin scale
2125	return $vertices
2126	}
2127
2128
2129	# ----------------------------------------------------------------------
2130	# OPTION: -device
2131	# ----------------------------------------------------------------------
2132	itcl::configbody Rappture::MolvisViewer::device {
2133	if {$itk_option(-device) != "" } {
2134	if {![Rappture::library isvalid $itk_option(-device)]} {
2135	error "bad value \"$itk_option(-device)\": should be Rappture::library object"
2136	}
2137	$this delete
2138	$this add $itk_option(-device)
2139	} else {
2140	$this delete
2141	}
2142
2143	if { [isconnected] } {
2144	$_dispatcher event -idle !rebuild
2145	}
2146	}
2147

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

Download in other formats: