Context Navigation

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

Last change on this file since 1536 was 1535, checked in by gah, 15 years ago

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

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

Download in other formats: