Context Navigation

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

Last change on this file since 5357 was 5357, checked in by ldelgass, 10 years ago
Add flag to enable vmouse events in pymol viewer
File size: 73.8 KB

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

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

Download in other formats: