1 # atobj-rcvr.tcl --
2 #
3 # AtObjRcvr : Active Object Receiver
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31
32 #---------------------------------------------------------------------------
33 # AtObjRcvr --
34 #
35 # An active object receiver is the class that handles the
36 # active objects streams from a end host (i.e. SRM_Source).
37 # It handles the demultiplexing of streams into each active object.
38 #
39
40 Atobj_rcvr instproc new_animation {anmName} {
41 # REVIEW: figure out dynamic creation of objects with diff. types
42 set anmType Nam
43 set anmView [new AnmView/$anmType]
44 DbgOut "created anmView: $anmView"
45 set datasrc [new DataSrc/$anmType]
46 DbgOut "created datasrc: $datasrc"
47 $anmView attach_datasrc $datasrc
48 $datasrc attach_view $anmView
49 $datasrc attach_rcvr $self
50 $datasrc setAnmId $anmName
51
52 # should have font and text events....
53 $anmView setFontByIdx 0 "lucidasanstypewriter-10" Blue
54 $anmView setFontByIdx 1 \
55 "-adobe-helvetica-bold-r-normal--12-*-*-*-*-*-*-*" \
56 Brown
57
58 set host [info hostname]
59 wm title [$anmView path] "(Remote) Nam@$host"
60 $self attach_info $anmView $datasrc
61 $datasrc setup
62 return $datasrc
63 }
64
65 #
66 # REVIEW: should have a more generic UI for remote ....
67 # maybe something closer to that of NamUI....
68 #
69 Atobj_rcvr instproc attach_info {view datasrc} {
70 set p [$view path]
71 set f [frame $p.ff -relief ridge]
72 set l [button $p.f -text "time:" -relief flat \
73 -activebackground [lindex \
74 [$f configure -background] 4] \
75 -command "new StackTrace {}"]
76 set lt [label $p.lt -text "0.0"]
77 set bq [button $p.bq -text "Quit" -command exit]
78 pack $f -side bottom -fill x
79 pack $l $lt -expand false -fill x -side left
80 pack $bq -side right -expand false -fill x
81
82 $datasrc proc hook_updateTime {t} " \
83 $lt configure -text \[format %.4f \$t\] \
84 "
85
86 set vpath [$view path]
87 bind $vpath <q> exit
88 bind $vpath <Control-c> exit
89 }
90
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.