Context Navigation

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

Last change on this file since 4215 was 3844, checked in by ldelgass, 11 years ago
Sync with trunk. Branch now differs only from trunk by r3722 (branch is version 1.3, trunk is version 1.4)
File size: 73.3 KB

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

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

Download in other formats: