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

Last change on this file since 1287 was 1287, checked in by dkearney, 16 years ago

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