Context Navigation

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

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

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

Download in other formats: