source: branches/blt4_trunk/gui/scripts/visviewer.tcl @ 6497

Last change on this file since 6497 was 6497, checked in by dkearney, 8 years ago

merging r6420 - r6496 from trunk to blt4-trunk branch
File size: 40.0 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  VisViewer -
4#
5#  This class is the base class for the various visualization viewers
6#  that use the nanoserver render farm.
7#
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15
16itcl::class ::Rappture::VisViewer {
17    inherit itk::Widget
18
19    itk_option define -sendcommand sendCommand SendCommand ""
20    itk_option define -receivecommand receiveCommand ReceiveCommand ""
21
22    constructor { args } {
23        # defined below
24    }
25    destructor {
26        # defined below
27    }
28    public proc GetServerList { type } {
29        return $_servers($type)
30    }
31    public proc SetServerList { type namelist } {
32        # Convert the comma separated list into a Tcl list.  OGRE also adds
33        # a trailing comma that we want to ignore.
34        regsub -all "," $namelist " " namelist
35        CheckNameList $namelist
36        set _servers($type) $namelist
37    }
38    public proc RemoveServerFromList { type server } {
39        if { ![info exists _servers($type)] } {
40            error "unknown server type \"$type\""
41        }
42        set i [lsearch $_servers($type) $server]
43        if { $i < 0 } {
44            return
45        }
46        set _servers($type) [lreplace $_servers($type) $i $i]
47    }
48    public proc SetPymolServerList { namelist } {
49        SetServerList "pymol" $namelist
50    }
51    public proc SetNanovisServerList { namelist } {
52        SetServerList "nanovis" $namelist
53    }
54    public proc SetVtkServerList { namelist } {
55        SetServerList "vtk" $namelist
56    }
57
58    protected method CheckConnection {}
59    protected method Color2RGB { color }
60    protected method ColorsToColormap { colors }
61    protected method Connect { servers }
62    protected method DebugOff {} {
63        set _debug 0
64    }
65    protected method DebugOn {} {
66        set _debug 1
67    }
68    protected method DebugTrace { args } {
69        if { $_debug } {
70            puts stderr "[info level -1]: $args"
71        }
72    }
73    protected method DisableWaitDialog {}
74    protected method Disconnect {}
75    protected method EnableWaitDialog { timeout }
76    protected method Euler2XYZ { theta phi psi }
77    protected method Flush {}
78    protected method GetColormapList { args }
79    protected method HandleError { args }
80    protected method HandleOk { args }
81    protected method IsConnected {}
82    protected method ReceiveBytes { nbytes }
83    protected method ReceiveEcho { channel {data ""} }
84    protected method SendBytes { bytes }
85    protected method SendCmd { string }
86    protected method SendData { bytes }
87    protected method SendEcho { channel {data ""} }
88    protected method StartBufferingCommands {}
89    protected method StartWaiting {}
90    protected method StopBufferingCommands {}
91    protected method StopWaiting {}
92    protected method ToggleConsole {}
93
94    protected variable _debug 0
95    protected variable _serverType "???";# Type of server.
96    protected variable _sid "";         # socket connection to server
97    protected variable _maxConnects 100
98    protected variable _buffering 0
99    protected variable _cmdSeq 0;       # Command sequence number
100    protected variable _dispatcher "";  # dispatcher for !events
101    protected variable _hosts "";       # list of hosts for server
102    protected variable _parser "";      # interpreter for incoming commands
103    protected variable _image
104    protected variable _hostname
105    protected variable _numConnectTries 0
106    protected variable _debugConsole 0
107    protected variable _reportClientInfo 1
108    # Number of milliscends to wait for server reply before displaying wait
109    # dialog.  If set to 0, dialog is never displayed.
110    protected variable _waitTimeout 0
111
112    private method BuildConsole {}
113    private method DebugConsole {}
114    private method HideConsole {}
115    private method ReceiveHelper {}
116    private method SendDebugCommand {}
117    private method SendHelper {}
118    private method ServerDown {}
119    private method Shuffle { servers }
120    private method TraceComm { channel {data {}} }
121    private method WaitDialog { state }
122    private method Waiting { option widget }
123
124    private proc CheckNameList { namelist }  {
125        foreach host $namelist {
126            set pattern {^[a-zA-Z0-9\.]+:[0-9]}
127            if { ![regexp $pattern $host match] } {
128                error "bad visualization server address \"$host\": should be host:port,host:port,..."
129            }
130        }
131    }
132
133    private variable _buffer;           # buffer for incoming/outgoing commands
134    private variable _outbuf;           # buffer for outgoing commands
135    private variable _blockOnWrite 0;   # Should writes to socket block?
136    private variable _initialized
137    private variable _isOpen 0
138    private variable _afterId -1
139    private variable _icon 0
140    private variable _trace 0;          # Protocol tracing for console
141    private variable _logging 0;        # Command logging to file
142    private variable _console;          # Debug console window path
143    # Number of milliseconds to wait before idle timeout.  If greater than 0,
144    # automatically disconnect from the visualization server when idle timeout
145    # is reached.
146    private variable _idleTimeout 43200000; # 12 hours
147    #private variable _idleTimeout 5000;# 5 seconds
148    #private variable _idleTimeout 0;   # No timeout
149
150    private common _servers;            # array of visualization server lists
151    set _servers(geovis)  "localhost:2015"
152    set _servers(nanovis) "localhost:2000"
153    set _servers(pymol)   "localhost:2020"
154    set _servers(vmdmds)  "localhost:2018"
155    set _servers(vtkvis)  "localhost:2010"
156    private common _done;               # Used to indicate status of send.
157    private common _consoleCnt 0;
158}
159
160itk::usual Panedwindow {
161    keep -background -cursor
162}
163
164# ----------------------------------------------------------------------
165# CONSTRUCTOR
166# ----------------------------------------------------------------------
167itcl::body Rappture::VisViewer::constructor { args } {
168
169    Rappture::dispatcher _dispatcher
170    $_dispatcher register !serverDown
171    $_dispatcher dispatch $this !serverDown "[itcl::code $this ServerDown]; list"
172    $_dispatcher register !timeout
173    $_dispatcher dispatch $this !timeout "[itcl::code $this Disconnect]; list"
174
175    $_dispatcher register !waiting
176
177    set _buffer(in) ""
178    set _buffer(out) ""
179    #
180    # Create a parser to handle incoming requests
181    #
182    set _parser [interp create -safe]
183    foreach cmd [$_parser eval {info commands}] {
184        $_parser hide $cmd
185    }
186    # Add default handlers for "ok" acknowledgement and server errors.
187    $_parser alias ok       [itcl::code $this HandleOk]
188    $_parser alias viserror [itcl::code $this HandleError]
189
190    #
191    # Set up the widgets in the main body
192    #
193    option add hull.width hull.height
194    pack propagate $itk_component(hull) no
195
196    itk_component add main {
197        Rappture::SidebarFrame $itk_interior.main -resizeframe 1
198    }
199    pack $itk_component(main) -expand yes -fill both
200    set f [$itk_component(main) component frame]
201
202    itk_component add plotarea {
203        frame $f.plotarea -highlightthickness 0 -background black
204    } {
205        ignore -background
206    }
207    pack $itk_component(plotarea) -fill both -expand yes
208    set _image(plot) [image create photo]
209
210    global env
211    if { [info exists env(VISRECORDER)] } {
212        set _logging 1
213        if { [file exists /tmp/recording.log] } {
214            file delete /tmp/recording.log
215        }
216    }
217    if { [info exists env(VISTRACE)] } {
218        set _trace 1
219    }
220    incr _consoleCnt
221    set _console ".renderconsole$_consoleCnt"
222
223    eval itk_initialize $args
224}
225
226#
227# destructor --
228#
229itcl::body Rappture::VisViewer::destructor {} {
230    $_dispatcher cancel !timeout
231    interp delete $_parser
232    array unset _done $this
233    if {[winfo exists $_console]} {
234        destroy $_console
235    }
236}
237
238#
239# Shuffle --
240#
241#   Shuffle the list of server hosts.
242#
243itcl::body Rappture::VisViewer::Shuffle { hosts } {
244    set randomHosts {}
245    set ticks [clock clicks]
246    expr {srand($ticks)}
247    for { set i [llength $hosts] } { $i > 0 } { incr i -1 } {
248        set index [expr {round(rand()*$i - 0.5)}]
249        if { $index == $i } {
250            set index [expr $i - 1]
251        }
252        lappend randomHosts [lindex $hosts $index]
253        set hosts [lreplace $hosts $index $index]
254    }
255    return $randomHosts
256}
257
258#
259# ServerDown --
260#
261#    Used internally to let the user know when the connection to the
262#    visualization server has been lost.  Puts up a tip encouraging the
263#    user to press any control to reconnect.
264#
265itcl::body Rappture::VisViewer::ServerDown {} {
266    if { [info exists itk_component(plotarea)] } {
267        set x [expr {[winfo rootx $itk_component(plotarea)]+10}]
268        set y [expr {[winfo rooty $itk_component(plotarea)]+10}]
269    } else {
270        set x 0; set y 0
271    }
272    Rappture::Tooltip::cue @$x,$y "Lost connection to visualization server.  This happens sometimes when there are too many users and the system runs out of memory.\n\nTo reconnect, reset the view or press any other control.  Your picture should come right back up."
273}
274
275#
276# Connect --
277#
278#    Connect to the visualization server (e.g. nanovis, pymolproxy).
279#    Creates an event callback that is triggered when we are idle
280#    (no I/O with the server) for some specified time.
281#
282itcl::body Rappture::VisViewer::Connect { servers } {
283    blt::busy hold $itk_component(hull) -cursor watch
284
285    if { $_numConnectTries > $_maxConnects } {
286        blt::busy release $itk_component(hull)
287        set x [expr {[winfo rootx $itk_component(hull)]+10}]
288        set y [expr {[winfo rooty $itk_component(hull)]+10}]
289        Rappture::Tooltip::cue @$x,$y "Exceeded maximum number of connection attmepts to any $_serverType visualization server. Please contact support."
290        return 0;
291    }
292    foreach server [Shuffle $servers] {
293        puts stderr "connecting to $server..."
294        foreach {hostname port} [split $server ":"] break
295        if { [catch {socket $hostname $port} _sid] != 0 } {
296            set _sid ""
297            RemoveServerFromList $_serverType $server
298            continue
299        }
300        incr _numConnectTries
301        set _hostname $server
302        fconfigure $_sid -translation binary -encoding binary
303
304        # Read back the server identification string.
305        if { [gets $_sid data] <= 0 } {
306            set _sid ""
307            puts stderr "ERORR reading from server data=($data)"
308            RemoveServerFromList $_serverType $server
309            continue
310        }
311        puts stderr "Render server is $data"
312        # We're connected. Cancel any pending serverDown events and
313        # release the busy window over the hull.
314        $_dispatcher cancel !serverDown
315        if { $_idleTimeout > 0 } {
316            $_dispatcher event -after $_idleTimeout !timeout
317        }
318        blt::busy release $itk_component(hull)
319        fconfigure $_sid -buffering line
320        fileevent $_sid readable [itcl::code $this ReceiveHelper]
321        return 1
322    }
323    blt::busy release $itk_component(hull)
324    set x [expr {[winfo rootx $itk_component(hull)]+10}]
325    set y [expr {[winfo rooty $itk_component(hull)]+10}]
326    Rappture::Tooltip::cue @$x,$y "Can't connect to any $_serverType visualization server.  This may be a network problem.  Wait a few moments and try resetting the view."
327    return 0
328}
329
330#
331# Disconnect --
332#
333#    Clients use this method to disconnect from the current rendering
334#    server.  Cancel any pending idle timeout events.
335#
336itcl::body Rappture::VisViewer::Disconnect {} {
337    after cancel $_afterId
338    $_dispatcher cancel !timeout
339    catch {close $_sid}
340    set _sid ""
341    set _buffer(in) ""
342    set _buffer(out) ""
343    set _outbuf ""
344    set _cmdSeq 0
345}
346
347#
348# IsConnected --
349#
350#    Indicates if we are currently connected to a server.
351#
352itcl::body Rappture::VisViewer::IsConnected {} {
353    if { $_sid == "" } {
354        return 0
355    }
356    if { [eof $_sid] } {
357        set _sid ""
358        return 0
359    }
360    return 1
361}
362
363#
364# CheckConection --
365#
366#   This routine is called whenever we're about to send/receive data on
367#   the socket connection to the visualization server.  If we're connected,
368#   then reset the timeout event.  Otherwise try to reconnect to the
369#   visualization server.
370#
371itcl::body Rappture::VisViewer::CheckConnection {} {
372    $_dispatcher cancel !timeout
373    if { $_idleTimeout > 0 } {
374        $_dispatcher event -after $_idleTimeout !timeout
375    }
376    if { [IsConnected] } {
377        return 1
378    }
379    if { $_sid != "" } {
380        fileevent $_sid writable ""
381    }
382    # If we aren't connected, assume it's because the connection to the
383    # visualization server broke. Try to open a connection and trigger a
384    # rebuild.
385    $_dispatcher cancel !serverDown
386    set x [expr {[winfo rootx $itk_component(plotarea)]+10}]
387    set y [expr {[winfo rooty $itk_component(plotarea)]+10}]
388    Rappture::Tooltip::cue @$x,$y "Connecting..."
389    set code [catch { Connect } ok]
390    if { $code == 0 && $ok} {
391        $_dispatcher event -idle !rebuild
392        Rappture::Tooltip::cue hide
393    } else {
394        Rappture::Tooltip::cue @$x,$y "Can't connect to any $_serverType visualization server.  This may be a network problem.  Wait a few moments and try resetting the view."
395        return 0
396    }
397    return 1
398}
399
400#
401# Flush --
402#
403#    Flushes the socket.
404#
405itcl::body Rappture::VisViewer::Flush {} {
406    if { [CheckConnection] } {
407        flush $_sid
408    }
409}
410
411
412#
413# SendHelper --
414#
415#   Helper routine called from a file event to send data when the
416#   connection is writable (i.e. not blocked).  Sets a magic variable
417#   _done($this) when we're done.
418#
419itcl::body Rappture::VisViewer::SendHelper {} {
420    if { ![CheckConnection] } {
421        return 0
422    }
423    puts -nonewline $_sid $_buffer(out)
424    flush $_sid
425    set _buffer(out) ""
426    set _done($this) 1;                 # Success
427}
428
429#
430# SendBytes --
431#
432#   Send a a string to the visualization server.
433#
434itcl::body Rappture::VisViewer::SendBytes { bytes } {
435    SendEcho >>line $bytes
436    if { ![CheckConnection] } {
437        return 0
438    }
439    StartWaiting
440    # Even though the data is sent in only 1 "puts", we need to verify that
441    # the server is ready first.  Wait for the socket to become writable
442    # before sending anything.
443    set _done($this) 1
444    if { $_debug && [string bytelength $_buffer(out)] > 0 } {
445        puts stderr "SendBytes: appending to output buffer"
446    }
447    # Append to the buffer, since we may have been called recursively
448    append _buffer(out) $bytes
449    # There's problem when the user is interacting with the GUI at the
450    # same time we're trying to write to the server.  Don't want to
451    # block because, the GUI will look like it's dead.  We can start
452    # by putting a busy window over plot so that inadvertent things like
453    # mouse movements aren't received.
454    if {$_blockOnWrite} {
455        # Allow a write to block.  In this case we won't re-enter SendBytes.
456        SendHelper
457    } else {
458        # NOTE: This can cause us to re-enter SendBytes during the tkwait.
459        # For this reason, we append to the buffer in the code above.
460        if { [info exists itk_component(main)] } {
461            blt::busy hold $itk_component(main) -cursor ""
462        }
463        fileevent $_sid writable [itcl::code $this SendHelper]
464        tkwait variable ::Rappture::VisViewer::_done($this)
465        if { [info exists itk_component(main)] } {
466            blt::busy release $itk_component(main)
467        }
468    }
469    set _buffer(out) ""
470    if { [IsConnected] } {
471        # The connection may have closed while we were writing to the server.
472        # This can happen if what we sent the server caused it to barf.
473        fileevent $_sid writable ""
474        flush $_sid
475    }
476    return $_done($this)
477}
478
479#
480# StartWaiting --
481#
482#    Display a waiting dialog after a timeout has passed
483#
484itcl::body Rappture::VisViewer::StartWaiting {} {
485    if { $_waitTimeout > 0 } {
486        after cancel $_afterId
487        set _afterId [after $_waitTimeout [itcl::code $this WaitDialog on]]
488    }
489}
490
491#
492# StopWaiting --
493#
494#    Take down waiting dialog
495#
496itcl::body Rappture::VisViewer::StopWaiting {} {
497    if { $_waitTimeout > 0 } {
498        WaitDialog off
499    }
500}
501
502itcl::body Rappture::VisViewer::EnableWaitDialog { value } {
503    set _waitTimeout $value
504}
505
506itcl::body Rappture::VisViewer::DisableWaitDialog {} {
507    set _waitTimeout 0
508}
509
510#
511# ReceiveBytes --
512#
513#    Read some number of bytes from the visualization server.
514#
515itcl::body Rappture::VisViewer::ReceiveBytes { size } {
516    if { ![CheckConnection] } {
517        return 0
518    }
519    set bytes [read $_sid $size]
520    ReceiveEcho <<line "<read $size bytes"
521    StopWaiting
522    return $bytes
523}
524
525#
526# ReceiveHelper --
527#
528#   Helper routine called from a file event when the connection is readable
529#   (i.e. a command response has been sent by the rendering server.  Reads
530#   the incoming command and executes it in a safe interpreter to handle the
531#   action.
532#
533#       Note: This routine currently only handles command responses from
534#         the visualization server.  It doesn't handle non-blocking
535#         reads from the visualization server.
536#
537#       nv>image -bytes 100000      yes
538#       ...following 100000 bytes...    no
539#
540#   Note: All commands from the render server are on one line.
541#         This is because the render server can send anything
542#         as an error message (restricted again to one line).
543#
544itcl::body Rappture::VisViewer::ReceiveHelper {} {
545    if { ![CheckConnection] } {
546        return 0
547    }
548    set n [gets $_sid line]
549
550    if { $n < 0 } {
551        Disconnect
552        return 0
553    }
554    set line [string trim $line]
555    if { $line == "" } {
556        return
557    }
558    if { [string compare -length 3 $line "nv>"] == 0 } {
559        ReceiveEcho <<line $line
560        if ($_trace) {
561            puts stderr "<<[string range $line 0 70]"
562        }
563        append _buffer(in) [string range $line 3 end]
564        append _buffer(in) "\n"
565        if {[info complete $_buffer(in)]} {
566            set request $_buffer(in)
567            set _buffer(in) ""
568            if { [catch {$_parser eval $request} err]  != 0 } {
569                global errorInfo
570                puts stderr "err=$err errorInfo=$errorInfo"
571            }
572        }
573    } elseif { [string compare -length 21 $line "NanoVis Server Error:"] == 0 ||
574               [string compare -length 20 $line "VtkVis Server Error:"] == 0} {
575        # this shows errors coming back from the engine
576        ReceiveEcho <<error $line
577        puts stderr "Render Server Error: $line\n"
578    } else {
579        # this shows errors coming back from the engine
580        ReceiveEcho <<error $line
581        puts stderr "Garbled message: $line\n"
582    }
583}
584
585#
586# Color2RGB --
587#
588#   Converts a color name to a list of r,g,b values needed for the engine.
589#   Each r/g/b component is scaled in the # range 0-1.
590#
591itcl::body Rappture::VisViewer::Color2RGB {color} {
592    foreach {r g b} [winfo rgb $itk_component(hull) $color] break
593    set r [expr {$r/65535.0}]
594    set g [expr {$g/65535.0}]
595    set b [expr {$b/65535.0}]
596    return [list $r $g $b]
597}
598
599#
600# Euler2XYZ --
601#
602#   Converts euler angles for the camera placement the to angles of
603#   rotation about the x/y/z axes, used by the engine.  Returns a list:
604#   {xangle, yangle, zangle}.
605#
606itcl::body Rappture::VisViewer::Euler2XYZ {theta phi psi} {
607    set xangle [expr {$theta-90.0}]
608    set yangle [expr {180.0-$phi}]
609    set zangle $psi
610    return [list $xangle $yangle $zangle]
611}
612
613#
614# SendEcho --
615#
616#     Used internally to echo sent data to clients interested in this widget.
617#     If the -sendcommand option is set, then it is invoked in the global scope
618#     with the <channel> and <data> values as arguments.  Otherwise, this does
619#     nothing.
620#
621itcl::body Rappture::VisViewer::SendEcho {channel {data ""}} {
622    if { $_logging }  {
623        set f [open "/tmp/recording.log" "a"]
624        fconfigure $f -translation binary -encoding binary
625        puts -nonewline $f $data
626        close $f
627    }
628    #puts stderr ">>($data)"
629    if {[string length $itk_option(-sendcommand)] > 0} {
630        uplevel #0 $itk_option(-sendcommand) [list $channel $data]
631    }
632}
633
634#
635# ReceiveEcho --
636#
637#     Echoes received data to clients interested in this widget.  If the
638#     -receivecommand option is set, then it is invoked in the global scope
639#     with the <channel> and <data> values as arguments.  Otherwise, this
640#     does nothing.
641#
642itcl::body Rappture::VisViewer::ReceiveEcho {channel {data ""}} {
643    #puts stderr "<<line $data"
644    if {[string length $itk_option(-receivecommand)] > 0} {
645        uplevel #0 $itk_option(-receivecommand) [list $channel $data]
646    }
647}
648
649itcl::body Rappture::VisViewer::WaitDialog { state } {
650    after cancel $_afterId
651    set _afterId -1
652    if { $state } {
653        if { [winfo exists $itk_component(plotarea).view.splash] } {
654            return
655        }
656        set inner [frame $itk_component(plotarea).view.splash]
657        $inner configure -relief raised -bd 2
658        label $inner.text1 -text "Working...\nPlease wait." \
659            -font "Arial 10"
660        label $inner.icon
661        pack $inner -expand yes -anchor c
662        blt::table $inner \
663            0,0 $inner.text1 -anchor w \
664            0,1 $inner.icon
665        Waiting start $inner.icon
666    } else {
667        if { ![winfo exists $itk_component(plotarea).view.splash] } {
668            return
669        }
670        Waiting stop $itk_component(plotarea).view.splash
671        destroy $itk_component(plotarea).view.splash
672    }
673}
674
675itcl::body Rappture::VisViewer::Waiting { option widget } {
676    switch -- $option {
677        "start" {
678            $_dispatcher dispatch $this !waiting \
679                "[itcl::code $this Waiting "next" $widget] ; list"
680            set _icon 0
681            $widget configure -image [Rappture::icon bigroller${_icon}]
682            $_dispatcher event -after 150 !waiting
683        }
684        "next" {
685            incr _icon
686            if { $_icon >= 8 } {
687                set _icon 0
688            }
689            $widget configure -image [Rappture::icon bigroller${_icon}]
690            $_dispatcher event -after 150 !waiting
691        }
692        "stop" {
693            $_dispatcher cancel !waiting
694        }
695    }
696}
697
698#
699# HideConsole --
700#
701#    Hide the debug console by withdrawing its toplevel window.
702#
703itcl::body Rappture::VisViewer::HideConsole {} {
704    set _debugConsole 0
705    DebugConsole
706}
707
708#
709# BuildConsole --
710#
711#    Create and pack the widgets that make up the debug console: a text
712#    widget to display the communication and an entry widget to type
713#    in commands to send to the render server.
714#
715itcl::body Rappture::VisViewer::BuildConsole {} {
716    toplevel $_console
717    wm protocol $_console WM_DELETE_WINDOW [itcl::code $this HideConsole]
718    set f $_console
719    frame $f.send
720    pack $f.send -side bottom -fill x
721    label $f.send.l -text "Send:"
722    pack $f.send.l -side left
723    itk_component add command {
724        entry $f.send.e -background white
725    } {
726        ignore -background
727    }
728    pack $f.send.e -side left -expand yes -fill x
729    bind $f.send.e <Return> [itcl::code $this SendDebugCommand]
730    bind $f.send.e <KP_Enter> [itcl::code $this SendDebugCommand]
731    scrollbar $f.sb -orient vertical -command "$f.comm yview"
732    pack $f.sb -side right -fill y
733    itk_component add trace {
734        text $f.comm -wrap char -yscrollcommand "$f.sb set" -background white
735    } {
736        ignore -background
737    }
738    pack $f.comm -expand yes -fill both
739    bind $f.comm <Control-F1> [itcl::code $this ToggleConsole]
740    bind $f.comm <Enter> [list focus %W]
741    bind $f.send.e <Control-F1> [itcl::code $this ToggleConsole]
742
743    $itk_component(trace) tag configure error -foreground red \
744        -font -*-courier-medium-o-normal-*-*-120-*
745    $itk_component(trace) tag configure incoming -foreground blue
746}
747
748#
749# ToggleConsole --
750#
751#    This is used by derived classes to turn on/off debuging.  It's
752#    up the to derived class to decide how to turn on/off debugging.
753#
754itcl::body Rappture::VisViewer::ToggleConsole {} {
755    if { $_debugConsole } {
756        set _debugConsole 0
757    } else {
758        set _debugConsole 1
759    }
760    DebugConsole
761}
762
763#
764# DebugConsole --
765#
766#    Based on the value of the variable _debugConsole, turns on/off
767#    debugging. This is done by setting/unsetting a procedure that
768#    is called whenever new characters are received or sent on the
769#    socket to the render server.  Additionally, the debug console
770#    is created if necessary and hidden/shown.
771#
772itcl::body Rappture::VisViewer::DebugConsole {} {
773    if { ![winfo exists $_console] } {
774        BuildConsole
775    }
776    if { $_debugConsole } {
777        $this configure -sendcommand [itcl::code $this TraceComm]
778        $this configure -receivecommand [itcl::code $this TraceComm]
779        wm deiconify $_console
780    } else {
781        $this configure -sendcommand ""
782        $this configure -receivecommand ""
783        wm withdraw $_console
784    }
785}
786
787# ----------------------------------------------------------------------
788# USAGE: TraceComm <channel> <data>
789#
790# Invoked automatically whenever there is communication between
791# the rendering widget and the server.  Eavesdrops on the communication
792# and posts the commands in a text viewer.
793# ----------------------------------------------------------------------
794itcl::body Rappture::VisViewer::TraceComm {channel {data ""}} {
795    $itk_component(trace) configure -state normal
796    switch -- $channel {
797        closed {
798            $itk_component(trace) insert end "--CLOSED--\n" error
799        }
800        <<line {
801            $itk_component(trace) insert end $data incoming "\n" incoming
802        }
803        >>line {
804            $itk_component(trace) insert end $data outgoing "\n" outgoing
805        }
806        error {
807            $itk_component(trace) insert end $data error "\n" error
808        }
809        default {
810            $itk_component(trace) insert end "$data\n"
811        }
812    }
813    $itk_component(trace) configure -state disabled
814    $itk_component(trace) see end
815}
816
817# ----------------------------------------------------------------------
818# USAGE: SendDebugCommand
819#
820# Invoked automatically whenever the user enters a command and
821# presses <Return>.  Sends the command along to the rendering
822# widget.
823# ----------------------------------------------------------------------
824itcl::body Rappture::VisViewer::SendDebugCommand {} {
825    incr _cmdSeq
826    set cmd [$itk_component(command) get]
827    append cmd "\n"
828    if {$_trace} {
829        puts stderr "$_cmdSeq>>[string range $cmd 0 70]"
830    }
831    SendBytes $cmd
832    $itk_component(command) delete 0 end
833}
834
835#
836# HandleOk --
837#
838#       This handles the "ok" response from the server that acknowledges
839#       the reception of a server command, but does not produce an image.
840#       It may pass an argument such as "-token 9" that could be used to
841#       determine how many commands have been processed by the server.
842#
843itcl::body Rappture::VisViewer::HandleOk { args } {
844    if { $_waitTimeout > 0 } {
845        StopWaiting
846    }
847}
848
849#
850# HandleError --
851#
852#       This handles the "viserror" response from the server that reports
853#       that a client-initiated error has occurred on the server.
854#
855itcl::body Rappture::VisViewer::HandleError { args } {
856    array set info {
857        -token "???"
858        -bytes 0
859        -type "???"
860    }
861    array set info $args
862    set bytes [ReceiveBytes $info(-bytes)]
863    if { $info(-type) == "error" } {
864        set popup $itk_component(hull).error
865        if { ![winfo exists $popup] } {
866            Rappture::Balloon $popup \
867                -title "Render Server Error"
868            set inner [$popup component inner]
869            label $inner.summary -text "" -anchor w
870
871            Rappture::Scroller $inner.scrl \
872                -xscrollmode auto -yscrollmode auto
873            text $inner.scrl.text \
874                -font "Arial 9" -background white -relief sunken -bd 1 \
875                -height 5 -wrap word -width 60
876            $inner.scrl contents $inner.scrl.text
877            button $inner.ok -text "Dismiss" -command [list $popup deactivate] \
878                -font "Arial 9"
879            blt::table $inner \
880                0,0 $inner.scrl -fill both \
881                1,0 $inner.ok
882            $inner.scrl.text tag configure normal -font "Arial 9"
883            $inner.scrl.text tag configure italic -font "Arial 9 italic"
884            $inner.scrl.text tag configure bold -font "Arial 10 bold"
885            $inner.scrl.text tag configure code -font "Courier 10 bold"
886        } else {
887            $popup deactivate
888        }
889        update
890        set inner [$popup component inner]
891        $inner.scrl.text delete 0.0 end
892
893        $inner.scrl.text configure -state normal
894        $inner.scrl.text insert end "The following error was reported by the render server:\n\n" bold
895        $inner.scrl.text insert end $bytes code
896        $inner.scrl.text configure -state disabled
897        update
898        $popup activate $itk_component(hull) below
899    } else {
900        ReceiveEcho <<error $bytes
901        puts stderr "Render server error:\n$bytes"
902    }
903}
904
905itcl::body Rappture::VisViewer::GetColormapList { args } {
906    array set opts {
907        -includeDefault 0
908        -includeElementDefault 0
909        -includeNone 0
910    }
911    if {[llength $args] > 0} {
912        foreach opt $args {
913            set opts($opt) 1
914        }
915    }
916    set colormaps [list]
917    if {$opts(-includeDefault)} {
918        lappend colormaps "default" "default"
919    }
920    if {$opts(-includeElementDefault)} {
921        lappend colormaps "elementDefault" "elementDefault"
922    }
923    lappend colormaps \
924        "BCGYR"              "BCGYR"            \
925        "BGYOR"              "BGYOR"            \
926        "blue-to-brown"      "blue-to-brown"    \
927        "blue-to-orange"     "blue-to-orange"   \
928        "blue-to-grey"       "blue-to-grey"     \
929        "green-to-magenta"   "green-to-magenta" \
930        "greyscale"          "greyscale"        \
931        "nanohub"            "nanohub"          \
932        "rainbow"            "rainbow"          \
933        "spectral"           "spectral"         \
934        "ROYGB"              "ROYGB"            \
935        "RYGCB"              "RYGCB"            \
936        "white-to-blue"      "white-to-blue"    \
937        "brown-to-blue"      "brown-to-blue"    \
938        "grey-to-blue"       "grey-to-blue"     \
939        "orange-to-blue"     "orange-to-blue"
940    if {$opts(-includeNone)} {
941        lappend colormaps "none" "none"
942    }
943    return $colormaps
944}
945
946itcl::body Rappture::VisViewer::ColorsToColormap { colors } {
947    set cmap {}
948    switch -- $colors {
949        "grey-to-blue" {
950            set cmap {
951                0.0                      0.200 0.200 0.200
952                0.14285714285714285      0.400 0.400 0.400
953                0.2857142857142857       0.600 0.600 0.600
954                0.42857142857142855      0.900 0.900 0.900
955                0.5714285714285714       0.800 1.000 1.000
956                0.7142857142857143       0.600 1.000 1.000
957                0.8571428571428571       0.400 0.900 1.000
958                1.0                      0.000 0.600 0.800
959            }
960        }
961        "blue-to-grey" {
962            set cmap {
963                0.0                     0.000 0.600 0.800
964                0.14285714285714285     0.400 0.900 1.000
965                0.2857142857142857      0.600 1.000 1.000
966                0.42857142857142855     0.800 1.000 1.000
967                0.5714285714285714      0.900 0.900 0.900
968                0.7142857142857143      0.600 0.600 0.600
969                0.8571428571428571      0.400 0.400 0.400
970                1.0                     0.200 0.200 0.200
971            }
972        }
973        "white-to-blue" {
974            set cmap {
975                0.0                     0.900 1.000 1.000
976                0.1111111111111111      0.800 0.983 1.000
977                0.2222222222222222      0.700 0.950 1.000
978                0.3333333333333333      0.600 0.900 1.000
979                0.4444444444444444      0.500 0.833 1.000
980                0.5555555555555556      0.400 0.750 1.000
981                0.6666666666666666      0.300 0.650 1.000
982                0.7777777777777778      0.200 0.533 1.000
983                0.8888888888888888      0.100 0.400 1.000
984                1.0                     0.000 0.250 1.000
985            }
986        }
987        "brown-to-blue" {
988            set cmap {
989                0.0                             0.200   0.100   0.000
990                0.09090909090909091             0.400   0.187   0.000
991                0.18181818181818182             0.600   0.379   0.210
992                0.2727272727272727              0.800   0.608   0.480
993                0.36363636363636365             0.850   0.688   0.595
994                0.45454545454545453             0.950   0.855   0.808
995                0.5454545454545454              0.800   0.993   1.000
996                0.6363636363636364              0.600   0.973   1.000
997                0.7272727272727273              0.400   0.940   1.000
998                0.8181818181818182              0.200   0.893   1.000
999                0.9090909090909091              0.000   0.667   0.800
1000                1.0                             0.000   0.480   0.600
1001            }
1002        }
1003        "blue-to-brown" {
1004            set cmap {
1005                0.0                             0.000   0.480   0.600
1006                0.09090909090909091             0.000   0.667   0.800
1007                0.18181818181818182             0.200   0.893   1.000
1008                0.2727272727272727              0.400   0.940   1.000
1009                0.36363636363636365             0.600   0.973   1.000
1010                0.45454545454545453             0.800   0.993   1.000
1011                0.5454545454545454              0.950   0.855   0.808
1012                0.6363636363636364              0.850   0.688   0.595
1013                0.7272727272727273              0.800   0.608   0.480
1014                0.8181818181818182              0.600   0.379   0.210
1015                0.9090909090909091              0.400   0.187   0.000
1016                1.0                             0.200   0.100   0.000
1017            }
1018        }
1019        "blue-to-orange" {
1020            set cmap {
1021                0.0                             0.000   0.167   1.000
1022                0.09090909090909091             0.100   0.400   1.000
1023                0.18181818181818182             0.200   0.600   1.000
1024                0.2727272727272727              0.400   0.800   1.000
1025                0.36363636363636365             0.600   0.933   1.000
1026                0.45454545454545453             0.800   1.000   1.000
1027                0.5454545454545454              1.000   1.000   0.800
1028                0.6363636363636364              1.000   0.933   0.600
1029                0.7272727272727273              1.000   0.800   0.400
1030                0.8181818181818182              1.000   0.600   0.200
1031                0.9090909090909091              1.000   0.400   0.100
1032                1.0                             1.000   0.167   0.000
1033            }
1034        }
1035        "orange-to-blue" {
1036            set cmap {
1037                0.0                             1.000   0.167   0.000
1038                0.09090909090909091             1.000   0.400   0.100
1039                0.18181818181818182             1.000   0.600   0.200
1040                0.2727272727272727              1.000   0.800   0.400
1041                0.36363636363636365             1.000   0.933   0.600
1042                0.45454545454545453             1.000   1.000   0.800
1043                0.5454545454545454              0.800   1.000   1.000
1044                0.6363636363636364              0.600   0.933   1.000
1045                0.7272727272727273              0.400   0.800   1.000
1046                0.8181818181818182              0.200   0.600   1.000
1047                0.9090909090909091              0.100   0.400   1.000
1048                1.0                             0.000   0.167   1.000
1049            }
1050        }
1051        "rainbow" {
1052            set clist {
1053                "#EE82EE"
1054                "#4B0082"
1055                "blue"
1056                "#008000"
1057                "yellow"
1058                "#FFA500"
1059                "red"
1060            }
1061        }
1062        "BGYOR" {
1063            set clist {
1064                "blue"
1065                "#008000"
1066                "yellow"
1067                "#FFA500"
1068                "red"
1069            }
1070        }
1071        "ROYGB" {
1072            set clist {
1073                "red"
1074                "#FFA500"
1075                "yellow"
1076                "#008000"
1077                "blue"
1078            }
1079        }
1080        "RYGCB" {
1081            set clist {
1082                "red"
1083                "yellow"
1084                "green"
1085                "cyan"
1086                "blue"
1087            }
1088        }
1089        "BCGYR" {
1090            set clist {
1091                "blue"
1092                "cyan"
1093                "green"
1094                "yellow"
1095                "red"
1096            }
1097        }
1098        "spectral" {
1099            set cmap {
1100                0.0 0.150 0.300 1.000
1101                0.1 0.250 0.630 1.000
1102                0.2 0.450 0.850 1.000
1103                0.3 0.670 0.970 1.000
1104                0.4 0.880 1.000 1.000
1105                0.5 1.000 1.000 0.750
1106                0.6 1.000 0.880 0.600
1107                0.7 1.000 0.680 0.450
1108                0.8 0.970 0.430 0.370
1109                0.9 0.850 0.150 0.196
1110                1.0 0.650 0.000 0.130
1111            }
1112        }
1113        "green-to-magenta" {
1114            set cmap {
1115                0.0 0.000 0.316 0.000
1116                0.06666666666666667 0.000 0.526 0.000
1117                0.13333333333333333 0.000 0.737 0.000
1118                0.2 0.000 0.947 0.000
1119                0.26666666666666666 0.316 1.000 0.316
1120                0.3333333333333333 0.526 1.000 0.526
1121                0.4 0.737 1.000 0.737
1122                0.4666666666666667 1.000 1.000 1.000
1123                0.5333333333333333 1.000 0.947 1.000
1124                0.6 1.000 0.737 1.000
1125                0.6666666666666666 1.000 0.526 1.000
1126                0.7333333333333333 1.000 0.316 1.000
1127                0.8 0.947 0.000 0.947
1128                0.8666666666666667 0.737 0.000 0.737
1129                0.9333333333333333 0.526 0.000 0.526
1130                1.0 0.316 0.000 0.316
1131            }
1132        }
1133        "greyscale" {
1134            set cmap {
1135                0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0
1136            }
1137        }
1138        "nanohub" {
1139            set clist "white yellow green cyan blue magenta"
1140        }
1141        default {
1142            set clist [split $colors ":"]
1143        }
1144    }
1145    if {$cmap == ""} {
1146        if { [llength $clist] == 1 } {
1147            set rgb [Color2RGB $clist]
1148            append cmap "0.0 $rgb 1.0 $rgb"
1149        } else {
1150            for {set i 0} {$i < [llength $clist]} {incr i} {
1151                set x [expr {double($i)/([llength $clist]-1)}]
1152                set color [lindex $clist $i]
1153                append cmap "$x [Color2RGB $color] "
1154            }
1155        }
1156    } else {
1157        regsub -all "\[ \t\r\n\]+" [string trim $cmap] " " cmap
1158    }
1159    return $cmap
1160}
1161
1162
1163#
1164# StartBufferingCommands --
1165#
1166itcl::body Rappture::VisViewer::StartBufferingCommands { } {
1167    incr _buffering
1168    if { $_buffering == 1 } {
1169        set _outbuf ""
1170    }
1171}
1172
1173#
1174# StopBufferingCommands --
1175#
1176#       This gets called when we want to stop buffering the commands for
1177#       the server and actually send then to the server.  Note that there's
1178#       a reference count on buffering.  This is so that you can can
1179#       Start/Stop multiple times without worrying about the current state.
1180#
1181itcl::body Rappture::VisViewer::StopBufferingCommands { } {
1182    incr _buffering -1
1183    if { $_buffering == 0 && $_outbuf != "" } {
1184        SendBytes $_outbuf
1185        set _outbuf ""
1186    }
1187}
1188
1189#
1190# SendCmd
1191#
1192#       Send command off to the rendering server.  If we're currently
1193#       buffering, the command is queued to be sent later.
1194#
1195itcl::body Rappture::VisViewer::SendCmd {string} {
1196    incr _cmdSeq
1197    if {$_trace} {
1198        puts stderr "$_cmdSeq>>[string range $string 0 70]"
1199    }
1200    if { $_buffering } {
1201        append _outbuf $string "\n"
1202    } else {
1203        SendBytes "$string\n"
1204    }
1205}
1206
1207#
1208# SendData
1209#
1210#       Send data off to the rendering server.  If we're currently
1211#       buffering, the data is queued to be sent later.
1212#
1213itcl::body Rappture::VisViewer::SendData {bytes} {
1214    if {$_trace} {
1215        puts stderr "$_cmdSeq>>data payload"
1216    }
1217    if { $_buffering } {
1218        append _outbuf $bytes
1219    } else {
1220        SendBytes $bytes
1221    }
1222}
Note: See TracBrowser for help on using the repository browser.