Context Navigation

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

Last change on this file since 2691 was 2691, checked in by gah, 13 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.pdb -anchor w \
602	1,0 $inner.image -anchor w \
603	2,0 $f -fill x -pady 4
604	$inner.pdb select
605	} else {
606	set inner [$popup component inner]
607	}
608	set num [llength [get]]
609	set num [expr {($num == 1) ? "1 result" : "$num results"}]
610	set word [Rappture::filexfer::label downloadWord]
611	$inner.summary configure -text "$word $num in the following format:"
612	update idletasks ; # Fix initial sizes
613	return $popup
614	}
615	now {
616	set popup .molvisviewerdownload
617	if {[winfo exists $popup]} {
618	$popup deactivate
619	}
620	switch -- $_downloadPopup(format) {
621	"pdb" {
622	return [list .pdb $_pdbdata]
623	}
624	"image" {
625	set popup .molvisviewerimage
626	if { ![winfo exists $popup] } {
627	# Create the balloon popup and and the print image
628	# dialog widget to it.
629	Rappture::Balloon $popup -title "Save as image..." \
630	-deactivatecommand \
631	[itcl::code $this SetWaitVariable 0]
632	set inner [$popup component inner]
633	# Add image controls to the ballon popup
634	AddImageControls $inner [lindex $args 0]
635	} else {
636	set inner [$popup component inner]
637	}
638	update
639	# Activate the popup and call for the output.
640	foreach { widget toolName plotName } $args break
641	SetWaitVariable 0
642	$popup activate $widget left
643	set bool [WaitForResponse]
644	$popup deactivate
645	if { $bool } {
646	return [GetImage $widget]
647	}
648	return ""
649	}
650	}
651	}
652	default {
653	error "bad option \"$option\": should be coming, controls, now"
654	}
655	}
656	}
657
658	#
659	# isconnected --
660	#
661	# Indicates if we are currently connected to the visualization server.
662	#
663	itcl::body Rappture::MolvisViewer::isconnected {} {
664	return [VisViewer::IsConnected]
665	}
666
667
668	#
669	# Connect --
670	#
671	# Establishes a connection to a new visualization server.
672	#
673	itcl::body Rappture::MolvisViewer::Connect {} {
674	global readyForNextFrame
675	set readyForNextFrame 1
676	if { [isconnected] } {
677	return 1
678	}
679	set hosts [GetServerList "pymol"]
680	if { "" == $hosts } {
681	return 0
682	}
683	set _reset 1
684	set result [VisViewer::Connect $hosts]
685	if { $result } {
686	$_dispatcher event -idle !rebuild
687	}
688	return $result
689	}
690
691	#
692	# Disconnect --
693	#
694	# Clients use this method to disconnect from the current rendering
695	# server.
696	#
697	itcl::body Rappture::MolvisViewer::Disconnect {} {
698	VisViewer::Disconnect
699
700	# disconnected -- no more data sitting on server
701	catch { after cancel $_rocker(afterid) }
702	catch { after cancel $_mevent(afterid) }
703	array unset _dataobjs
704	array unset _model
705	array unset _mlist
706	array unset _imagecache
707
708	set _state(server) 1
709	set _state(client) 1
710	set _outbuf ""
711	global readyForNextFrame
712	set readyForNextFrame 1
713	}
714
715	itcl::body Rappture::MolvisViewer::SendCmd { cmd } {
716	debug "in SendCmd ($cmd)\n"
717
718	if { $_buffering } {
719	# Just buffer the commands. Don't send them yet.
720	if { $_state(server) != $_state(client) } {
721	append _outbuf "frame -defer $_state(client)\n"
722	set _state(server) $_state(client)
723	}
724	if { $_rocker(server) != $_rocker(client) } {
725	append _outbuf "rock -defer $_rocker(client)\n"
726	set _rocker(server) $_rocker(client)
727	}
728	append _outbuf "$cmd\n"
729	} else {
730	if { $_state(server) != $_state(client) } {
731	if { ![SendBytes "frame -defer $_state(client)\n"] } {
732	set _state(server) $_state(client)
733	}
734	}
735	if { $_rocker(server) != $_rocker(client) } {
736	if { ![SendBytes "rock -defer $_rocker(client)\n"] } {
737	set _rocker(server) $_rocker(client)
738	}
739	}
740	SendBytes "$cmd\n"
741	}
742	}
743
744	#
745	# ReceiveImage -bytes <size>
746	#
747	# Invoked automatically whenever the "image" command comes in from
748	# the rendering server. Indicates that binary image data with the
749	# specified <size> will follow.
750	#
751	set count 0
752	itcl::body Rappture::MolvisViewer::ReceiveImage { size cacheid frame rock } {
753	global readyForNextFrame
754	set readyForNextFrame 1
755	set tag "$frame,$rock"
756	global count
757	incr count
758	if { $cacheid != $_cacheid } {
759	array unset _imagecache
760	set _cacheid $cacheid
761	}
762	#debug "reading $size bytes from proxy\n"
763	set data [ReceiveBytes $size]
764	#debug "success: reading $size bytes from proxy\n"
765	if { [string match "print*" $cacheid] } {
766	# $frame is the token that we sent to the proxy.
767	set _hardcopy($this-$cacheid) $data
768	puts stderr "setting _hardcopy($this-$cacheid)"
769	} else {
770	set _imagecache($tag) $data
771	#debug "CACHED: $tag,$cacheid"
772	$_image(plot) configure -data $data
773	set _image(id) $tag
774	}
775	}
776
777	itcl::body Rappture::MolvisViewer::BuildSettingsTab {} {
778	set fg [option get $itk_component(hull) font Font]
779
780	set inner [$itk_component(main) insert end \
781	-title "Settings" \
782	-icon [Rappture::icon wrench]]
783	$inner configure -borderwidth 4
784
785	label $inner.pict -image $_settings($this-modelimg)
786
787	label $inner.rep_l -text "Molecule Representation" \
788	-font "Arial 9"
789
790	itk_component add representation {
791	Rappture::Combobox $inner.rep -width 20 -editable no
792	}
793	$inner.rep choices insert end \
794	"ballnstick" "ball and stick" \
795	"spheres" "spheres" \
796	"sticks" "sticks" \
797	"lines" "lines" \
798	"cartoon" "cartoon"
799
800	bind $inner.rep <<Value>> [itcl::code $this Representation]
801	$inner.rep value "ball and stick"
802
803	scale $inner.spherescale -width 10 -font "Arial 9" \
804	-from 0.1 -to 2.0 -resolution 0.05 -label "Sphere Scale" \
805	-showvalue true -orient horizontal \
806	-command [itcl::code $this EventuallyChangeSettings] \
807	-variable Rappture::MolvisViewer::_settings($this-spherescale)
808	$inner.spherescale set $_settings($this-spherescale)
809	Rappture::Tooltip::for $inner.spherescale \
810	"Adjust scale of atoms (spheres or balls). 1.0 is the full VDW radius."
811
812	scale $inner.stickradius -width 10 -font "Arial 9" \
813	-from 0.1 -to 1.0 -resolution 0.025 -label "Stick Radius" \
814	-showvalue true -orient horizontal \
815	-command [itcl::code $this EventuallyChangeSettings] \
816	-variable Rappture::MolvisViewer::_settings($this-stickradius)
817	Rappture::Tooltip::for $inner.stickradius \
818	"Adjust scale of bonds (sticks)."
819	$inner.stickradius set $_settings($this-stickradius)
820
821	checkbutton $inner.labels -text "Show labels on atoms" \
822	-command [itcl::code $this labels update] \
823	-variable [itcl::scope _settings($this-showlabels)] \
824	-font "Arial 9"
825	Rappture::Tooltip::for $inner.labels \
826	"Display atom symbol and serial number."
827
828	checkbutton $inner.rock -text "Rock model back and forth" \
829	-command [itcl::code $this Rock toggle] \
830	-variable Rappture::MolvisViewer::_settings($this-rock) \
831	-font "Arial 9"
832	Rappture::Tooltip::for $inner.rock \
833	"Rotate the object back and forth around the y-axis."
834
835	checkbutton $inner.ortho -text "Orthoscopic projection" \
836	-command [itcl::code $this OrthoProjection update] \
837	-variable Rappture::MolvisViewer::_settings($this-ortho) \
838	-font "Arial 9"
839	Rappture::Tooltip::for $inner.ortho \
840	"Toggle between orthoscopic/perspective projection modes."
841
842	checkbutton $inner.cartoontrace -text "Cartoon Trace" \
843	-command [itcl::code $this CartoonTrace update] \
844	-variable [itcl::scope _settings($this-cartoontrace)] \
845	-font "Arial 9"
846	Rappture::Tooltip::for $inner.cartoontrace \
847	"Set cartoon representation of bonds (sticks)."
848
849	checkbutton $inner.cell -text "Parallelepiped" \
850	-command [itcl::code $this Cell toggle] \
851	-font "Arial 9"
852	$inner.cell select
853
854	label $inner.spacer
855	blt::table $inner \
856	0,0 $inner.labels -anchor w -pady {1 0} \
857	1,0 $inner.rock -anchor w -pady {1 0} \
858	2,0 $inner.ortho -anchor w -pady {1 0} \
859	3,0 $inner.cartoontrace -anchor w -pady {1 0} \
860	4,0 $inner.cell -anchor w -pady {1 0} \
861	5,0 $inner.rep_l -anchor w -pady { 2 0 } \
862	6,0 $inner.rep -anchor w \
863	7,0 $inner.spherescale -fill x -pady {3 0} \
864	8,0 $inner.stickradius -fill x -pady {1 0} \
865
866	blt::table configure $inner r* -resize none
867	blt::table configure $inner r10 -resize expand
868	}
869
870	# ----------------------------------------------------------------------
871	# USAGE: Rebuild
872	#
873	# Called automatically whenever something changes that affects the
874	# data in the widget. Clears any existing data and rebuilds the
875	# widget to display new data.
876	# ----------------------------------------------------------------------
877	itcl::body Rappture::MolvisViewer::Rebuild {} {
878	debug "in rebuild"
879	set changed 0
880
881	# Turn on buffering of commands to the server. We don't want to
882	# be preempted by a server disconnect/reconnect (that automatically
883	# generates a new call to Rebuild).
884	#blt::bltdebug 100
885	set _buffering 1
886	set _cell 0
887
888	if { $_reset } {
889	set _rocker(server) 0
890	set _cacheid 0
891	SendCmd "raw -defer {set auto_color,0}"
892	SendCmd "raw -defer {set auto_show_lines,0}"
893	}
894	set dlist [get]
895	foreach dataobj $dlist {
896	set model [$dataobj get components.molecule.model]
897	if {"" == $model } {
898	set model "molecule"
899	scan $dataobj "::libraryObj%d" suffix
900	set model $model$suffix
901	}
902	lappend _obj2models($dataobj) $model
903	set state [$dataobj get components.molecule.state]
904	if {"" == $state} {
905	set state $_state(server)
906	}
907	if { ![info exists _mlist($model)] } { # new, turn on
908	set _mlist($model) 2
909	} elseif { $_mlist($model) == 1 } { # on, leave on
910	set _mlist($model) 3
911	} elseif { $_mlist($model) == 0 } { # off, turn on
912	set _mlist($model) 2
913	}
914	if { ![info exists _dataobjs($model-$state)] } {
915	set data1 ""
916	set serial 1
917
918	foreach _atom [$dataobj children -type atom components.molecule] {
919	set symbol [$dataobj get components.molecule.$_atom.symbol]
920	set xyz [$dataobj get components.molecule.$_atom.xyz]
921	regsub {,} $xyz {} xyz
922	scan $xyz "%f %f %f" x y z
923	set recname "ATOM "
924	set altLoc ""
925	set resName ""
926	set chainID ""
927	set Seqno ""
928	set occupancy 1
929	set tempFactor 0
930	set recID ""
931	set segID ""
932	set element ""
933	set charge ""
934	set atom $symbol
935	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]
936	append data1 $line
937	incr serial
938	}
939	if {"" != $data1} {
940	# Save the PDB data in case the user wants to later save it.
941	set _pdbdata $data1
942	set nBytes [string length $data1]
943
944	# We know we're buffered here, so append the "loadpdb" command
945	# with the data payload immediately afterwards.
946	SendCmd "loadpdb -defer follows $model $state $nBytes"
947	append _outbuf $data1
948	set _dataobjs($model-$state) 1
949	}
950	# note that pdb files always overwrite xyz files
951	set data2 [$dataobj get components.molecule.pdb]
952	if {"" != $data2} {
953	# Save the PDB data in case the user wants to later save it.
954	set _pdbdata $data2
955	set nBytes [string length $data2]
956
957	# We know we're buffered here, so append the "loadpdb" command
958	# with the data payload immediately afterwards.
959	SendCmd "loadpdb -defer follows $model $state $nBytes"
960	append _outbuf $data2
961	set _dataobjs($model-$state) 1
962	}
963	# lammps dump file overwrites pdb file (change this?)
964	set lammpstypemap [$dataobj get components.molecule.lammpstypemap]
965	set lammpsdata [$dataobj get components.molecule.lammps]
966	if {"" != $lammpsdata} {
967	set data3 ""
968	set modelcount 0
969	foreach lammpsline [split $lammpsdata "\n"] {
970	if {[scan $lammpsline "%d %d %f %f %f" id type x y z] == 5} {
971	set recname "ATOM "
972	set altLoc ""
973	set resName ""
974	set chainID ""
975	set Seqno ""
976	set occupancy 1
977	set tempFactor 0
978	set recID ""
979	set segID ""
980	set element ""
981	set charge ""
982	if { "" == $lammpstypemap} {
983	set atom $type
984	} else {
985	set atom [lindex $lammpstypemap [expr {$type - 1}]]
986	if { "" == $atom} {
987	set atom $type
988	}
989	}
990	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]
991	append data3 $pdbline
992	}
993	# only read first model
994	if {[regexp "^ITEM: ATOMS" $lammpsline]} {
995	incr modelcount
996	if {$modelcount > 1} {
997	break
998	}
999	}
1000	}
1001	if {"" != $data3} {
1002	# Save the PDB data in case the user wants to later save it.
1003	set _pdbdata $data3
1004	set nBytes [string length $data3]
1005
1006	# We know we're buffered here, so append the "loadpdb"
1007	# command with the data payload immediately afterwards.
1008	SendCmd "loadpdb -defer follows $model $state $nBytes"
1009	append _outbuf $data3
1010	}
1011	set _dataobjs($model-$state) 1
1012	}
1013	}
1014	if { ![info exists _model($model-transparency)] } {
1015	set _model($model-transparency) ""
1016	}
1017	if { ![info exists _model($model-rep)] } {
1018	set _model($model-rep) ""
1019	set _model($model-newrep) $_mrep
1020	}
1021	if { $_model($model-transparency) != $_dobj2transparency($dataobj) } {
1022	set _model($model-newtransparency) $_dobj2transparency($dataobj)
1023	}
1024	if { $_dobj2transparency($dataobj) == "ghost"} {
1025	array unset _active $model
1026	} else {
1027	set _active($model) $dataobj
1028	}
1029	set vector [$dataobj get components.parallelepiped.vector]
1030	if { $vector != "" } {
1031	set vertices [ComputeParallelepipedVertices $dataobj]
1032	SendCmd "raw -defer {verts = \[$vertices\]\n}"
1033	SendCmd "raw -defer {run \$PYMOL_SITE_PATH/rappture/box.py\n}"
1034	SendCmd "raw -defer {draw_box(verts)\n}"
1035	set _cell 1
1036	}
1037	}
1038
1039	# enable/disable models as required (0=off->off, 1=on->off, 2=off->on,
1040	# 3=on->on)
1041
1042	foreach model [array names _mlist] {
1043	if { $_mlist($model) == 1 } {
1044	SendCmd "disable -defer $model"
1045	set _mlist($model) 0
1046	set changed 1
1047	} elseif { $_mlist($model) == 2 } {
1048	set _mlist($model) 1
1049	SendCmd "enable -defer $model"
1050	set changed 1
1051	} elseif { $_mlist($model) == 3 } {
1052	set _mlist($model) 1
1053	}
1054	if { $_mlist($model) == 1 } {
1055	if { [info exists _model($model-newtransparency)] \|\|
1056	[info exists _model($model-newrep)] } {
1057	if { ![info exists _model($model-newrep)] } {
1058	set _model($model-newrep) $_model($model-rep)
1059	}
1060	if { ![info exists _model($model-newtransparency)] } {
1061	set _model($model-newtransparency) $_model($model-transparency)
1062	}
1063	set rep $_model($model-newrep)
1064	set transp $_model($model-newtransparency)
1065	SendCmd "representation -defer -model $model $rep"
1066	set changed 1
1067	set _model($model-transparency) $_model($model-newtransparency)
1068	set _model($model-rep) $_model($model-newrep)
1069	catch {
1070	unset _model($model-newtransparency)
1071	unset _model($model-newrep)
1072	}
1073	}
1074	}
1075
1076	}
1077
1078	if { $changed } {
1079	array unset _imagecache
1080	}
1081	if { $dlist == "" } {
1082	set _state(server) 1
1083	set _state(client) 1
1084	SendCmd "frame 1"
1085	set flush 1
1086	} elseif { ![info exists _imagecache($state,$_rocker(client))] } {
1087	set _state(server) $state
1088	set _state(client) $state
1089	SendCmd "frame $state"
1090	set flush 1
1091	} else {
1092	set _state(client) $state
1093	UpdateState
1094	set flush 0
1095	}
1096	if { $_reset } {
1097	# Set or restore viewing parameters. We do this for the first
1098	# model and assume this works for everything else.
1099	set w [winfo width $itk_component(3dview)]
1100	set h [winfo height $itk_component(3dview)]
1101	SendCmd [subst {
1102	reset
1103	screen $w $h
1104	rotate $_view(mx) $_view(my) $_view(mz)
1105	pan $_view(x) $_view(y)
1106	zoom $_view(zoom)
1107	}]
1108	debug "rebuild: rotate $_view(mx) $_view(my) $_view(mz)"
1109
1110	SendCmd "raw -defer {zoom complete=1}"
1111	set _reset 0
1112	}
1113	if { $changed } {
1114	# Default settings for all models.
1115	SphereScale update
1116	StickRadius update
1117	labels update
1118	Opacity update
1119	CartoonTrace update
1120	Cell update
1121	OrthoProjection update
1122	Representation update
1123	}
1124	set inner [$itk_component(main) panel "Settings"]
1125	if { $_cell } {
1126	$inner.cell configure -state normal
1127	} else {
1128	$inner.cell configure -state disabled
1129	}
1130	if { $flush } {
1131	global readyForNextFrame
1132	set readyForNextFrame 0; # Don't advance to the next frame
1133	# until we get an image.
1134	#SendCmd "ppm"; # Flush the results.
1135	set _flush 0
1136	}
1137	set _buffering 0; # Turn off buffering.
1138
1139	blt::busy hold $itk_component(hull)
1140
1141	# Actually write the commands to the server socket.
1142	# If it fails, we don't care. We're finished here.
1143	SendBytes $_outbuf;
1144	set _outbuf ""; # Clear the buffer.
1145	blt::busy release $itk_component(hull)
1146
1147	debug "exiting rebuild"
1148	}
1149
1150	itcl::body Rappture::MolvisViewer::Unmap { } {
1151	# Pause rocking loop while unmapped (saves CPU time)
1152	Rock pause
1153
1154	# Blank image, mark current image dirty
1155	# This will force reload from cache, or remain blank if cache is cleared
1156	# This prevents old image from briefly appearing when a new result is added
1157	# by result viewer
1158
1159	#$_image(plot) blank
1160	set _image(id) ""
1161	}
1162
1163	itcl::body Rappture::MolvisViewer::Map { } {
1164	if { [isconnected] } {
1165	# Resume rocking loop if it was on
1166	Rock unpause
1167	# Rebuild image if modified, or redisplay cached image if not
1168	$_dispatcher event -idle !rebuild
1169	}
1170	}
1171
1172	itcl::body Rappture::MolvisViewer::DoResize { } {
1173	SendCmd "screen $_width $_height"
1174	$_image(plot) configure -width $_width -height $_height
1175	# Immediately invalidate cache, defer update until mapped
1176	array unset _imagecache
1177	set _resizePending 0
1178	}
1179
1180	itcl::body Rappture::MolvisViewer::EventuallyResize { w h } {
1181	set _width $w
1182	set _height $h
1183	if { !$_resizePending } {
1184	$_dispatcher event -after 400 !resize
1185	set _resizePending 1
1186	}
1187	}
1188
1189	itcl::body Rappture::MolvisViewer::DoRotate {} {
1190	SendCmd "rotate $_view(a) $_view(b) $_view(c)"
1191	array unset _imagecache
1192	set _rotatePending 0
1193	}
1194
1195	itcl::body Rappture::MolvisViewer::EventuallyRotate { a b c } {
1196	set _view(a) $a
1197	set _view(b) $b
1198	set _view(c) $c
1199	if { !$_rotatePending } {
1200	$_dispatcher event -after 50 !rotate
1201	set _rotatePending 1
1202	}
1203	}
1204
1205	itcl::body Rappture::MolvisViewer::DoUpdate { } {
1206	array unset _imagecache
1207	set models [array names _mlist]
1208	SphereScale $_settings($this-spherescale) $models
1209	StickRadius $_settings($this-stickradius) $models
1210	set _updatePending 0
1211	}
1212
1213	itcl::body Rappture::MolvisViewer::EventuallyChangeSettings { args } {
1214	if { !$_updatePending } {
1215	$_dispatcher event -after 400 !update
1216	set _updatePending 1
1217	}
1218	}
1219
1220	# ----------------------------------------------------------------------
1221	# USAGE: $this Pan click x y
1222	# $this Pan drag x y
1223	# $this Pan release x y
1224	#
1225	# Called automatically when the user clicks on one of the zoom
1226	# controls for this widget. Changes the zoom for the current view.
1227	# ----------------------------------------------------------------------
1228	itcl::body Rappture::MolvisViewer::Pan {option x y} {
1229	if { $option == "set" } {
1230	set dx $x
1231	set dy $y
1232	set _view(x) [expr $_view(x) + $dx]
1233	set _view(y) [expr $_view(y) + $dy]
1234	array unset _imagecache
1235	SendCmd "pan $dx $dy"
1236	return
1237	}
1238	if { ![info exists _mevent(x)] } {
1239	set option "click"
1240	}
1241	if { $option == "click" } {
1242	$itk_component(3dview) configure -cursor hand1
1243	}
1244	if { $option == "drag" \|\| $option == "release" } {
1245	set dx [expr $x - $_mevent(x)]
1246	set dy [expr $y - $_mevent(y)]
1247	set _view(x) [expr $_view(x) + $dx]
1248	set _view(y) [expr $_view(y) + $dy]
1249	array unset _imagecache
1250	SendCmd "pan $dx $dy"
1251	}
1252	set _mevent(x) $x
1253	set _mevent(y) $y
1254	if { $option == "release" } {
1255	$itk_component(3dview) configure -cursor ""
1256	}
1257	}
1258
1259	# ----------------------------------------------------------------------
1260	# USAGE: Zoom in
1261	# USAGE: Zoom out
1262	# USAGE: Zoom reset
1263	#
1264	# Called automatically when the user clicks on one of the zoom
1265	# controls for this widget. Changes the zoom for the current view.
1266	# ----------------------------------------------------------------------
1267	itcl::body Rappture::MolvisViewer::Zoom {option {factor 10}} {
1268	switch -- $option {
1269	"in" {
1270	set _view(zoom) [expr $_view(zoom) + $factor]
1271	SendCmd "zoom $factor"
1272	}
1273	"out" {
1274	set _view(zoom) [expr $_view(zoom) - $factor]
1275	SendCmd "zoom -$factor"
1276	}
1277	"reset" {
1278	set _view(zoom) 0
1279	SendCmd "reset"
1280	}
1281	}
1282	array unset _imagecache
1283	}
1284
1285	itcl::body Rappture::MolvisViewer::UpdateState { args } {
1286	set tag "$_state(client),$_rocker(client)"
1287	if { $_image(id) != "$tag" } {
1288	if { [info exists _imagecache($tag)] } {
1289	$_image(plot) configure -data $_imagecache($tag)
1290	set _image(id) "$tag"
1291	}
1292	}
1293	}
1294
1295	# ----------------------------------------------------------------------
1296	# USAGE: Rock on\|off\|toggle
1297	# USAGE: Rock pause\|unpause\|step
1298	#
1299	# Used to control the "rocking" model for the molecule being displayed.
1300	# Clients should use only the on/off/toggle options; the rest are for
1301	# internal control of the rocking motion.
1302	# ----------------------------------------------------------------------
1303	itcl::body Rappture::MolvisViewer::Rock { option } {
1304	# cancel any pending rocks
1305	if { [info exists _rocker(afterid)] } {
1306	after cancel $_rocker(afterid)
1307	unset _rocker(afterid)
1308	}
1309	if { ![winfo viewable $itk_component(3dview)] } {
1310	return
1311	}
1312	set _rocker(on) $_settings($this-rock)
1313	if { $option == "step"} {
1314	if { $_rocker(client) >= 10 } {
1315	set _rocker(dir) -1
1316	} elseif { $_rocker(client) <= -10 } {
1317	set _rocker(dir) 1
1318	}
1319	set _rocker(client) [expr {$_rocker(client) + $_rocker(dir)}]
1320	if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
1321	set _rocker(server) $_rocker(client)
1322	SendCmd "rock $_rocker(client)"
1323	}
1324	UpdateState
1325	}
1326	if { $_rocker(on) && $option != "pause" } {
1327	set _rocker(afterid) [after 200 [itcl::code $this Rock step]]
1328	}
1329	}
1330
1331
1332	itcl::body Rappture::MolvisViewer::Vmouse2 {option b m x y} {
1333	set now [clock clicks -milliseconds]
1334	set vButton [expr $b - 1]
1335	set vModifier 0
1336	set vState 1
1337
1338	if { $m & 1 } { set vModifier [expr $vModifier \| 1 ] }
1339	if { $m & 4 } { set vModifier [expr $vModifier \| 2 ] }
1340	if { $m & 131072 } { set vModifier [expr $vModifier \| 4 ] }
1341
1342	if { $option == "click" } { set vState 0 }
1343	if { $option == "release" } { set vState 1 }
1344	if { $option == "drag" } { set vState 2 }
1345	if { $option == "move" } { set vState 3 }
1346
1347	if { $vState == 2 \|\| $vState == 3} {
1348	set diff 0
1349
1350	catch { set diff [expr $now - $_mevent(time)] }
1351	if {$diff < 75} { # 75ms between motion updates
1352	return
1353	}
1354	}
1355	SendCmd "vmouse $vButton $vModifier $vState $x $y"
1356	set _mevent(time) $now
1357	}
1358
1359	itcl::body Rappture::MolvisViewer::Vmouse {option b m x y} {
1360	set now [clock clicks -milliseconds]
1361	# cancel any pending delayed dragging events
1362	if { [info exists _mevent(afterid)] } {
1363	after cancel $_mevent(afterid)
1364	unset _mevent(afterid)
1365	}
1366
1367	if { ![info exists _mevent(x)] } {
1368	set option "click"
1369	}
1370	if { $option == "click" } {
1371	$itk_component(3dview) configure -cursor fleur
1372	}
1373	if { $option == "drag" \|\| $option == "release" } {
1374	set diff 0
1375	catch { set diff [expr $now - $_mevent(time) ] }
1376	if {$diff < 25 && $option == "drag" } { # 75ms between motion updates
1377	set _mevent(afterid) [after [expr 25 - $diff] [itcl::code $this Vmouse drag $b $m $x $y]]
1378	return
1379	}
1380	set w [winfo width $itk_component(3dview)]
1381	set h [winfo height $itk_component(3dview)]
1382	if {$w <= 0 \|\| $h <= 0} {
1383	return
1384	}
1385	set x1 [expr double($w) / 3]
1386	set x2 [expr $x1 * 2]
1387	set y1 [expr double($h) / 3]
1388	set y2 [expr $y1 * 2]
1389	set dx [expr $x - $_mevent(x)]
1390	set dy [expr $y - $_mevent(y)]
1391	set mx 0
1392	set my 0
1393	set mz 0
1394
1395	if { $_mevent(x) < $x1 } {
1396	set mz $dy
1397	} elseif { $_mevent(x) < $x2 } {
1398	set mx $dy
1399	} else {
1400	set mz [expr -$dy]
1401	}
1402
1403	if { $_mevent(y) < $y1 } {
1404	set mz [expr -$dx]
1405	} elseif { $_mevent(y) < $y2 } {
1406	set my $dx
1407	} else {
1408	set mz $dx
1409	}
1410	# Accumlate movements
1411	set _view(mx) [expr {$_view(mx) + $mx}]
1412	set _view(my) [expr {$_view(my) + $my}]
1413	set _view(mz) [expr {$_view(mz) + $mz}]
1414	#SendCmd "rotate $mx $my $mz"
1415	EventuallyRotate $mx $my $mz
1416	debug "_vmmouse: rotate $_view(mx) $_view(my) $_view(mz)"
1417	}
1418	set _mevent(x) $x
1419	set _mevent(y) $y
1420	set _mevent(time) $now
1421	if { $option == "release" } {
1422	$itk_component(3dview) configure -cursor ""
1423	}
1424	}
1425
1426	# ----------------------------------------------------------------------
1427	# USAGE: Rotate click <x> <y>
1428	# USAGE: Rotate drag <x> <y>
1429	# USAGE: Rotate release <x> <y>
1430	#
1431	# Called automatically when the user clicks/drags/releases in the
1432	# plot area. Moves the plot according to the user's actions.
1433	# ----------------------------------------------------------------------
1434	itcl::body Rappture::MolvisViewer::Rotate {option x y} {
1435	set now [clock clicks -milliseconds]
1436	#update idletasks
1437	# cancel any pending delayed dragging events
1438	if { [info exists _mevent(afterid)] } {
1439	after cancel $_mevent(afterid)
1440	unset _mevent(afterid)
1441	}
1442	switch -- $option {
1443	click {
1444	$itk_component(3dview) configure -cursor fleur
1445	set _click(x) $x
1446	set _click(y) $y
1447	set _click(theta) $_view(theta)
1448	set _click(phi) $_view(phi)
1449	}
1450	drag {
1451	if {[array size _click] == 0} {
1452	Rotate click $x $y
1453	} else {
1454	set w [winfo width $itk_component(3dview)]
1455	set h [winfo height $itk_component(3dview)]
1456	if {$w <= 0 \|\| $h <= 0} {
1457	return
1458	}
1459	# set diff 0
1460	# catch { set diff [expr $now - $_mevent(time) ] }
1461	# if {$diff < 175 && $option == "drag" } { # 75ms between motion updates
1462	# set _mevent(afterid) [after [expr 175 - $diff] [itcl::code $this Rotate drag $x $y]]
1463	# return
1464	# }
1465
1466	if {[catch {
1467	# this fails sometimes for no apparent reason
1468	set dx [expr {double($x-$_click(x))/$w}]
1469	set dy [expr {double($y-$_click(y))/$h}]
1470	}]} {
1471	return
1472	}
1473
1474	#
1475	# Rotate the camera in 3D
1476	#
1477	if {$_view(psi) > 90 \|\| $_view(psi) < -90} {
1478	# when psi is flipped around, theta moves backwards
1479	set dy [expr {-$dy}]
1480	}
1481	set theta [expr {$_view(theta) - $dy*180}]
1482	while {$theta < 0} { set theta [expr {$theta+180}] }
1483	while {$theta > 180} { set theta [expr {$theta-180}] }
1484
1485	if {abs($theta) >= 30 && abs($theta) <= 160} {
1486	set phi [expr {$_view(phi) - $dx*360}]
1487	while {$phi < 0} { set phi [expr {$phi+360}] }
1488	while {$phi > 360} { set phi [expr {$phi-360}] }
1489	set psi $_view(psi)
1490	} else {
1491	set phi $_view(phi)
1492	set psi [expr {$_view(psi) - $dx*360}]
1493	while {$psi < -180} { set psi [expr {$psi+360}] }
1494	while {$psi > 180} { set psi [expr {$psi-360}] }
1495	}
1496	array set _view [subst {
1497	theta $theta
1498	phi $phi
1499	psi $psi
1500	}]
1501	foreach { vx vy vz } [Euler2XYZ $theta $phi $psi] break
1502	set a [expr $vx - $_view(vx)]
1503	set a [expr -$a]
1504	set b [expr $vy - $_view(vy)]
1505	set c [expr $vz - $_view(vz)]
1506	array set _view [subst {
1507	vx $vx
1508	vy $vy
1509	vz $vz
1510	}]
1511	EventuallyRotate $a $b $c
1512	#SendCmd "rotate $a $b $c"
1513	debug "Rotate $x $y: rotate $_view(vx) $_view(vy) $_view(vz)"
1514	set _click(x) $x
1515	set _click(y) $y
1516	}
1517	}
1518	release {
1519	Rotate drag $x $y
1520	$itk_component(3dview) configure -cursor ""
1521	catch {unset _click}
1522	}
1523	default {
1524	error "bad option \"$option\": should be click, drag, release"
1525	}
1526	}
1527	set _mevent(time) $now
1528	}
1529
1530	# ----------------------------------------------------------------------
1531	# USAGE: Representation spheres\|ballnstick\|lines\|sticks
1532	#
1533	# Used internally to change the molecular representation used to render
1534	# our scene.
1535	# ----------------------------------------------------------------------
1536	itcl::body Rappture::MolvisViewer::Representation { { option "" } } {
1537	if { $option == "" } {
1538	set value [$itk_component(representation) value]
1539	set option [$itk_component(representation) translate $value]
1540	}
1541	if { $option == $_mrep } {
1542	return
1543	}
1544	if { $option == "update" } {
1545	set option $_settings($this-model)
1546	}
1547	array unset _imagecache
1548	if { $option == "sticks" } {
1549	set _settings($this-modelimg) [Rappture::icon lines]
1550	} else {
1551	set _settings($this-modelimg) [Rappture::icon $option]
1552	}
1553	set inner [$itk_component(main) panel "Settings"]
1554	$inner.pict configure -image $_settings($this-modelimg)
1555
1556	# Save the current option to set all radiobuttons -- just in case.
1557	# This method gets called without the user clicking on a radiobutton.
1558	set _settings($this-model) $option
1559	set _mrep $option
1560
1561	foreach model [array names _mlist] {
1562	if { [info exists _model($model-rep)] } {
1563	if { $_model($model-rep) != $option } {
1564	set _model($model-newrep) $option
1565	} else {
1566	catch { unset _model($model-newrep) }
1567	}
1568	}
1569	}
1570	if { [isconnected] } {
1571	SendCmd "representation -model $model $option"
1572	#$_dispatcher event -idle !rebuild
1573	}
1574	}
1575
1576
1577	# ----------------------------------------------------------------------
1578	# USAGE: OrthoProjection on\|off\|toggle
1579	# USAGE: OrthoProjection update
1580	#
1581	# Used internally to turn labels associated with atoms on/off, and to
1582	# update the positions of the labels so they sit on top of each atom.
1583	# ----------------------------------------------------------------------
1584	itcl::body Rappture::MolvisViewer::OrthoProjection {option} {
1585	array unset _imagecache
1586	switch -- $option {
1587	"orthoscopic" {
1588	set ortho 1
1589	}
1590	"perspective" {
1591	set ortho 0
1592	}
1593	"toggle" {
1594	set ortho [expr {$_settings($this-ortho) == 0}]
1595	}
1596	"update" {
1597	set ortho $_settings($this-ortho)
1598	}
1599	default {
1600	error "bad option \"$option\": should be on, off, toggle, or update"
1601	}
1602	}
1603	if { $ortho == $_settings($this-ortho) && $option != "update"} {
1604	# nothing to do
1605	return
1606	}
1607	if { $ortho } {
1608	$itk_component(ortho) configure -image [Rappture::icon molvis-3dorth]
1609	Rappture::Tooltip::for $itk_component(ortho) \
1610	"Use perspective projection"
1611	set _settings($this-ortho) 1
1612	SendCmd "orthoscopic on"
1613	} else {
1614	$itk_component(ortho) configure -image [Rappture::icon molvis-3dpers]
1615	Rappture::Tooltip::for $itk_component(ortho) \
1616	"Use orthoscopic projection"
1617	set _settings($this-ortho) 0
1618	SendCmd "orthoscopic off"
1619	}
1620	}
1621
1622	# ----------------------------------------------------------------------
1623	# USAGE: Cell on\|off\|toggle
1624	#
1625	# Used internally to turn labels associated with atoms on/off, and to
1626	# update the positions of the labels so they sit on top of each atom.
1627	# ----------------------------------------------------------------------
1628	itcl::body Rappture::MolvisViewer::Cell {option} {
1629	switch -- $option {
1630	"on" - "off" {
1631	set cell $option
1632	}
1633	"toggle" {
1634	set cell [expr {$_settings($this-showcell) == 0}]
1635	}
1636	"update" {
1637	set cell $_settings($this-showcell)
1638	}
1639	default {
1640	error "bad option \"$option\": should be on, off, toggle, or update"
1641	}
1642	}
1643	if { $cell == $_settings($this-showcell) && $option != "update"} {
1644	# nothing to do
1645	return
1646	}
1647	array unset _imagecache
1648	if { $cell } {
1649	Rappture::Tooltip::for $itk_component(ortho) \
1650	"Hide the cell."
1651	set _settings($this-showcell) 1
1652	SendCmd "raw {show everything,unitcell}"
1653	} else {
1654	Rappture::Tooltip::for $itk_component(ortho) \
1655	"Show the cell."
1656	set _settings($this-showcell) 0
1657	SendCmd "raw {hide everything,unitcell}"
1658	}
1659	}
1660
1661
1662	#
1663	# ResetView
1664	#
1665	itcl::body Rappture::MolvisViewer::ResetView {} {
1666	array set _view {
1667	theta 45
1668	phi 45
1669	psi 0
1670	mx 0
1671	my 0
1672	mz 0
1673	x 0
1674	y 0
1675	z 0
1676	zoom 0
1677	width 0
1678	height 0
1679	}
1680	SendCmd "reset"
1681	DoResize
1682	SendCmd "rotate $_view(mx) $_view(my) $_view(mz)"
1683	debug "ResetView: rotate $_view(mx) $_view(my) $_view(mz)"
1684	SendCmd "pan $_view(x) $_view(y)"
1685	SendCmd "zoom $_view(zoom)"
1686	}
1687
1688
1689	itcl::body Rappture::MolvisViewer::WaitIcon { option widget } {
1690	switch -- $option {
1691	"start" {
1692	$_dispatcher dispatch $this !waiticon \
1693	"[itcl::code $this WaitIcon "next" $widget] ; list"
1694	set _icon 0
1695	$widget configure -image [Rappture::icon bigroller${_icon}]
1696	$_dispatcher event -after 100 !waiticon
1697	}
1698	"next" {
1699	incr _icon
1700	if { $_icon >= 8 } {
1701	set _icon 0
1702	}
1703	$widget configure -image [Rappture::icon bigroller${_icon}]
1704	$_dispatcher event -after 100 !waiticon
1705	}
1706	"stop" {
1707	$_dispatcher cancel !waiticon
1708	}
1709	}
1710	}
1711
1712	itcl::body Rappture::MolvisViewer::GetImage { widget } {
1713	set token "print[incr _nextToken]"
1714	set var ::Rappture::MolvisViewer::_hardcopy($this-$token)
1715	set $var ""
1716
1717	set controls $_downloadPopup(image_controls)
1718	set combo $controls.size
1719	set size [$combo translate [$combo value]]
1720	switch -- $size {
1721	"standard" {
1722	set width 1200
1723	set height 1200
1724	}
1725	"highquality" {
1726	set width 2400
1727	set height 2400
1728	}
1729	"draft" {
1730	set width 400
1731	set height 400
1732	}
1733	default {
1734	error "unknown image size [$combo value]"
1735	}
1736	}
1737	# Setup an automatic timeout procedure.
1738	$_dispatcher dispatch $this !pngtimeout "set $var {} ; list"
1739
1740	set popup .molvisviewerimagedownload
1741	if { ![winfo exists $popup] } {
1742	Rappture::Balloon $popup -title "Generating file..."
1743	set inner [$popup component inner]
1744	label $inner.title -text "Generating hardcopy." -font "Arial 10 bold"
1745	label $inner.please -text "This may take a minute." -font "Arial 10"
1746	label $inner.icon -image [Rappture::icon bigroller0]
1747	button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
1748	-command [list set $var ""]
1749	blt::table $inner \
1750	0,0 $inner.title -columnspan 2 \
1751	1,0 $inner.please -anchor w \
1752	1,1 $inner.icon -anchor e \
1753	2,0 $inner.cancel -columnspan 2
1754	blt::table configure $inner r0 -pady 4
1755	blt::table configure $inner r2 -pady 4
1756	bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
1757	} else {
1758	set inner [$popup component inner]
1759	}
1760	set combo $controls.bgcolor
1761	set bgcolor [$combo translate [$combo value]]
1762
1763	$_dispatcher event -after 60000 !pngtimeout
1764	WaitIcon start $inner.icon
1765	grab set $inner
1766	focus $inner.cancel
1767
1768	SendCmd "print $token $width $height $bgcolor"
1769
1770	$popup activate $widget below
1771	# We wait here for either
1772	# 1) the png to be delivered or
1773	# 2) timeout or
1774	# 3) user cancels the operation.
1775	tkwait variable $var
1776
1777	# Clean up.
1778	$_dispatcher cancel !pngtimeout
1779	WaitIcon stop $inner.icon
1780	grab release $inner
1781	$popup deactivate
1782	update
1783
1784	if { $_hardcopy($this-$token) != "" } {
1785	set combo $controls.format
1786	set fmt [$combo translate [$combo value]]
1787	switch -- $fmt {
1788	"jpg" {
1789	set img [image create photo -data $_hardcopy($this-$token)]
1790	set bytes [$img data -format "jpeg -quality 100"]
1791	set bytes [Rappture::encoding::decode -as b64 $bytes]
1792	return [list .jpg $bytes]
1793	}
1794	"gif" {
1795	set img [image create photo -data $_hardcopy($this-$token)]
1796	set bytes [$img data -format "gif"]
1797	set bytes [Rappture::encoding::decode -as b64 $bytes]
1798	return [list .gif $bytes]
1799	}
1800	"png" {
1801	return [list .png $_hardcopy($this-$token)]
1802	}
1803	}
1804	}
1805	return ""
1806	}
1807
1808	# ----------------------------------------------------------------------
1809	# USAGE: SphereScale radius ?model?
1810	# SphereScale update ?model?
1811	#
1812	# Used internally to change the molecular atom scale used to render
1813	# our scene.
1814	#
1815	# Note: Only sets the specified radius for active models. If the model
1816	# is inactive, then it overridden with the value "0.1".
1817	# ----------------------------------------------------------------------
1818
1819	itcl::body Rappture::MolvisViewer::SphereScale { option {models "all"} } {
1820	if { $option == "update" } {
1821	set radius $_settings($this-spherescale)
1822	} elseif { [string is double $option] } {
1823	set radius $option
1824	if { ($radius < 0.1) \|\| ($radius > 2.0) } {
1825	error "bad atom size \"$radius\""
1826	}
1827	} else {
1828	error "bad option \"$option\""
1829	}
1830	set _settings($this-spherescale) $radius
1831	if { $models == "all" } {
1832	SendCmd "spherescale -model all $radius"
1833	return
1834	}
1835	set overrideradius [expr $radius * 0.8]
1836	SendCmd "spherescale -model all $overrideradius"
1837	foreach model $models {
1838	if { [info exists _active($model)] } {
1839	SendCmd "spherescale -model $model $radius"
1840	}
1841	}
1842	}
1843
1844	# ----------------------------------------------------------------------
1845	# USAGE: StickRadius radius ?models?
1846	# StickRadius update ?models?
1847	#
1848	# Used internally to change the stick radius used to render
1849	# our scene.
1850	#
1851	# Note: Only sets the specified radius for active models. If the model
1852	# is inactive, then it overridden with the value "0.25".
1853	# ----------------------------------------------------------------------
1854
1855	itcl::body Rappture::MolvisViewer::StickRadius { option {models "all"} } {
1856	if { $option == "update" } {
1857	set radius $_settings($this-stickradius)
1858	} elseif { [string is double $option] } {
1859	set radius $option
1860	if { ($radius < 0.1) \|\| ($radius > 2.0) } {
1861	error "bad stick radius \"$radius\""
1862	}
1863	} else {
1864	error "bad option \"$option\""
1865	}
1866	set _settings($this-stickradius) $radius
1867	if { $models == "all" } {
1868	SendCmd "stickradius -model all $radius"
1869	return
1870	}
1871	set overrideradius [expr $radius * 0.8]
1872	SendCmd "stickradius -model all $overrideradius"
1873	foreach model $models {
1874	if { [info exists _active($model)] } {
1875	SendCmd "stickradius -model $model $radius"
1876	}
1877	}
1878	}
1879
1880	# ----------------------------------------------------------------------
1881	# USAGE: Opacity value ?models?
1882	# Opacity update ?models?
1883	#
1884	# Used internally to change the opacity (transparency) used to render
1885	# our scene.
1886	#
1887	# Note: Only sets the specified transparency for active models. If the model
1888	# is inactive, then it overridden with the value "0.75".
1889	# ----------------------------------------------------------------------
1890
1891	itcl::body Rappture::MolvisViewer::Opacity { option } {
1892	array unset _imagecache
1893	if { $option == "update" } {
1894	set opacity $_settings($this-opacity)
1895	} elseif { [string is double $option] } {
1896	set opacity $option
1897	if { ($opacity < 0.0) \|\| ($opacity > 1.0) } {
1898	error "bad opacity \"$opacity\""
1899	}
1900	} else {
1901	error "bad option \"$option\""
1902	}
1903	set _settings($this-opacity) $opacity
1904	set transparency [expr 1.0 - $opacity]
1905	set models [array names _active]
1906	if { [llength $models] == 0 } {
1907	SendCmd "transparency -model all $transparency"
1908	return
1909	}
1910	set overridetransparency 0.60
1911	SendCmd "transparency -model all $overridetransparency"
1912	foreach model $models {
1913	SendCmd "transparency -model $model $transparency"
1914	}
1915	}
1916
1917	# ----------------------------------------------------------------------
1918	# USAGE: labels on\|off\|toggle
1919	# USAGE: labels update
1920	#
1921	# Used internally to turn labels associated with atoms on/off, and to
1922	# update the positions of the labels so they sit on top of each atom.
1923	# ----------------------------------------------------------------------
1924	itcl::body Rappture::MolvisViewer::labels {option {models "all"}} {
1925	set showlabels $_settings($this-showlabels)
1926	if { $option == "update" } {
1927	set showlabels $_settings($this-showlabels)
1928	} elseif { [string is boolean $option] } {
1929	set showlabels $option
1930	} else {
1931	error "bad option \"$option\""
1932	}
1933	# Clear the image cache
1934	array unset _imagecache
1935	set _settings($this-showlabels) $showlabels
1936	if { $models == "all" } {
1937	SendCmd "label -model all $showlabels"
1938	return
1939	}
1940	SendCmd "label -model all off"
1941	if { $showlabels } {
1942	foreach model $models {
1943	if { [info exists _active($model)] } {
1944	SendCmd "label -model $model $showlabels"
1945	}
1946	}
1947	}
1948	}
1949
1950	# ----------------------------------------------------------------------
1951	# USAGE: CartoonTrace on\|off\|toggle
1952	# USAGE: CartoonTrace update
1953	#
1954	# Used internally to turn labels associated with atoms on/off, and to
1955	# update the positions of the labels so they sit on top of each atom.
1956	# ----------------------------------------------------------------------
1957	itcl::body Rappture::MolvisViewer::CartoonTrace {option {models "all"}} {
1958	array unset _imagecache
1959	set trace $_settings($this-cartoontrace)
1960	if { $option == "update" } {
1961	set trace $_settings($this-cartoontrace)
1962	} elseif { [string is boolean $option] } {
1963	set trace $option
1964	} else {
1965	error "bad option \"$option\""
1966	}
1967	set _settings($this-cartoontrace) $trace
1968	if { $models == "all" } {
1969	SendCmd "cartoontrace -model all $trace"
1970	return
1971	}
1972	SendCmd "cartoontrace -model all off"
1973	if { $trace } {
1974	foreach model $models {
1975	if { [info exists _active($model)] } {
1976	SendCmd "cartoontrace -model $model $trace"
1977	}
1978	}
1979	}
1980	}
1981
1982	itcl::body Rappture::MolvisViewer::AddImageControls { inner widget } {
1983	label $inner.size_l -text "Size:" -font "Arial 9"
1984	set _downloadPopup(image_controls) $inner
1985	set img $_image(plot)
1986	set res "[image width $img]x[image height $img]"
1987	Rappture::Combobox $inner.size -width 30 -editable no
1988	$inner.size choices insert end \
1989	"draft" "Draft (400x400)" \
1990	"standard" "Standard (1200x1200)" \
1991	"highquality" "High Quality (2400x2400)"
1992
1993	label $inner.bgcolor_l -text "Background:" -font "Arial 9"
1994	Rappture::Combobox $inner.bgcolor -width 30 -editable no
1995	$inner.bgcolor choices insert end \
1996	"black" "Black" \
1997	"white" "White" \
1998	"none" "Transparent (PNG only)"
1999
2000	label $inner.format_l -text "Format:" -font "Arial 9"
2001	Rappture::Combobox $inner.format -width 30 -editable no
2002	$inner.format choices insert end \
2003	"png" "PNG (Portable Network Graphics format)" \
2004	"jpg" "JPEG (Joint Photographic Experts Group format)" \
2005	"gif" "GIF (GIF Graphics Interchange Format)"
2006
2007	set f [frame $inner.frame]
2008	button $f.ok -text "Save" \
2009	-highlightthickness 0 -pady 3 -padx 3 \
2010	-command [itcl::code $this SetWaitVariable 1] \
2011	-compound left \
2012	-image [Rappture::icon download
2013	]
2014	button $f.cancel -text "Cancel" \
2015	-highlightthickness 0 -pady 3 -padx 3 \
2016	-command [itcl::code $this SetWaitVariable 0] \
2017	-compound left \
2018	-image [Rappture::icon cancel]
2019	blt::table $f \
2020	0,0 $f.ok \
2021	0,1 $f.cancel
2022
2023	blt::table $inner \
2024	0,0 $inner.format_l -anchor e \
2025	0,1 $inner.format -anchor w -fill x \
2026	1,0 $inner.size_l -anchor e \
2027	1,1 $inner.size -anchor w -fill x \
2028	2,0 $inner.bgcolor_l -anchor e \
2029	2,1 $inner.bgcolor -anchor w -fill x \
2030	3,0 $f -cspan 2 -fill x
2031	blt::table configure $inner r0 r1 r2 r3 -pady { 4 0 }
2032	blt::table configure $inner r3 -pady { 4 4 }
2033	$inner.bgcolor value "Black"
2034	$inner.size value "Draft (400x400)"
2035	$inner.format value "PNG (Portable Network Graphics format)"
2036	}
2037
2038	itcl::body Rappture::MolvisViewer::snap { w h } {
2039	if { $w <= 0 \|\| $h <= 0 } {
2040	set w [image width $_image(plot)]
2041	set h [image height $_image(plot)]
2042	}
2043	set tag "$_state(client),$_rocker(client)"
2044	if { $_image(id) != "$tag" } {
2045	while { ![info exists _imagecache($tag)] } {
2046	update idletasks
2047	update
2048	after 100
2049	}
2050	if { [info exists _imagecache($tag)] } {
2051	$_image(plot) configure -data $_imagecache($tag)
2052	set _image(id) "$tag"
2053	}
2054	}
2055	set img [image create picture -width $w -height $h]
2056	$img resample $_image(plot)
2057	return $img
2058	}
2059
2060	# FIXME: Handle 2D vectors
2061	itcl::body Rappture::MolvisViewer::ComputeParallelepipedVertices { dataobj } {
2062	# Create a vector for every 3D point
2063	blt::vector point0(3) point1(3) point2(3) point3(3) point4(3) point5(3) \
2064	point6(3) point7(3) origin(3) scale(3)
2065
2066	set count 0
2067	set parent [$dataobj element -as object "components.parallelepiped"]
2068	foreach child [$parent children] {
2069	if { ![string match "vector*" $child] } {
2070	continue
2071	}
2072	incr count
2073	set values [$parent get $child]
2074	regexp -all {,} $values { } values
2075	point$count set $values
2076	}
2077	itcl::delete object $parent
2078	if { $count < 1 \|\| $count > 3 } {
2079	error "bad number of vectors supplied to parallelepiped"
2080	}
2081	point0 set { 0.0 0.0 0.0 }
2082	point4 expr {point2 + point1}
2083	point5 expr {point4 + point3}
2084	point6 expr {point2 + point3}
2085	point7 expr {point1 + point3}
2086
2087	set values [$dataobj get components.parallelepiped.scale]
2088	set n [llength $values]
2089	scale set { 1.0 1.0 1.0 }
2090	if { $n == 1 } {
2091	set scale(0:2) [lindex $values 0]
2092	} elseif { $n == 2 } {
2093	set scale(0:1) [lindex $values 0]
2094	} elseif { $n == 3 } {
2095	scale set $values
2096	}
2097	set values [$dataobj get components.parallelepiped.origin]
2098	set n [llength $values]
2099	origin set { 0.0 0.0 0.0 }
2100	if { $n == 1 } {
2101	set origin(0) [lindex $values 0]
2102	} elseif { $n == 2 } {
2103	set origin(0) [lindex $values 0]
2104	set origin(1) [lindex $values 1]
2105	} elseif { $n == 3 } {
2106	origin set $values
2107	}
2108
2109	# Scale and translate points
2110	for { set i 0 } { $i < 8 } { incr i } {
2111	point${i} expr "(point${i} * scale) + origin"
2112	}
2113
2114	# Generate vertices as a string for PyMOL
2115	set vertices ""
2116	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 } {
2117	set values [point${n} range 0 end]
2118	append vertices "\[ [join $values {, }] \], \\\n"
2119	}
2120	set values [point6 range 0 end]
2121	append vertices "\[ [join $values {, }] \] \\\n"
2122	blt::vector destroy point0 point1 point2 point3 point4 point5 point6 \
2123	point7 origin scale
2124	return $vertices
2125	}
2126
2127
2128	# ----------------------------------------------------------------------
2129	# OPTION: -device
2130	# ----------------------------------------------------------------------
2131	itcl::configbody Rappture::MolvisViewer::device {
2132	if {$itk_option(-device) != "" } {
2133	if {![Rappture::library isvalid $itk_option(-device)]} {
2134	error "bad value \"$itk_option(-device)\": should be Rappture::library object"
2135	}
2136	$this delete
2137	$this add $itk_option(-device)
2138	} else {
2139	$this delete
2140	}
2141
2142	if { [isconnected] } {
2143	$_dispatcher event -idle !rebuild
2144	}
2145	}
2146

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

Download in other formats: