Context Navigation

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

Last change on this file since 1958 was 1958, checked in by gah, 14 years ago
add unit cell to molvisviewer
File size: 71.2 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 {models "all"} }
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	11,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	append _outbuf "loadpdb -defer follows $model $state $nBytes\n"
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	append _outbuf "loadpdb -defer follows $model $state $nBytes\n"
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	append _outbuf \
854	"loadpdb -defer follows $model $state $nBytes\n"
855	append _outbuf $data3
856	}
857	set _dataobjs($model-$state) 1
858	}
859	}
860	if { ![info exists _model($model-transparency)] } {
861	set _model($model-transparency) ""
862	}
863	if { ![info exists _model($model-rep)] } {
864	set _model($model-rep) ""
865	set _model($model-newrep) $_mrep
866	}
867	if { $_model($model-transparency) != $_dobj2transparency($dataobj) } {
868	set _model($model-newtransparency) $_dobj2transparency($dataobj)
869	}
870	if { $_dobj2transparency($dataobj) == "ghost"} {
871	array unset _active $model
872	} else {
873	set _active($model) $dataobj
874	}
875	set vector [$dataobj get components.parallelepiped.vector]
876	if { $vector != "" } {
877	set vertices [ComputeParallelepipedVertices $dataobj]
878	SendCmd "raw -defer {verts = \[$vertices\]\n}"
879	SendCmd "raw -defer {run \$PYMOL_PATH/rappture/box.py\n}"
880	SendCmd "raw -defer {draw_box(verts)\n}"
881	set _cell 1
882	}
883	}
884
885	# enable/disable models as required (0=off->off, 1=on->off, 2=off->on,
886	# 3=on->on)
887
888	foreach model [array names _mlist] {
889	if { $_mlist($model) == 1 } {
890	SendCmd "disable -defer $model"
891	set _mlist($model) 0
892	set changed 1
893	} elseif { $_mlist($model) == 2 } {
894	set _mlist($model) 1
895	SendCmd "enable -defer $model"
896	set changed 1
897	} elseif { $_mlist($model) == 3 } {
898	set _mlist($model) 1
899	}
900	if { $_mlist($model) == 1 } {
901	if { [info exists _model($model-newtransparency)] \|\|
902	[info exists _model($model-newrep)] } {
903	if { ![info exists _model($model-newrep)] } {
904	set _model($model-newrep) $_model($model-rep)
905	}
906	if { ![info exists _model($model-newtransparency)] } {
907	set _model($model-newtransparency) $_model($model-transparency)
908	}
909	set rep $_model($model-newrep)
910	set transp $_model($model-newtransparency)
911	SendCmd "representation -defer -model $model $rep"
912	if { $_model($model-newtransparency) == "ghost" } {
913	SendCmd "deactivate -defer -model $model"
914	} else {
915	SendCmd "activate -defer -model $model"
916	}
917	set changed 1
918	set _model($model-transparency) $_model($model-newtransparency)
919	set _model($model-rep) $_model($model-newrep)
920	catch {
921	unset _model($model-newtransparency)
922	unset _model($model-newrep)
923	}
924	}
925	}
926
927	}
928
929	if { $changed } {
930	array unset _imagecache
931	}
932	if { $dlist == "" } {
933	set _state(server) 1
934	set _state(client) 1
935	SendCmd "frame 1"
936	set flush 1
937	} elseif { ![info exists _imagecache($state,$_rocker(client))] } {
938	set _state(server) $state
939	set _state(client) $state
940	SendCmd "frame $state"
941	set flush 1
942	} else {
943	set _state(client) $state
944	Update
945	set flush 0
946	}
947	if { $_restore } {
948	# Set or restore viewing parameters. We do this for the first
949	# model and assume this works for everything else.
950	set w [winfo width $itk_component(3dview)]
951	set h [winfo height $itk_component(3dview)]
952	SendCmd [subst {
953	reset
954	screen $w $h
955	rotate $_view(mx) $_view(my) $_view(mz)
956	pan $_view(x) $_view(y)
957	zoom $_view(zoom)
958	}]
959	debug "rebuild: rotate $_view(mx) $_view(my) $_view(mz)"
960
961	# Default settings for all models.
962	SphereScale update
963	StickRadius update
964	labels update
965	Opacity update
966	CartoonTrace update
967	Cell update
968	OrthoProjection update
969	Representation update
970	SendCmd "raw -defer {zoom complete=1}"
971	set _restore 0
972	}
973	set tab [$itk_component(main) panel "Settings"]
974	set inner $tab.ss.frame
975	if { $_cell } {
976	$inner.cell configure -state normal
977	} else {
978	$inner.cell configure -state disabled
979	}
980	if { $flush } {
981	global readyForNextFrame
982	set readyForNextFrame 0; # Don't advance to the next frame
983	# until we get an image.
984	SendCmd "bmp"; # Flush the results.
985	}
986	set _buffering 0; # Turn off buffering.
987
988	blt::busy hold $itk_component(hull)
989
990	# Actually write the commands to the server socket.
991	# If it fails, we don't care. We're finished here.
992	SendBytes $_outbuf;
993	set _outbuf ""; # Clear the buffer.
994	blt::busy release $itk_component(hull)
995
996	debug "exiting rebuild"
997	}
998
999	itcl::body Rappture::MolvisViewer::Unmap { } {
1000	# Pause rocking loop while unmapped (saves CPU time)
1001	Rock pause
1002
1003	# Blank image, mark current image dirty
1004	# This will force reload from cache, or remain blank if cache is cleared
1005	# This prevents old image from briefly appearing when a new result is added
1006	# by result viewer
1007
1008	#$_image(plot) blank
1009	set _image(id) ""
1010	}
1011
1012	itcl::body Rappture::MolvisViewer::Map { } {
1013	if { [isconnected] } {
1014	# Resume rocking loop if it was on
1015	Rock unpause
1016	# Rebuild image if modified, or redisplay cached image if not
1017	$_dispatcher event -idle !rebuild
1018	}
1019	}
1020
1021	itcl::body Rappture::MolvisViewer::DoResize { } {
1022	SendCmd "screen $_width $_height"
1023	$_image(plot) configure -width $_width -height $_height
1024	$_image(plot) blank black
1025	# Immediately invalidate cache, defer update until mapped
1026	array unset _imagecache
1027	set _resizePending 0
1028	}
1029
1030	itcl::body Rappture::MolvisViewer::EventuallyResize { w h } {
1031	set _width $w
1032	set _height $h
1033	if { !$_resizePending } {
1034	$_dispatcher event -idle !resize
1035	set _resizePending 1
1036	}
1037	}
1038
1039	# ----------------------------------------------------------------------
1040	# USAGE: $this Pan click x y
1041	# $this Pan drag x y
1042	# $this Pan release x y
1043	#
1044	# Called automatically when the user clicks on one of the zoom
1045	# controls for this widget. Changes the zoom for the current view.
1046	# ----------------------------------------------------------------------
1047	itcl::body Rappture::MolvisViewer::Pan {option x y} {
1048	if { $option == "set" } {
1049	set dx $x
1050	set dy $y
1051	set _view(x) [expr $_view(x) + $dx]
1052	set _view(y) [expr $_view(y) + $dy]
1053	SendCmd "pan $dx $dy"
1054	return
1055	}
1056	if { ![info exists _mevent(x)] } {
1057	set option "click"
1058	}
1059	if { $option == "click" } {
1060	$itk_component(3dview) configure -cursor hand1
1061	}
1062	if { $option == "drag" \|\| $option == "release" } {
1063	set dx [expr $x - $_mevent(x)]
1064	set dy [expr $y - $_mevent(y)]
1065	set _view(x) [expr $_view(x) + $dx]
1066	set _view(y) [expr $_view(y) + $dy]
1067	SendCmd "pan $dx $dy"
1068	}
1069	set _mevent(x) $x
1070	set _mevent(y) $y
1071	if { $option == "release" } {
1072	$itk_component(3dview) configure -cursor ""
1073	}
1074	}
1075
1076	# ----------------------------------------------------------------------
1077	# USAGE: Zoom in
1078	# USAGE: Zoom out
1079	# USAGE: Zoom reset
1080	#
1081	# Called automatically when the user clicks on one of the zoom
1082	# controls for this widget. Changes the zoom for the current view.
1083	# ----------------------------------------------------------------------
1084	itcl::body Rappture::MolvisViewer::Zoom {option {factor 10}} {
1085	switch -- $option {
1086	"in" {
1087	set _view(zoom) [expr $_view(zoom) + $factor]
1088	SendCmd "zoom $factor"
1089	}
1090	"out" {
1091	set _view(zoom) [expr $_view(zoom) - $factor]
1092	SendCmd "zoom -$factor"
1093	}
1094	"reset" {
1095	set _view(zoom) 0
1096	SendCmd "reset"
1097	}
1098	}
1099	}
1100
1101	itcl::body Rappture::MolvisViewer::Update { args } {
1102	set tag "$_state(client),$_rocker(client)"
1103	if { $_image(id) != "$tag" } {
1104	if { [info exists _imagecache($tag)] } {
1105	$_image(plot) configure -data $_imagecache($tag)
1106	set _image(id) "$tag"
1107	}
1108	}
1109	}
1110
1111	# ----------------------------------------------------------------------
1112	# USAGE: Rock on\|off\|toggle
1113	# USAGE: Rock pause\|unpause\|step
1114	#
1115	# Used to control the "rocking" model for the molecule being displayed.
1116	# Clients should use only the on/off/toggle options; the rest are for
1117	# internal control of the rocking motion.
1118	# ----------------------------------------------------------------------
1119	itcl::body Rappture::MolvisViewer::Rock { option } {
1120	# cancel any pending rocks
1121	if { [info exists _rocker(afterid)] } {
1122	after cancel $_rocker(afterid)
1123	unset _rocker(afterid)
1124	}
1125	if { ![winfo viewable $itk_component(3dview)] } {
1126	return
1127	}
1128	set _rocker(on) $_settings($this-rock)
1129	if { $option == "step"} {
1130	if { $_rocker(client) >= 10 } {
1131	set _rocker(dir) -1
1132	} elseif { $_rocker(client) <= -10 } {
1133	set _rocker(dir) 1
1134	}
1135	set _rocker(client) [expr {$_rocker(client) + $_rocker(dir)}]
1136	if { ![info exists _imagecache($_state(server),$_rocker(client))] } {
1137	set _rocker(server) $_rocker(client)
1138	SendCmd "rock $_rocker(client)"
1139	}
1140	Update
1141	}
1142	if { $_rocker(on) && $option != "pause" } {
1143	set _rocker(afterid) [after 200 [itcl::code $this Rock step]]
1144	}
1145	}
1146
1147
1148	itcl::body Rappture::MolvisViewer::Vmouse2 {option b m x y} {
1149	set now [clock clicks -milliseconds]
1150	set vButton [expr $b - 1]
1151	set vModifier 0
1152	set vState 1
1153
1154	if { $m & 1 } { set vModifier [expr $vModifier \| 1 ] }
1155	if { $m & 4 } { set vModifier [expr $vModifier \| 2 ] }
1156	if { $m & 131072 } { set vModifier [expr $vModifier \| 4 ] }
1157
1158	if { $option == "click" } { set vState 0 }
1159	if { $option == "release" } { set vState 1 }
1160	if { $option == "drag" } { set vState 2 }
1161	if { $option == "move" } { set vState 3 }
1162
1163	if { $vState == 2 \|\| $vState == 3} {
1164	set diff 0
1165
1166	catch { set diff [expr $now - $_mevent(time)] }
1167	if {$diff < 75} { # 75ms between motion updates
1168	return
1169	}
1170	}
1171	SendCmd "vmouse $vButton $vModifier $vState $x $y"
1172	set _mevent(time) $now
1173	}
1174
1175	itcl::body Rappture::MolvisViewer::Vmouse {option b m x y} {
1176	set now [clock clicks -milliseconds]
1177	# cancel any pending delayed dragging events
1178	if { [info exists _mevent(afterid)] } {
1179	after cancel $_mevent(afterid)
1180	unset _mevent(afterid)
1181	}
1182
1183	if { ![info exists _mevent(x)] } {
1184	set option "click"
1185	}
1186	if { $option == "click" } {
1187	$itk_component(3dview) configure -cursor fleur
1188	}
1189	if { $option == "drag" \|\| $option == "release" } {
1190	set diff 0
1191	catch { set diff [expr $now - $_mevent(time) ] }
1192	if {$diff < 25 && $option == "drag" } { # 75ms between motion updates
1193	set _mevent(afterid) [after [expr 25 - $diff] [itcl::code $this Vmouse drag $b $m $x $y]]
1194	return
1195	}
1196	set w [winfo width $itk_component(3dview)]
1197	set h [winfo height $itk_component(3dview)]
1198	if {$w <= 0 \|\| $h <= 0} {
1199	return
1200	}
1201	set x1 [expr double($w) / 3]
1202	set x2 [expr $x1 * 2]
1203	set y1 [expr double($h) / 3]
1204	set y2 [expr $y1 * 2]
1205	set dx [expr $x - $_mevent(x)]
1206	set dy [expr $y - $_mevent(y)]
1207	set mx 0
1208	set my 0
1209	set mz 0
1210
1211	if { $_mevent(x) < $x1 } {
1212	set mz $dy
1213	} elseif { $_mevent(x) < $x2 } {
1214	set mx $dy
1215	} else {
1216	set mz [expr -$dy]
1217	}
1218
1219	if { $_mevent(y) < $y1 } {
1220	set mz [expr -$dx]
1221	} elseif { $_mevent(y) < $y2 } {
1222	set my $dx
1223	} else {
1224	set mz $dx
1225	}
1226	# Accumlate movements
1227	set _view(mx) [expr {$_view(mx) + $mx}]
1228	set _view(my) [expr {$_view(my) + $my}]
1229	set _view(mz) [expr {$_view(mz) + $mz}]
1230	SendCmd "rotate $mx $my $mz"
1231	debug "_vmmouse: rotate $_view(mx) $_view(my) $_view(mz)"
1232	}
1233	set _mevent(x) $x
1234	set _mevent(y) $y
1235	set _mevent(time) $now
1236	if { $option == "release" } {
1237	$itk_component(3dview) configure -cursor ""
1238	}
1239	}
1240
1241	# ----------------------------------------------------------------------
1242	# USAGE: Rotate click <x> <y>
1243	# USAGE: Rotate drag <x> <y>
1244	# USAGE: Rotate release <x> <y>
1245	#
1246	# Called automatically when the user clicks/drags/releases in the
1247	# plot area. Moves the plot according to the user's actions.
1248	# ----------------------------------------------------------------------
1249	itcl::body Rappture::MolvisViewer::Rotate {option x y} {
1250	set now [clock clicks -milliseconds]
1251	#update idletasks
1252	# cancel any pending delayed dragging events
1253	if { [info exists _mevent(afterid)] } {
1254	after cancel $_mevent(afterid)
1255	unset _mevent(afterid)
1256	}
1257	switch -- $option {
1258	click {
1259	$itk_component(3dview) configure -cursor fleur
1260	set _click(x) $x
1261	set _click(y) $y
1262	set _click(theta) $_view(theta)
1263	set _click(phi) $_view(phi)
1264	}
1265	drag {
1266	if {[array size _click] == 0} {
1267	Rotate click $x $y
1268	} else {
1269	set w [winfo width $itk_component(3dview)]
1270	set h [winfo height $itk_component(3dview)]
1271	if {$w <= 0 \|\| $h <= 0} {
1272	return
1273	}
1274	# set diff 0
1275	# catch { set diff [expr $now - $_mevent(time) ] }
1276	# if {$diff < 175 && $option == "drag" } { # 75ms between motion updates
1277	# set _mevent(afterid) [after [expr 175 - $diff] [itcl::code $this Rotate drag $x $y]]
1278	# return
1279	# }
1280
1281	if {[catch {
1282	# this fails sometimes for no apparent reason
1283	set dx [expr {double($x-$_click(x))/$w}]
1284	set dy [expr {double($y-$_click(y))/$h}]
1285	}]} {
1286	return
1287	}
1288
1289	#
1290	# Rotate the camera in 3D
1291	#
1292	if {$_view(psi) > 90 \|\| $_view(psi) < -90} {
1293	# when psi is flipped around, theta moves backwards
1294	set dy [expr {-$dy}]
1295	}
1296	set theta [expr {$_view(theta) - $dy*180}]
1297	while {$theta < 0} { set theta [expr {$theta+180}] }
1298	while {$theta > 180} { set theta [expr {$theta-180}] }
1299
1300	if {abs($theta) >= 30 && abs($theta) <= 160} {
1301	set phi [expr {$_view(phi) - $dx*360}]
1302	while {$phi < 0} { set phi [expr {$phi+360}] }
1303	while {$phi > 360} { set phi [expr {$phi-360}] }
1304	set psi $_view(psi)
1305	} else {
1306	set phi $_view(phi)
1307	set psi [expr {$_view(psi) - $dx*360}]
1308	while {$psi < -180} { set psi [expr {$psi+360}] }
1309	while {$psi > 180} { set psi [expr {$psi-360}] }
1310	}
1311	array set _view [subst {
1312	theta $theta
1313	phi $phi
1314	psi $psi
1315	}]
1316	foreach { vx vy vz } [Euler2XYZ $theta $phi $psi] break
1317	set a [expr $vx - $_view(vx)]
1318	set a [expr -$a]
1319	set b [expr $vy - $_view(vy)]
1320	set c [expr $vz - $_view(vz)]
1321	array set _view [subst {
1322	vx $vx
1323	vy $vy
1324	vz $vz
1325	}]
1326	SendCmd "rotate $a $b $c"
1327	debug "Rotate $x $y: rotate $_view(vx) $_view(vy) $_view(vz)"
1328	set _click(x) $x
1329	set _click(y) $y
1330	}
1331	}
1332	release {
1333	Rotate drag $x $y
1334	$itk_component(3dview) configure -cursor ""
1335	catch {unset _click}
1336	}
1337	default {
1338	error "bad option \"$option\": should be click, drag, release"
1339	}
1340	}
1341	set _mevent(time) $now
1342	}
1343
1344	# ----------------------------------------------------------------------
1345	# USAGE: Representation spheres\|ballnstick\|lines\|sticks
1346	#
1347	# Used internally to change the molecular representation used to render
1348	# our scene.
1349	# ----------------------------------------------------------------------
1350	itcl::body Rappture::MolvisViewer::Representation {option {model "all"} } {
1351	if { $option == $_mrep } {
1352	return
1353	}
1354	if { $option == "update" } {
1355	set option $_settings($this-model)
1356	}
1357	if { $option == "sticks" } {
1358	set _settings($this-modelimg) [Rappture::icon lines]
1359	} else {
1360	set _settings($this-modelimg) [Rappture::icon $option]
1361	}
1362	set tab [$itk_component(main) panel "Settings"]
1363	set inner $tab.ss.frame
1364	$inner.pict configure -image $_settings($this-modelimg)
1365
1366	# Save the current option to set all radiobuttons -- just in case.
1367	# This method gets called without the user clicking on a radiobutton.
1368	set _settings($this-model) $option
1369	set _mrep $option
1370
1371	if { $model == "all" } {
1372	set models [array names _mlist]
1373	} else {
1374	set models $model
1375	}
1376
1377	foreach model $models {
1378	if { [info exists _model($model-rep)] } {
1379	if { $_model($model-rep) != $option } {
1380	set _model($model-newrep) $option
1381	} else {
1382	catch { unset _model($model-newrep) }
1383	}
1384	}
1385	}
1386	if { [isconnected] } {
1387	SendCmd "representation -model $model $option"
1388	#$_dispatcher event -idle !rebuild
1389	}
1390	}
1391
1392
1393	# ----------------------------------------------------------------------
1394	# USAGE: OrthoProjection on\|off\|toggle
1395	# USAGE: OrthoProjection update
1396	#
1397	# Used internally to turn labels associated with atoms on/off, and to
1398	# update the positions of the labels so they sit on top of each atom.
1399	# ----------------------------------------------------------------------
1400	itcl::body Rappture::MolvisViewer::OrthoProjection {option} {
1401	switch -- $option {
1402	"orthoscopic" {
1403	set ortho 1
1404	}
1405	"perspective" {
1406	set ortho 0
1407	}
1408	"toggle" {
1409	set ortho [expr {$_settings($this-ortho) == 0}]
1410	}
1411	"update" {
1412	set ortho $_settings($this-ortho)
1413	}
1414	default {
1415	error "bad option \"$option\": should be on, off, toggle, or update"
1416	}
1417	}
1418	if { $ortho == $_settings($this-ortho) && $option != "update"} {
1419	# nothing to do
1420	return
1421	}
1422	if { $ortho } {
1423	$itk_component(ortho) configure -image [Rappture::icon molvis-3dorth]
1424	Rappture::Tooltip::for $itk_component(ortho) \
1425	"Use perspective projection"
1426	set _settings($this-ortho) 1
1427	SendCmd "orthoscopic on"
1428	} else {
1429	$itk_component(ortho) configure -image [Rappture::icon molvis-3dpers]
1430	Rappture::Tooltip::for $itk_component(ortho) \
1431	"Use orthoscopic projection"
1432	set _settings($this-ortho) 0
1433	SendCmd "orthoscopic off"
1434	}
1435	}
1436
1437	# ----------------------------------------------------------------------
1438	# USAGE: Cell on\|off\|toggle
1439	#
1440	# Used internally to turn labels associated with atoms on/off, and to
1441	# update the positions of the labels so they sit on top of each atom.
1442	# ----------------------------------------------------------------------
1443	itcl::body Rappture::MolvisViewer::Cell {option} {
1444	switch -- $option {
1445	"on" - "off" {
1446	set cell $option
1447	}
1448	"toggle" {
1449	set cell [expr {$_settings($this-showcell) == 0}]
1450	}
1451	"update" {
1452	set cell $_settings($this-showcell)
1453	}
1454	default {
1455	error "bad option \"$option\": should be on, off, toggle, or update"
1456	}
1457	}
1458	if { $cell == $_settings($this-showcell) && $option != "update"} {
1459	# nothing to do
1460	return
1461	}
1462	if { $cell } {
1463	Rappture::Tooltip::for $itk_component(ortho) \
1464	"Hide the cell."
1465	set _settings($this-showcell) 1
1466	SendCmd "raw {show everything,unitcell}"
1467	} else {
1468	Rappture::Tooltip::for $itk_component(ortho) \
1469	"Show the cell."
1470	set _settings($this-showcell) 0
1471	SendCmd "raw {hide everything,unitcell}"
1472	}
1473	}
1474
1475
1476	# ----------------------------------------------------------------------
1477	# USAGE: add <dataobj> ?<settings>?
1478	#
1479	# Clients use this to add a data object to the plot. The optional
1480	# <settings> are used to configure the plot. Allowed settings are
1481	# -color, -brightness, -width, -linestyle, and -raise. Only
1482	# -brightness and -raise do anything.
1483	# ----------------------------------------------------------------------
1484	itcl::body Rappture::MolvisViewer::add { dataobj {options ""}} {
1485	array set params {
1486	-color auto
1487	-brightness 0
1488	-width 1
1489	-raise 0
1490	-linestyle solid
1491	-description ""
1492	-param ""
1493	}
1494
1495	foreach {opt val} $options {
1496	if {![info exists params($opt)]} {
1497	error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
1498	}
1499	set params($opt) $val
1500	}
1501
1502	set pos [lsearch -exact $dataobj $_dlist]
1503
1504	if {$pos < 0} {
1505	if {![Rappture::library isvalid $dataobj]} {
1506	error "bad value \"$dataobj\": should be Rappture::library object"
1507	}
1508
1509	if { !$_settings($this-showlabels-initialized) } {
1510	set showlabels [$dataobj get components.molecule.about.emblems]
1511	if { $showlabels != "" && [string is boolean $showlabels] } {
1512	set _settings($this-showlabels) $showlabels
1513	}
1514	}
1515
1516	lappend _dlist $dataobj
1517	if { $params(-brightness) >= 0.5 } {
1518	set _dobj2transparency($dataobj) "ghost"
1519	} else {
1520	set _dobj2transparency($dataobj) "normal"
1521	}
1522	set _dobj2raise($dataobj) $params(-raise)
1523	debug "setting parameters for $dataobj\n"
1524
1525	if { [isconnected] } {
1526	$_dispatcher event -idle !rebuild
1527	}
1528	}
1529	}
1530
1531	#
1532	# ResetView
1533	#
1534	itcl::body Rappture::MolvisViewer::ResetView {} {
1535	array set _view {
1536	theta 45
1537	phi 45
1538	psi 0
1539	mx 0
1540	my 0
1541	mz 0
1542	x 0
1543	y 0
1544	z 0
1545	zoom 0
1546	width 0
1547	height 0
1548	}
1549	SendCmd "reset"
1550	SendCmd "rotate $_view(mx) $_view(my) $_view(mz)"
1551	debug "ResetView: rotate $_view(mx) $_view(my) $_view(mz)"
1552	SendCmd "pan $_view(x) $_view(y)"
1553	SendCmd "zoom $_view(zoom)"
1554	}
1555
1556	# ----------------------------------------------------------------------
1557	# USAGE: get
1558	#
1559	# Clients use this to query the list of objects being plotted, in
1560	# order from bottom to top of this result.
1561	# ----------------------------------------------------------------------
1562	itcl::body Rappture::MolvisViewer::get {} {
1563	# put the dataobj list in order according to -raise options
1564	set dlist $_dlist
1565	foreach obj $dlist {
1566	if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
1567	set i [lsearch -exact $dlist $obj]
1568	if {$i >= 0} {
1569	set dlist [lreplace $dlist $i $i]
1570	lappend dlist $obj
1571	}
1572	}
1573	}
1574	return $dlist
1575	}
1576
1577	# ----------------------------------------------------------------------
1578	# USAGE: delete ?<dataobj> <dataobj> ...?
1579	#
1580	# Clients use this to delete a dataobj from the plot. If no dataobjs
1581	# are specified, then all dataobjs are deleted.
1582	# ----------------------------------------------------------------------
1583	itcl::body Rappture::MolvisViewer::delete { args } {
1584	if {[llength $args] == 0} {
1585	set args $_dlist
1586	}
1587
1588	# delete all specified dataobjs
1589	set changed 0
1590	foreach dataobj $args {
1591	set pos [lsearch -exact $_dlist $dataobj]
1592	if {$pos >= 0} {
1593	set _dlist [lreplace $_dlist $pos $pos]
1594	if { [info exists _obj2models($dataobj)] } {
1595	foreach model $_obj2models($dataobj) {
1596	array unset _active $model
1597	}
1598	}
1599	array unset _obj2models $dataobj
1600	array unset _dobj2transparency $dataobj
1601	array unset _dobj2color $dataobj
1602	array unset _dobj2width $dataobj
1603	array unset _dobj2dashes $dataobj
1604	array unset _dobj2raise $dataobj
1605	set changed 1
1606	}
1607	}
1608
1609	# if anything changed, then rebuild the plot
1610	if {$changed} {
1611	if { [isconnected] } {
1612	$_dispatcher event -idle !rebuild
1613	}
1614	}
1615	}
1616
1617	# ----------------------------------------------------------------------
1618	# OPTION: -device
1619	# ----------------------------------------------------------------------
1620	itcl::configbody Rappture::MolvisViewer::device {
1621	if {$itk_option(-device) != "" } {
1622
1623	if {![Rappture::library isvalid $itk_option(-device)]} {
1624	error "bad value \"$itk_option(-device)\": should be Rappture::library object"
1625	}
1626	$this delete
1627	$this add $itk_option(-device)
1628	} else {
1629	$this delete
1630	}
1631
1632	if { [isconnected] } {
1633	$_dispatcher event -idle !rebuild
1634	}
1635	}
1636
1637
1638
1639	itcl::body Rappture::MolvisViewer::WaitIcon { option widget } {
1640	switch -- $option {
1641	"start" {
1642	$_dispatcher dispatch $this !waiticon \
1643	"[itcl::code $this WaitIcon "next" $widget] ; list"
1644	set _icon 0
1645	$widget configure -image [Rappture::icon bigroller${_icon}]
1646	$_dispatcher event -after 100 !waiticon
1647	}
1648	"next" {
1649	incr _icon
1650	if { $_icon >= 8 } {
1651	set _icon 0
1652	}
1653	$widget configure -image [Rappture::icon bigroller${_icon}]
1654	$_dispatcher event -after 100 !waiticon
1655	}
1656	"stop" {
1657	$_dispatcher cancel !waiticon
1658	}
1659	}
1660	}
1661
1662	itcl::body Rappture::MolvisViewer::GetImage { widget } {
1663	set token "print[incr _nextToken]"
1664	set var ::Rappture::MolvisViewer::_hardcopy($this-$token)
1665	set $var ""
1666
1667	set controls $_downloadPopup(image_controls)
1668	set combo $controls.size_combo
1669	set size [$combo translate [$combo value]]
1670	switch -- $size {
1671	"standard" {
1672	set width 1200
1673	set height 1200
1674	}
1675	"highquality" {
1676	set width 2400
1677	set height 2400
1678	}
1679	"draft" {
1680	set width 400
1681	set height 400
1682	}
1683	default {
1684	error "unknown image size [$inner.image_size_combo value]"
1685	}
1686	}
1687	# Setup an automatic timeout procedure.
1688	$_dispatcher dispatch $this !pngtimeout "set $var {} ; list"
1689
1690	set popup .molvisviewerprint
1691	if { ![winfo exists $popup] } {
1692	Rappture::Balloon $popup -title "Generating file..."
1693	set inner [$popup component inner]
1694	label $inner.title -text "Generating hardcopy." -font "Arial 10 bold"
1695	label $inner.please -text "This may take a minute." -font "Arial 10"
1696	label $inner.icon -image [Rappture::icon bigroller0]
1697	button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
1698	-command [list set $var ""]
1699	blt::table $inner \
1700	0,0 $inner.title -columnspan 2 \
1701	1,0 $inner.please -anchor w \
1702	1,1 $inner.icon -anchor e \
1703	2,0 $inner.cancel -columnspan 2
1704	blt::table configure $inner r0 -pady 4
1705	blt::table configure $inner r2 -pady 4
1706	bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
1707	} else {
1708	set inner [$popup component inner]
1709	}
1710	set combo $controls.bgcolor_combo
1711	set bgcolor [$combo translate [$combo value]]
1712
1713	$_dispatcher event -after 60000 !pngtimeout
1714	WaitIcon start $inner.icon
1715	grab set -local $inner
1716	focus $inner.cancel
1717
1718	SendCmd "print $token $width $height $bgcolor"
1719
1720	$popup activate $widget below
1721	# We wait here for either
1722	# 1) the png to be delivered or
1723	# 2) timeout or
1724	# 3) user cancels the operation.
1725	tkwait variable $var
1726
1727	# Clean up.
1728	$_dispatcher cancel !pngtimeout
1729	WaitIcon stop $inner.icon
1730	grab release $inner
1731	$popup deactivate
1732	update
1733
1734	if { $_hardcopy($this-$token) != "" } {
1735	set combo $controls.type_combo
1736	set type [$combo translate [$combo value]]
1737	switch -- $type {
1738	"jpg" {
1739	set img [image create picture -data $_hardcopy($this-$token)]
1740	$img export jpg -quality 100 -data bytes
1741	return [list .jpg $bytes]
1742	}
1743	"gif" {
1744	set img [image create picture -data $_hardcopy($this-$token)]
1745	$img export gif -data bytes
1746	return [list .gif $bytes]
1747	}
1748	"png" {
1749	return [list .png $_hardcopy($this-$token)]
1750	}
1751	}
1752	}
1753	return ""
1754	}
1755
1756	# ----------------------------------------------------------------------
1757	# USAGE: SphereScale radius ?model?
1758	# SphereScale update ?model?
1759	#
1760	# Used internally to change the molecular atom scale used to render
1761	# our scene.
1762	#
1763	# Note: Only sets the specified radius for active models. If the model
1764	# is inactive, then it overridden with the value "0.1".
1765	# ----------------------------------------------------------------------
1766
1767	itcl::body Rappture::MolvisViewer::SphereScale { option {models "all"} } {
1768	if { $option == "update" } {
1769	set radius $_settings($this-spherescale)
1770	} elseif { [string is double $option] } {
1771	set radius $option
1772	if { ($radius < 0.1) \|\| ($radius > 2.0) } {
1773	error "bad atom size \"$radius\""
1774	}
1775	} else {
1776	error "bad option \"$option\""
1777	}
1778	set _settings($this-spherescale) $radius
1779	if { $models == "all" } {
1780	SendCmd "spherescale -model all $radius"
1781	return
1782	}
1783	set overrideradius [expr $radius * 0.8]
1784	SendCmd "spherescale -model all $overrideradius"
1785	foreach model $models {
1786	if { [info exists _active($model)] } {
1787	SendCmd "spherescale -model $model $radius"
1788	}
1789	}
1790	}
1791
1792	# ----------------------------------------------------------------------
1793	# USAGE: StickRadius radius ?models?
1794	# StickRadius update ?models?
1795	#
1796	# Used internally to change the stick radius used to render
1797	# our scene.
1798	#
1799	# Note: Only sets the specified radius for active models. If the model
1800	# is inactive, then it overridden with the value "0.25".
1801	# ----------------------------------------------------------------------
1802
1803	itcl::body Rappture::MolvisViewer::StickRadius { option {models "all"} } {
1804	if { $option == "update" } {
1805	set radius $_settings($this-stickradius)
1806	} elseif { [string is double $option] } {
1807	set radius $option
1808	if { ($radius < 0.1) \|\| ($radius > 2.0) } {
1809	error "bad stick radius \"$radius\""
1810	}
1811	} else {
1812	error "bad option \"$option\""
1813	}
1814	set _settings($this-stickradius) $radius
1815	if { $models == "all" } {
1816	SendCmd "stickradius -model all $radius"
1817	return
1818	}
1819	set overrideradius [expr $radius * 0.8]
1820	SendCmd "stickradius -model all $overrideradius"
1821	foreach model $models {
1822	if { [info exists _active($model)] } {
1823	SendCmd "stickradius -model $model $radius"
1824	}
1825	}
1826	}
1827
1828	# ----------------------------------------------------------------------
1829	# USAGE: Opacity value ?models?
1830	# Opacity update ?models?
1831	#
1832	# Used internally to change the opacity (transparency) used to render
1833	# our scene.
1834	#
1835	# Note: Only sets the specified transparency for active models. If the model
1836	# is inactive, then it overridden with the value "0.75".
1837	# ----------------------------------------------------------------------
1838
1839	itcl::body Rappture::MolvisViewer::Opacity { option {models "all"} } {
1840	if { $option == "update" } {
1841	set opacity $_settings($this-opacity)
1842	} elseif { [string is double $option] } {
1843	set opacity $option
1844	if { ($opacity < 0.0) \|\| ($opacity > 1.0) } {
1845	error "bad opacity \"$opacity\""
1846	}
1847	} else {
1848	error "bad option \"$option\""
1849	}
1850	set _settings($this-opacity) $opacity
1851	set transparency [expr 1.0 - $opacity]
1852	if { $models == "all" } {
1853	SendCmd "transparency -model all $transparency"
1854	return
1855	}
1856	set overridetransparency 0.60
1857	SendCmd "transparency -model all $overridetransparency"
1858	foreach model $models {
1859	if { [info exists _active($model)] } {
1860	SendCmd "transparency -model $model $transparency"
1861	}
1862	}
1863	}
1864
1865	# ----------------------------------------------------------------------
1866	# USAGE: labels on\|off\|toggle
1867	# USAGE: labels update
1868	#
1869	# Used internally to turn labels associated with atoms on/off, and to
1870	# update the positions of the labels so they sit on top of each atom.
1871	# ----------------------------------------------------------------------
1872	itcl::body Rappture::MolvisViewer::labels {option {models "all"}} {
1873	set showlabels $_settings($this-showlabels)
1874	if { $option == "update" } {
1875	set showlabels $_settings($this-showlabels)
1876	} elseif { [string is boolean $option] } {
1877	set showlabels $option
1878	} else {
1879	error "bad option \"$option\""
1880	}
1881	set _settings($this-showlabels) $showlabels
1882	if { $models == "all" } {
1883	SendCmd "label -model all $showlabels"
1884	return
1885	}
1886	SendCmd "label -model all off"
1887	if { $showlabels } {
1888	foreach model $models {
1889	if { [info exists _active($model)] } {
1890	SendCmd "label -model $model $showlabels"
1891	}
1892	}
1893	}
1894	}
1895
1896	# ----------------------------------------------------------------------
1897	# USAGE: CartoonTrace on\|off\|toggle
1898	# USAGE: CartoonTrace update
1899	#
1900	# Used internally to turn labels associated with atoms on/off, and to
1901	# update the positions of the labels so they sit on top of each atom.
1902	# ----------------------------------------------------------------------
1903	itcl::body Rappture::MolvisViewer::CartoonTrace {option {models "all"}} {
1904	set trace $_settings($this-cartoontrace)
1905	if { $option == "update" } {
1906	set trace $_settings($this-cartoontrace)
1907	} elseif { [string is boolean $option] } {
1908	set trace $option
1909	} else {
1910	error "bad option \"$option\""
1911	}
1912	set _settings($this-cartoontrace) $trace
1913	if { $models == "all" } {
1914	SendCmd "cartoontrace -model all $trace"
1915	return
1916	}
1917	SendCmd "cartoontrace -model all off"
1918	if { $trace } {
1919	foreach model $models {
1920	if { [info exists _active($model)] } {
1921	SendCmd "cartoontrace -model $model $trace"
1922	}
1923	}
1924	}
1925	}
1926
1927	itcl::body Rappture::MolvisViewer::DownloadPopup { popup command } {
1928	Rappture::Balloon $popup \
1929	-title "[Rappture::filexfer::label downloadWord] as..."
1930	set inner [$popup component inner]
1931	label $inner.summary -text "" -anchor w -font "Arial 11 bold"
1932	radiobutton $inner.pdb_button -text "PDB Protein Data Bank Format File" \
1933	-variable [itcl::scope _downloadPopup(format)] \
1934	-command [itcl::code $this EnableDownload $popup pdb] \
1935	-font "Arial 10 " \
1936	-value pdb
1937	Rappture::Tooltip::for $inner.pdb_button \
1938	"Save as PDB Protein Data Bank format file."
1939	radiobutton $inner.image_button -text "Image File" \
1940	-variable [itcl::scope _downloadPopup(format)] \
1941	-command [itcl::code $this EnableDownload $popup image] \
1942	-font "Arial 10 " \
1943	-value image
1944	Rappture::Tooltip::for $inner.image_button \
1945	"Save as digital image."
1946
1947	set controls [frame $inner.image_frame -bd 2 -relief groove]
1948	label $controls.size_label -text "Size:" \
1949	-font "Arial 9"
1950	set img $_image(plot)
1951	set res "[image width $img]x[image height $img]"
1952	Rappture::Combobox $controls.size_combo -width 20 -editable no
1953	$controls.size_combo choices insert end \
1954	"draft" "Draft (400x400)" \
1955	"standard" "Standard (1200x1200)" \
1956	"highquality" "High Quality (2400x2400)"
1957
1958	label $controls.bgcolor_label -text "Background:" \
1959	-font "Arial 9"
1960	Rappture::Combobox $controls.bgcolor_combo -width 20 -editable no
1961	$controls.bgcolor_combo choices insert end \
1962	"black" "Black" \
1963	"white" "White" \
1964	"none" "Transparent (PNG only)"
1965
1966	label $controls.type_label -text "Type:" \
1967	-font "Arial 9"
1968	Rappture::Combobox $controls.type_combo -width 20 -editable no
1969	$controls.type_combo choices insert end \
1970	"jpg" "JPEG Joint Photographic Experts Group Format (*.jpg)" \
1971	"png" "PNG Portable Network Graphics Format (*.png)"
1972
1973	button $inner.go -text [Rappture::filexfer::label download] \
1974	-command $command
1975
1976	blt::table $controls \
1977	1,0 $controls.size_label -anchor e \
1978	1,1 $controls.size_combo -anchor w -fill x \
1979	2,0 $controls.bgcolor_label -anchor e \
1980	2,1 $controls.bgcolor_combo -anchor w -fill x \
1981	3,0 $controls.type_label -anchor e \
1982	3,1 $controls.type_combo -anchor w -fill x
1983	blt::table configure $controls r0 -height 16
1984	blt::table configure $controls -padx 4 -pady {0 6}
1985	blt::table $inner \
1986	0,0 $inner.summary -cspan 2 \
1987	1,0 $inner.pdb_button -cspan 2 -anchor w \
1988	2,0 $inner.image_button -cspan 2 -rspan 2 -anchor nw -ipadx 2 -ipady 2 \
1989	3,1 $controls -fill both \
1990	6,0 $inner.go -cspan 2 -pady 5
1991	blt::table configure $inner c0 -width 11
1992	blt::table configure $inner r2 -height 11
1993	#blt::table configure $inner c1 -width 8
1994	raise $inner.image_button
1995	$inner.pdb_button invoke
1996	$controls.bgcolor_combo value "Black"
1997	$controls.size_combo value "Draft (400x400)"
1998	$controls.type_combo value "PNG Portable Network Graphics Format (*.png)"
1999	return $inner
2000	}
2001
2002	itcl::body Rappture::MolvisViewer::EnableDownload { popup what } {
2003	set inner [$popup component inner]
2004	switch -- $what {
2005	"pdb" {
2006	foreach w [winfo children $inner.image_frame] {
2007	$w configure -state disabled
2008	}
2009	}
2010	"image" {
2011	foreach w [winfo children $inner.image_frame] {
2012	$w configure -state normal
2013	}
2014	}
2015	default {
2016	error "unknown type of download"
2017	}
2018	}
2019	}
2020
2021	itcl::body Rappture::MolvisViewer::snap { w h } {
2022	if { $w <= 0 \|\| $h <= 0 } {
2023	set w [image width $_image(plot)]
2024	set h [image height $_image(plot)]
2025	}
2026	set tag "$_state(client),$_rocker(client)"
2027	if { $_image(id) != "$tag" } {
2028	while { ![info exists _imagecache($tag)] } {
2029	update idletasks
2030	update
2031	after 100
2032	}
2033	if { [info exists _imagecache($tag)] } {
2034	$_image(plot) configure -data $_imagecache($tag)
2035	set _image(id) "$tag"
2036	}
2037	}
2038	set img [image create picture -width $w -height $h]
2039	$img resample $_image(plot)
2040	return $img
2041	}
2042
2043	# FIXME: Handle 2D vectors
2044	itcl::body Rappture::MolvisViewer::ComputeParallelepipedVertices { dataobj } {
2045	# Create a vector for every 3D point
2046	blt::vector point0(3) point1(3) point2(3) point3(3) point4(3) point5(3) \
2047	point6(3) point7(3) origin(3) scale(3)
2048
2049	set count 0
2050	set parent [$dataobj element -as object "components.parallelepiped"]
2051	foreach child [$parent children] {
2052	if { ![string match "vector*" $child] } {
2053	continue
2054	}
2055	incr count
2056	set vector [$parent get $child]
2057	regexp -all {,} $vector {} vector
2058	point$count set $vector
2059	}
2060	itcl::delete object $parent
2061	if { $count < 1 \|\| $count > 3 } {
2062	error "bad number of vectors supplied to parallelepiped"
2063	}
2064	set values [$dataobj get components.parallelepiped.scale]
2065	set n [llength $values]
2066	scale set { 1.0 1.0 1.0 }
2067	if { $n == 1 } {
2068	set scale(0:2) [lindex $values 0]
2069	} elseif { $n == 2 } {
2070	set scale(0:1) [lindex $values 0]
2071	} elseif { $n == 3 } {
2072	scale set $values
2073	}
2074	set values [$dataobj get components.parallelepiped.origin]
2075	set n [llength $values]
2076	origin set { 0.0 0.0 0.0 }
2077	if { $n == 1 } {
2078	set origin(0) [lindex $values 0]
2079	} elseif { $n == 2 } {
2080	set origin(0) [lindex $values 0]
2081	set origin(1) [lindex $values 1]
2082	} elseif { $n == 3 } {
2083	origin set $values
2084	}
2085	point0 set { 0.0 0.0 0.0 }
2086	point4 expr {point2 + point1}
2087	point5 expr {point4 + point3}
2088	point6 expr {point2 + point3}
2089	point7 expr {point1 + point3}
2090
2091	# Generate vertices as a string for PyMOL
2092	set vertices ""
2093	blt::vector x
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	x expr "(point${n} * scale) + origin"
2096	set values [x values]
2097	append vertices "\[ [join $values {, }] \], \\\n"
2098	}
2099	x expr "(point6 * scale) + origin"
2100	set values [x values]
2101	append vertices "\[ [join $values {, }] \] \\\n"
2102	blt::vector destroy point0 point1 point2 point3 point4 point5 point6 \
2103	point7 x origin scale
2104	return $vertices
2105	}

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

Download in other formats: