Context Navigation

source: branches/1.3/gui/scripts/molvisviewer.tcl @ 4670

Last change on this file since 4670 was 4670, checked in by ldelgass, 10 years ago
merge r4668:4669 from trunk
File size: 73.6 KB

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

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

Download in other formats: