Context Navigation

source: branches/Rappture 1.2/gui/scripts/molvisviewer.tcl @ 3296

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

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

Download in other formats: