Context Navigation

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

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

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

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

Download in other formats: