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

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

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