Context Navigation

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

Last change on this file since 2628 was 2628, checked in by gah, 13 years ago

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

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

Download in other formats: