source: trunk/gui/scripts/visviewer.tcl @ 5725

Last change on this file since 5725 was 5725, checked in by ldelgass, 9 years ago

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