Context Navigation

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

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

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

Download in other formats: