Context Navigation

molvisviewer.tcl @ 6640

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

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

Context Navigation

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

Download in other formats: