Context Navigation

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

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

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

Download in other formats: