Context Navigation

source: branches/uq/gui/scripts/molvisviewer.tcl @ 5679

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

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

Download in other formats: