Context Navigation

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

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

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

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

Download in other formats: