Context Navigation

source: branches/blt4/gui/scripts/molvisviewer.tcl @ 2745

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

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

Download in other formats: