~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/psvp/test2/fx_ui.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # fx_ui.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1999-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 import RTPApplication
 32 import GraphComm
 33 
 34 Class FX_UI_App -superclass RTPApplication
 35 
 36 FX_UI_App instproc init args {
 37     $self next fx_ui
 38 
 39     $self init_resources
 40 
 41     [$self options] register_option -cntrl_spec cntrl_spec
 42     [$self options] register_option -comm_id comm_id
 43 
 44     eval [$self options] parse_args $args;
 45 
 46     $self instvar cntrl_obj_;
 47 
 48     set ctrl_spec [split [$self get_option cntrl_spec] "/"];
 49     set ctrl_addr [lindex $ctrl_spec 0];
 50     set ctrl_port [lindex $ctrl_spec 1];
 51     set ctrl_ttl [lindex $ctrl_spec 2];
 52 
 53     set cntrl_obj_ [new GraphComm/FX_UI $self [$self get_option comm_id] $ctrl_addr $ctrl_port $ctrl_ttl];
 54 
 55     $self instvar in_list_ out_list_ param_list_;
 56 
 57     set in_list_ "";
 58     set out_list_ "";
 59     set param_list_ "";
 60 
 61     frame .in_frame;
 62     frame .out_frame;
 63     frame .param_frame;
 64 
 65     pack .in_frame -side top -fill both -expand 1
 66     pack .out_frame -side top  -fill both -expand 1
 67     pack .param_frame -side top  -fill both -expand 1
 68 
 69     label .in_frame.l -text "Inputs"
 70     label .out_frame.l -text "Outputs"
 71     label .param_frame.l -text "Parameters"
 72 
 73     pack .in_frame.l -side top -fill both -expand 1
 74     pack .out_frame.l -side top -fill both -expand 1
 75     pack .param_frame.l -side top -fill both -expand 1
 76 }
 77 
 78 FX_UI_App instproc init_resources {} {
 79     $self add_option network ip
 80     $self add_option mtu 1024
 81     $self add_option defaultTTL 32
 82     $self add_option sessionType rtpv2
 83     $self add_option maxVideoSessionBW 30000000
 84     $self add_option cntrl_spec 224.3.2.1/22334/16
 85 
 86     set hname [exec hostname];
 87     set hname [split $hname .];
 88     set hname [string trim [lindex $hname 0]];
 89 
 90     $self add_option comm_id $hname;
 91 }
 92 
 93 FX_UI_App instproc BuildInputFrame {id} {
 94     $self instvar in_list_ cntrl_obj_;
 95 
 96     if {[lsearch $in_list_ $id] == -1} {
 97         lappend in_list_ $id;
 98 
 99         set f [frame .in_frame.$id];
100         label $f.l -text "$id";
101         entry $f.e;
102         $f.e insert 0 "224.2.3.4/22334/*"
103         button $f.b -text "Set" -command "$cntrl_obj_ set_input_attr $id spec \[$f.e get\]";
104         checkbutton $f.trig -text "AutoTrigger" -variable trig_array($f.trig) -command "$cntrl_obj_ set_input_attr $id trigger \[list auto \$trig_array($f.trig)\]"
105         pack $f.l -side left;
106         pack $f.e -side left -fill x -expand 1;
107         pack $f.b -side left;
108         pack $f.trig -side right;
109         pack $f -side top -fill both -expand 1;
110     }
111 }
112 
113 FX_UI_App instproc BuildOutputFrame {id} {
114     $self instvar out_list_ cntrl_obj_
115 
116     if {[lsearch $out_list_ $id] == -1} {
117         lappend out_list_ $id;
118 
119         set f [frame .out_frame.$id];
120         label $f.l -text "$id";
121         entry $f.e;
122         $f.e insert 0 "224.2.3.4/22334"
123         button $f.b -text "Set" -command "$cntrl_obj_ set_output_attr $id spec \[$f.e get\]";
124         pack $f.l -side left;
125         pack $f.e -side left -fill x -expand 1;
126         pack $f.b -side right;
127         pack $f -side top -fill both -expand 1;
128     }
129 }
130 
131 FX_UI_App instproc BuildParamFrame {id} {
132     $self instvar param_list_ cntrl_obj_;
133 
134     if {[lsearch $param_list_ $id] != -1} {
135         # Already build ui for this parameter
136         return;
137     }
138 
139     if {![$cntrl_obj_ parameter_attr_has_value $id type]} {
140         # Don't know type info yet
141         return;
142     }
143     if {![$cntrl_obj_ parameter_attr_has_value $id domain]} {
144         # Don't know domain info yet
145         return;
146     }
147 
148     lappend param_list_ $id;
149 
150     set ptype [$cntrl_obj_ get_parameter_attr_value $id type];
151     set pdomain [$cntrl_obj_ get_parameter_attr_value $id domain];
152 
153     set f [frame .param_frame.$id];
154     label $f.l -text "$id";
155     pack $f.l -side left;
156 
157     if {$ptype == "real"} {
158         # Handle real value parameters here.
159         set pdomain [split $pdomain "(),"];
160         set from [lindex $pdomain 1];
161         set to [lindex $pdomain 2];
162 
163         scale $f.s -from $from -to $to -resolution [expr ($to - $from)/100.0] -orient h;
164         pack $f.s -side right -fill x -expand 1;
165         $f.s configure -command "$cntrl_obj_ set_parameter_attr $id value ";
166     } elseif {$ptype == "int"} {
167         # Handle int value parameter here.
168         set pdomain [split $pdomain "(),"];
169         set from [lindex $pdomain 1];
170         set to [lindex $pdomain 2];
171 
172         scale $f.s -from $from -to $to -resolution 1 -orient h;
173         pack $f.s -side right -fill x -expand 1;
174         $f.s configure -command "$cntrl_obj_ set_parameter_attr $id value";
175     } elseif {$ptype == "exclusive_choice"} {
176         # Exclusive choice type.
177         menubutton $f.mb
178         menu $f.mb.m
179         foreach e $pdomain {
180             $f.mb.m add radiobutton -label $e -command "$f.mb configure -text \"$e\"; $cntrl_obj_ set_parameter_attr $id value $e";
181         }
182         $f.mb configure -text "None chosen" -menu $f.mb.m;
183         pack $f.mb;
184     } elseif {$ptype == "rect_subregion"} {
185         import RectSubregionUI
186 
187         frame $f.f
188         set o [new RectSubregionUI $f.f];
189         pack $f.f -side right
190 
191         $o set_command "$cntrl_obj_ set_parameter_attr $id value ";
192     } else {
193         # All other types
194         entry $f.e;
195         button $f.b -text "Set" -command "$cntrl_obj_ set_parameter_attr $id value \[$f.e get\]";
196         pack $f.e -side left -fill x -expand 1;
197         pack $f.b -side right;
198     }
199     pack $f -side top -fill both -expand 1;
200 }
201 
202 Class GraphComm/FX_UI -superclass GraphComm;
203 
204 GraphComm/FX_UI instproc init {ui_obj comm_id addr port ttl} {
205     $self next $comm_id $addr $port $ttl;
206 
207     $self instvar ui_obj_;
208 
209     set ui_obj_ $ui_obj;
210 }
211 
212 GraphComm/FX_UI instproc new_input {new_name} {
213     $self next $new_name;
214 
215     # Need to create input container in our local space
216     # since we'll be writing to attributes.
217 
218     $self create_input $new_name
219 
220     # Create attribute containers for attributes we
221     # expect to write
222 
223     $self create_input_attr $new_name spec;
224     $self create_input_attr $new_name trigger;
225 
226     $self instvar ui_obj_;
227     $ui_obj_ BuildInputFrame $new_name;
228 }
229 
230 GraphComm/FX_UI instproc new_output {new_name} {
231     $self next $new_name;
232 
233     $self create_output $new_name;
234     $self create_output_attr $new_name spec;
235 
236     $self instvar ui_obj_;
237     $ui_obj_ BuildOutputFrame $new_name;
238 }
239 
240 GraphComm/FX_UI instproc new_parameter {new_name} {
241     $self next $new_name;
242 
243     $self create_parameter $new_name;
244     $self create_parameter_attr $new_name value;
245 }
246 
247 GraphComm/FX_UI instproc update_parameter_attr_value {parameter_name attr_name value} {
248     $self next $parameter_name $attr_name $value;
249 
250     if {$attr_name == "type"} {
251         $self instvar ui_obj_;
252         $ui_obj_ BuildParamFrame $parameter_name;
253     } elseif {$attr_name == "domain"} {
254         $self instvar ui_obj_;
255         $ui_obj_ BuildParamFrame $parameter_name;
256     }
257 }
258 
259 set app [new FX_UI_App $argv];
260 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.