Context Navigation

source: branches/blt4/gui/scripts/molvisviewer.tcl @ 1650

Last change on this file since 1650 was 1650, checked in by gah, 14 years ago

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

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

Download in other formats: