Context Navigation

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

Last change on this file since 5351 was 5351, checked in by ldelgass, 9 years ago
Clean up debug prints
File size: 73.3 KB

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

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

Download in other formats: