Context Navigation

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

Last change on this file since 1631 was 1567, checked in by gah, 15 years ago

File size: 56.0 KB

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

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

Download in other formats: