Context Navigation

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

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

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

Download in other formats: