Changeset 953

Show
Ignore:
Timestamp:
11/05/99 11:15:49 (15 years ago)
Author:
piers
Message:

Adding layered support and PVH codec:
cf-main.tcl - new rtp_types for ldct,pvh.
cf-network.tcl - create network sockets for send/recv layers. Added auto addr generation for layers
ui-ctrlmenu.tcl - $encoder loop_layer (numLayers+1) after $encoder transmitter $V(session)

adds pvh to 411 format list. Creates pvh encoder button, pvh_shs proc

ui-main.tcl - $decoder maxChannel numLayers for pvh format
ui-srclist.tcl - create layers when new src object is created
ui-resource.tcl - added numLayers resource

Location:
vic/trunk/tcl
Files:
6 modified

Legend:

Unmodified
Added
Removed
  • vic/trunk/tcl/cf-main.tcl

    r904 r953  
    3333 
    3434set rtp_type(126) raw 
     35set rtp_type(20) ldct 
     36set rtp_type(21) pvh 
    3537set rtp_type(22) bvc 
    3638set rtp_type(25) cellb 
     
    4749 
    4850proc vic_main {} { 
    49         global V tcl_platform env 
     51        global V tcl_platform 
     52 
    5053        set V(class) Vic     
    5154        set V(app) vic 
  • vic/trunk/tcl/cf-network.tcl

    r941 r953  
    3636# 
    3737proc net_open_ip { sessionType session dst } { 
    38         global V 
     38        global V numLayers 
    3939        set c $V(class) 
    4040 
     
    9393                set port [expr $port &~ 1] 
    9494        } 
     95 
     96#Layer 0 
     97        set layer 0 
    9598        set dn [new network ip] 
    9699        if { [$dn open $addr $port $ttl] == 0 } { 
     
    112115        set V(data-net) $dn 
    113116 
     117        if { $numLayers > 0 } { 
     118                set oct [split $addr .] 
     119                set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2] 
     120                set off [lindex $oct 3] 
     121                set ismulticast [in_multicast $addr] 
     122 
     123                while { $numLayers > $layer } { 
     124                        incr port  
     125                        incr layer 
     126                        if { $ismulticast } { 
     127                                incr off 
     128                        } 
     129                        set dn [new network ip] 
     130                        $dn open $base.$off $port $ttl 
     131                        $session data-net $dn $layer 
     132 
     133                        if { $sessionType != "nv" } { 
     134                                if { $sessionType == "ivs" } { 
     135                                        incr port 2 
     136                                } else { 
     137                                        incr port 
     138                                } 
     139                                set cn [new network ip] 
     140                                $cn open $base.$off $port $ttl 
     141                                $session ctrl-net $cn $layer 
     142                        } 
     143                } 
     144        } 
    114145        # 
    115146        # if the max bandwidth wasn't set, pick one based on the 
     
    154185} 
    155186 
    156 # 
    157 # $dst is an "atm-host" 
    158 # 
    159 proc net_open_atm { sessionType session dst } { 
    160         global V 
    161  
    162         set dataSAP 4092 
    163         set ctrlSAP 4090 
    164         set dn [new network atm] 
    165         if { $dn == "" } { 
    166                 warn "not compiled with ATM support" 
    167                 exit 1 
    168         } 
    169         #XXX should be able to configure qos parameters 
    170         if { [$dn open $dst $dataSAP 256 64 128 128 2 1] < 0 } { 
    171                 warn "cannot open atm connection to $dst" 
    172                 exit 1 
    173         } 
    174         $session data-net $dn 
    175         set cn [new network atm] 
    176         if { [$cn open $dst $ctrlSAP 128 64 24 24 2 1] < 0 } { 
    177                 warn "cannot open atm control connection to $dst" 
    178                 exit 1 
    179         } 
    180         $session ctrl-net $cn 
    181         set V(ctrl-net) $cn 
    182         set V(data-net) $dn 
    183 } 
    184  
    185 # 
    186 # $dst has form ip-addr/rtip-port 
    187 # 
    188 proc net_open_rtip { sessionType session dst } { 
    189         global V 
    190  
    191         set dst [split $dst /] 
    192         set n [llength $dst] 
    193         if { $n != 2 } { 
    194                 warn  "must specify both address and port (i.e., addr/port) for RTIP" 
    195                 exit 1 
    196         } 
    197         set addr [lindex $dst 0] 
    198         set port [lindex $dst 1] 
    199         set dn [new network rtip] 
    200         if { [$dn open $addr $port [resource rtipXmin] [resource rtipXave] \ 
    201                 [resource rtipI] [resource rtipSmax] [resource rtipD] \ 
    202                 [resource rtipJ] [resource rtipZ] [resource rtipW] \ 
    203                 [resource rtipU]  [resource rtipType]] < 0 } { 
    204                 warn "cannot open RTIP connection to $addr/$port" 
    205                 exit 1 
    206         } 
    207         # just send control over data port 
    208         $session data-net $dn 
    209         $session ctrl-net $dn 
    210         set V(ctrl-net) $cn 
    211         set V(data-net) $dn 
    212 } 
    213  
    214 proc init_network {} { 
    215         set netType [resource network] 
    216         if { [string first ":" [resource defaultHostSpec]] > 0 } { 
    217                 set netType ip6 
    218         } 
    219         if { [info procs net_open_$netType] == "" } { 
    220                 warn "$netType not a recognized network type" 
    221                 exit 1 
    222         } 
    223         set sessionType [resource sessionType] 
    224         if { $sessionType == "rtpv2" || $sessionType == "vic" } { 
    225                 set sessionType rtp 
    226         } 
    227         global V 
    228         set V(sessionType) $sessionType 
    229         set V(session) [new session $V(media)/$sessionType] 
    230         if { $V(session) == "" } { 
    231                 warn "'$sessionType' not a recognized session type" 
    232                 exit 1 
    233         } 
    234         net_open_$netType $sessionType $V(session) [resource defaultHostSpec] 
    235  
    236         $V(session) max-bandwidth [resource maxbw] 
    237         $V(session) lip-sync [yesno lipSync] 
    238  
    239         set key [resource sessionKey] 
    240         if { $key != "" } { 
    241                 crypt_set $key 
    242         } 
    243 } 
    244  
    245 proc in_multicast addr { 
    246         return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0] 
    247 } 
    248  
    249 proc crypt_format {key sessionType} { 
    250         if {$sessionType == "vat"} { 
    251                 set fmt VAT 
    252         } else { 
    253                 set k [string first / $key] 
    254                 if { $k < 0 } { 
    255                         set fmt DES1 
    256                 } else { 
    257                         set fmt [string range $key 0 [expr $k - 1]] 
    258                         set key [string range $key [expr $k + 1] end] 
    259                 } 
    260         } 
    261         return "$fmt $key" 
    262 } 
    263  
    264 proc crypt_set key { 
    265         global doEncryption entryTab V 
    266         set L [crypt_format $key $V(sessionType)] 
    267         set fmt [lindex $L 0] 
    268         set key [lindex $L 1] 
    269         set dc data-crypt:$fmt 
    270         set cc ctrl-crypt:$fmt 
    271         if ![info exists V($dc)] { 
    272                 set crypt [new crypt $fmt/data] 
    273                 if { $crypt == "" } { 
    274                         open_dialog "no $fmt enryption support" 
    275                         return -1 
    276                 } 
    277                 set V($dc) $crypt 
    278                 set V($cc) [new crypt $fmt/ctrl] 
    279         } 
    280         if [$V($dc) key $key] { 
    281                 $V($cc) key $key 
    282                 $V(data-net) crypt $V($dc) 
    283                 $V(ctrl-net) crypt $V($cc) 
    284                 set V(encrypt) 1 
    285                 return 0 
    286         } else { 
    287                 open_dialog "your key is cryptographically weak" 
    288                 crypt_clear 
    289                 return -1 
    290         } 
    291 } 
    292  
    293 proc crypt_clear {} { 
    294         global V 
    295         $V(data-net) crypt "" 
    296         $V(ctrl-net) crypt "" 
    297         set V(encrypt) 0 
    298 } 
    299  
     187 
     188# IPv6 network type 
    300189# 
    301190# $dst has form addr/port/fmt/ttl (last two optional) 
    302191# 
    303192proc net_open_ip6 { sessionType session dst } { 
    304         global V 
     193        global V numLayers  
     194 
    305195        set c $V(class) 
    306196 
     
    381271        } 
    382272        set V(data-net) $dn 
     273 
     274        if { $numLayers > 0 } { 
     275                set base [string range $addr 0 [string last : $addr]] 
     276                set off [string range $addr [expr {[string last : $addr]+1}] end] 
     277 
     278                set ismulticast [in6_multicast $addr] 
     279 
     280                while { $numLayers > $layer } { 
     281                        incr port  
     282                        incr layer 
     283                        if { $ismulticast } { 
     284                                incr off 
     285                        } 
     286                        set dn [new network ip] 
     287                        $dn open $base.$off $port $ttl 
     288                        $session data-net $dn $layer 
     289 
     290                        if { $sessionType != "nv" } { 
     291                                if { $sessionType == "ivs" } { 
     292                                        incr port 2 
     293                                } else { 
     294                                        incr port 
     295                                } 
     296                                set cn [new network ip] 
     297                                $cn open $base.$off $port $ttl 
     298                                $session ctrl-net $cn $layer 
     299                        } 
     300                } 
     301        } 
    383302 
    384303        # 
     
    423342        } 
    424343} 
     344 
     345# 
     346# $dst is an "atm-host" 
     347# 
     348proc net_open_atm { sessionType session dst } { 
     349        global V 
     350 
     351        set dataSAP 4092 
     352        set ctrlSAP 4090 
     353        set dn [new network atm] 
     354        if { $dn == "" } { 
     355                warn "not compiled with ATM support" 
     356                exit 1 
     357        } 
     358        #XXX should be able to configure qos parameters 
     359        if { [$dn open $dst $dataSAP 256 64 128 128 2 1] < 0 } { 
     360                warn "cannot open atm connection to $dst" 
     361                exit 1 
     362        } 
     363        $session data-net $dn 
     364        set cn [new network atm] 
     365        if { [$cn open $dst $ctrlSAP 128 64 24 24 2 1] < 0 } { 
     366                warn "cannot open atm control connection to $dst" 
     367                exit 1 
     368        } 
     369        $session ctrl-net $cn 
     370        set V(ctrl-net) $cn 
     371        set V(data-net) $dn 
     372} 
     373 
     374# 
     375# $dst has form ip-addr/rtip-port 
     376# 
     377proc net_open_rtip { sessionType session dst } { 
     378        global V 
     379 
     380        set dst [split $dst /] 
     381        set n [llength $dst] 
     382        if { $n != 2 } { 
     383                warn  "must specify both address and port (i.e., addr/port) for RTIP" 
     384                exit 1 
     385        } 
     386        set addr [lindex $dst 0] 
     387        set port [lindex $dst 1] 
     388        set dn [new network rtip] 
     389        if { [$dn open $addr $port [resource rtipXmin] [resource rtipXave] \ 
     390                [resource rtipI] [resource rtipSmax] [resource rtipD] \ 
     391                [resource rtipJ] [resource rtipZ] [resource rtipW] \ 
     392                [resource rtipU]  [resource rtipType]] < 0 } { 
     393                warn "cannot open RTIP connection to $addr/$port" 
     394                exit 1 
     395        } 
     396        # just send control over data port 
     397        $session data-net $dn 
     398        $session ctrl-net $dn 
     399        set V(ctrl-net) $cn 
     400        set V(data-net) $dn 
     401} 
     402 
     403proc init_network {} { 
     404        global numLayers 
     405         
     406        set numLayers [resource numLayers] 
     407        set netType [resource network] 
     408        # Auto detect IPv6 addresses 
     409        if { [string first ":" [resource defaultHostSpec]] > 0 } { 
     410                set netType ip6 
     411        } 
     412        # Check for ipv6 as well as ip6 as a netType 
     413        if { $netType == "ipv6" } { 
     414                set netType ip6 
     415        } 
     416        if { [info procs net_open_$netType] == "" } { 
     417                warn "$netType not a recognized network type" 
     418                exit 1 
     419        } 
     420        set sessionType [resource sessionType] 
     421        if { $sessionType == "rtpv2" || $sessionType == "vic" } { 
     422                set sessionType rtp 
     423        } 
     424        global V 
     425        set V(sessionType) $sessionType 
     426        set V(session) [new session $V(media)/$sessionType] 
     427        if { $V(session) == "" } { 
     428                warn "'$sessionType' not a recognized session type" 
     429                exit 1 
     430        } 
     431        net_open_$netType $sessionType $V(session) [resource defaultHostSpec] 
     432 
     433 
     434        $V(session) max-bandwidth [resource maxbw] 
     435        $V(session) lip-sync [yesno lipSync] 
     436 
     437        set key [resource sessionKey] 
     438        if { $key != "" } { 
     439                crypt_set $key 
     440        } 
     441} 
     442 
     443proc in_multicast addr { 
     444        return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0] 
     445} 
     446 
     447proc in6_multicast addr { 
     448        return [expr (0x[lindex [split $addr :] 0] & 0xff00) == 0xff00] 
     449} 
     450 
     451proc crypt_format {key sessionType} { 
     452        if {$sessionType == "vat"} { 
     453                set fmt VAT 
     454        } else { 
     455                set k [string first / $key] 
     456                if { $k < 0 } { 
     457                        set fmt DES1 
     458                } else { 
     459                        set fmt [string range $key 0 [expr $k - 1]] 
     460                        set key [string range $key [expr $k + 1] end] 
     461                } 
     462        } 
     463        return "$fmt $key" 
     464} 
     465 
     466proc crypt_set key { 
     467        global doEncryption entryTab V 
     468        set L [crypt_format $key $V(sessionType)] 
     469        set fmt [lindex $L 0] 
     470        set key [lindex $L 1] 
     471        set dc data-crypt:$fmt 
     472        set cc ctrl-crypt:$fmt 
     473        if ![info exists V($dc)] { 
     474                set crypt [new crypt $fmt/data] 
     475                if { $crypt == "" } { 
     476                        open_dialog "no $fmt enryption support" 
     477                        return -1 
     478                } 
     479                set V($dc) $crypt 
     480                set V($cc) [new crypt $fmt/ctrl] 
     481        } 
     482        if [$V($dc) key $key] { 
     483                $V($cc) key $key 
     484                $V(data-net) crypt $V($dc) 
     485                $V(ctrl-net) crypt $V($cc) 
     486                set V(encrypt) 1 
     487                return 0 
     488        } else { 
     489                open_dialog "your key is cryptographically weak" 
     490                crypt_clear 
     491                return -1 
     492        } 
     493} 
     494 
     495proc crypt_clear {} { 
     496        global V 
     497        $V(data-net) crypt "" 
     498        $V(ctrl-net) crypt "" 
     499        set V(encrypt) 0 
     500} 
  • vic/trunk/tcl/ui-ctrlmenu.tcl

    r904 r953  
    277277} 
    278278 
    279 set transmitButtonState 0 
     279set  transmitButtonState 0 
     280 
    280281proc transmit { } { 
    281         global transmitButtonState videoFormat videoDevice V useJPEGforH261 useHardwareComp 
     282        global transmitButtonState videoFormat videoDevice V useJPEGforH261 useHardwareComp numLayers 
    282283        if ![have grabber] { 
    283284                set DA [$videoDevice attributes] 
     
    319320 
    320321                $encoder transmitter $V(session) 
     322 
     323                $encoder loop_layer [expr {$numLayers + 1}] 
     324                 
    321325                set V(encoder) $encoder 
    322326                set ff [$grabtarget frame-format] 
     
    535539        } 
    536540        if [inList 411 $formats] { 
    537                 set fmtList "$fmtList bvc" 
     541                set fmtList "$fmtList bvc pvh" 
    538542        } 
    539543        if [inList cif $sizes] { 
     
    686690} 
    687691 
    688 proc format_col { w n0 n1 n2 } { 
     692proc format_col3 { w n0 n1 n2 } { 
    689693        set f [smallfont] 
    690694        frame $w 
     
    702706        global formatButtons 
    703707        lappend formatButtons $w.b0 $w.b1 $w.b2 
     708 
     709        #format_col $w.p0 nv nvdct cellb  
     710        #format_col $w.p1 jpeg h261 bvc 
     711        #format_col $w.p2 h263+ h263 raw 
     712} 
     713 
     714proc format_col { w n0 n1 } { 
     715        set f [smallfont] 
     716        frame $w 
     717        if { [string first : $n0] > 0 } {  
     718                set reliefn0 ridge 
     719                set n0 [ string range $n0 0 [expr {[string length $n0] -2 }] ] 
     720        } else { 
     721                set reliefn0 flat 
     722        } 
     723        if { [string first : $n1] > 0 } {  
     724                set reliefn1 ridge 
     725                set n1 [ string range $n1 0 [expr {[string length $n1] -2 }] ] 
     726        } else { 
     727                set reliefn1 flat 
     728        } 
     729        radiobutton $w.b0 -text $n0 -relief $reliefn0 -font $f -anchor w \ 
     730                -variable videoFormat -value $n0 -padx 0 -pady 0 \ 
     731                -command "select_format $n0" -state disabled 
     732        radiobutton $w.b1 -text $n1 -relief $reliefn1 -font $f -anchor w \ 
     733                -variable videoFormat -value $n1 -padx 0 -pady 0 \ 
     734                -command "select_format $n1" -state disabled 
     735        pack $w.b0 $w.b1 -fill x  
     736 
     737        global formatButtons 
     738        lappend formatButtons $w.b0 $w.b1 
     739 
     740        #format_col $w.p0 nv nvdct  
     741        #format_col $w.p1 jpeg h261 
     742        #format_col $w.p2 h263+ h263 
     743        #format_col $w.p3 raw cellb 
     744        #format_col $w.p4 pvh bvc 
     745} 
     746 
     747proc set_numLayers { value } { 
     748        global transmitButtonState numLayers V layerscale layervalue 
     749 
     750        $layervalue configure -text $value 
     751         
     752        if $transmitButtonState { 
     753                $V(encoder) loop_layer [expr {$numLayers + 1}] 
     754                $V(decoder) maxChannel $numLayers 
     755        } 
     756} 
     757 
     758proc layer_frame { w n0 } { 
     759        global numLayers 
     760        set f [smallfont] 
     761 
     762        radiobutton $w.b0 -text $n0 -relief flat -font $f -anchor w \ 
     763                -variable videoFormat -value $n0 -padx 0 -pady 0 \ 
     764                -command "select_format $n0" -state disabled 
     765         
     766        scale $w.scale -orient horizontal -width 12 \ 
     767                -label "Number of layers" \ 
     768                -variable numLayers \ 
     769                -relief groove -showvalue 1 -from 0 -to [resource numLayers] \ 
     770        -command "set_numLayers" 
     771         
     772        pack $w.b0 $w.scale -fill x -side left 
     773 
     774        global formatButtons 
     775        lappend formatButtons $w.b0 
     776} 
     777 
     778proc build.layer_scale w { 
     779        global numLayers layerscale layervalue 
     780 
     781        set f [smallfont] 
     782 
     783        frame $w.tb 
     784        label $w.title -text "Layers" -font $f -anchor w 
     785        label $w.tb.value -text 0 -font $f -width 3 
     786        scale $w.tb.scale -font $f -orient horizontal \ 
     787                -showvalue 0 -from 0 -to $numLayers \ 
     788                -variable numLayers \ 
     789                -width 12 -relief groove \ 
     790        -command "set_numLayers" 
     791 
     792 
     793        set layerscale $w.tb.scale 
     794        set layervalue $w.tb.value 
     795 
     796        $layervalue configure -text $numLayers 
     797 
     798#$layerscale configure -state disabled 
     799 
     800        pack $w.tb.scale -side left -fill x -expand 1 
     801        pack $w.tb.value -side left 
     802        pack $w.title -padx 2 -side left 
     803        pack $w.tb -fill x -padx 6 -side left -expand 1 
    704804} 
    705805 
    706806proc build.format w { 
    707         format_col $w.p0 nv nvdct cellb  
    708         format_col $w.p1 jpeg h261 bvc 
    709         format_col $w.p2 h263+ h263 raw 
    710  
    711         set f [smallfont] 
     807        format_col $w.p0 nv nvdct  
     808        format_col $w.p1 jpeg h261 
     809        format_col $w.p2 h263+ h263 
     810        format_col $w.p3 raw cellb 
     811        format_col $w.p4 bvc pvh: 
     812         
     813        #frame $w.layer -relief groove -borderwidth 2 -width 50 
     814        #layer_frame $w.layer pvh 
    712815 
    713816        frame $w.glue0 
    714817        frame $w.glue1 
    715818 
    716         pack $w.glue0 -side left -fill x -expand 1 
    717         pack $w.p0 $w.p1 $w.p2 -side left 
    718         pack $w.glue1 -side left -fill x -expand 1 
     819        #pack $w.layer -side bottom -fill x -expand 1 
     820        #pack $w.glue0 -side left -fill x -expand 1 
     821        pack $w.p0 $w.p1 $w.p2 $w.p3 $w.p4 -side left 
     822        #pack $w.glue1 -side left -fill x -expand 1 
    719823 
    720824} 
     
    10061110 
    10071111        frame $w.f.h0 -relief flat 
    1008         frame $w.f.h1 -relief flat 
     1112        frame $w.f.quality -relief flat 
     1113#       frame $w.f.layer -relief flat 
    10091114        frame $w.f.h0.eb -relief flat 
    10101115        frame $w.f.h0.format -relief groove -borderwidth 2 
     
    10161121        build.size $w.f.h0.size 
    10171122 
    1018         build.q $w.f.h1 
     1123        build.q $w.f.quality 
     1124#build.layer_scale $w.f.h2 
    10191125 
    10201126        pack $w.f.h0.eb -side left -anchor n -fill y -padx 6 -pady 4 
     
    10241130 
    10251131        pack $w.f.h0 -fill x -pady 4 
    1026         pack $w.f.h1 -fill x -pady 6 
     1132#       pack $w.f.layer -fill x  
     1133        pack $w.f.quality -fill x -pady 6 
    10271134        pack $w.title $w.f -fill x 
    10281135} 
     
    10871194proc nvdct_setq value { 
    10881195        nv_setq $value 
     1196        global qvalue 
     1197        $qvalue configure -text $value 
    10891198} 
    10901199 
     
    11241233} 
    11251234 
     1235set pvh_shmap { 0 1 2 1 } 
     1236set pvh_shs { 
     1237        { lum-dct 0 5-1--11- } 
     1238        { lum-dct 1 ---5111- } 
     1239        { lum-dct 2 --51-11- } 
     1240        { lum-sbc 0 ----4--2 } 
     1241        { lum-sbc 1 ----4--2 } 
     1242        { lum-sbc 2 ----4--2 } 
     1243        { chm     0 -5---1-- } 
     1244        { chm     1 ---5-1-- } 
     1245        { chm     2 --5--1-- } 
     1246} 
     1247 
     1248# 
     1249# Format specific routine to map generic quality <i>value</i> 
     1250# into actions that program the underlying PVH codec. 
     1251# 
     1252#VideoPipeline instproc  
     1253# 
     1254proc pvh_setq value { 
     1255#       $self instvar encoder_ 
     1256#       if ![info exists encoder_] { 
     1257#               return -1 
     1258#       } 
     1259        if [have grabber] { 
     1260                #encoder q $value 
     1261 
     1262                #XXX ignore value and just set up the bit allocation 
     1263                #XXX should have variable strategies here 
     1264                global pvh_shmap pvh_shs 
     1265                set n [llength $pvh_shmap] 
     1266                set i 0 
     1267                while { $i < $n } { 
     1268                        encoder shmap $i [lindex $pvh_shmap $i] 
     1269                        incr i 
     1270                } 
     1271                set i 0 
     1272                foreach tuple $pvh_shs { 
     1273                        set compID [lindex $tuple 0] 
     1274                        set shID [lindex $tuple 1] 
     1275                        set pattern [lindex $tuple 2] 
     1276                        encoder comp $compID $shID $pattern 
     1277                } 
     1278                global qvalue 
     1279                $qvalue configure -text $value 
     1280                 
     1281                return 0 
     1282        } 
     1283        #XXX 
     1284        return -1 
     1285} 
     1286 
    11261287# 
    11271288# If the capture device is open, close it.  If transmission 
     
    11691330 
    11701331proc select_format fmt { 
    1171         global qscale qlabel videoDevice videoFormat qscale_val lastFmt 
    1172  
    1173         if { $fmt == "h261" } { 
     1332        global qscale qlabel videoDevice videoFormat qscale_val lastFmt layerscale 
     1333 
     1334        if { $fmt == "h261" || $fmt == "pvh"} { 
    11741335                # H.261 supports only QCIF/CIF 
    11751336                disable_large_button 
    11761337        } else { 
    11771338                enable_large_button 
     1339        } 
     1340 
     1341        if { $fmt == "pvh"} { 
     1342                set w .menu.encoder.f.layer 
     1343                if ![winfo exists $w] { 
     1344                        frame $w 
     1345                        build.layer_scale $w 
     1346                } 
     1347                pack $w -before .menu.encoder.f.quality  -fill x 
     1348        } else { 
     1349                pack forget .menu.encoder.f.layer 
    11781350        } 
    11791351 
     
    11911363        set qual [resource quality] 
    11921364        if { $qual > 0 } { 
    1193                 puts "vic: quality found " 
    11941365                $qscale set [resource quality] 
    11951366        } else { if [info exists qscale_val($fmt)] { 
     
    13041475proc build.xmit w { 
    13051476        set f [smallfont] 
     1477 
    13061478        label $w.label -text Transmission 
    13071479        frame $w.frame -relief sunken -borderwidth 2 
    13081480        pack $w.label -fill x 
    13091481        pack $w.frame -fill both -expand 1 
    1310  
    13111482        frame $w.frame.buttons 
    13121483        build.buttons $w.frame.buttons 
  • vic/trunk/tcl/ui-main.tcl

    r936 r953  
    593593 
    594594proc create_decoder src { 
    595         set decoder [new decoder [rtp_format $src]] 
     595        global numLayers 
     596 
     597        set format [rtp_format $src] 
     598        set decoder [new decoder $format] 
    596599        if { $decoder == "" } { 
    597600                # don't support this format 
    598601                set decoder [new decoder null] 
    599602        } 
     603##LL 
     604        if { $format == "pvh" } { 
     605                $decoder maxChannel $numLayers 
     606        } 
    600607        $src handler $decoder 
    601608        return $decoder 
     
    610617# 
    611618proc activate src { 
     619        global V 
     620 
    612621        if [yesno relateInterface] { 
    613                 create_decoder $src 
     622                set V(decoder) [create_decoder $src] 
    614623                after idle "really_activate_relate $src" 
    615624        } else { 
    616                 create_decoder $src 
     625                set V(decoder) [create_decoder $src] 
    617626        # 
    618627        # give decoder a chance see a packet so it can 
  • vic/trunk/tcl/ui-resource.tcl

    r930 r953  
    199199        option add Vic.flowLabel 0 startupFile 
    200200 
     201        option add Vic.numLayers 0 startupFile 
     202 
    201203        option add Vic.foundry adobe startupFile 
    202204 
  • vic/trunk/tcl/ui-srclist.tcl

    r904 r953  
    7272# those not actually sending video). 
    7373# 
     74# This also sets up the layers within each source object 
     75# 
    7476proc register src { 
    75         global srcstate srclist srclist_bottom nametag 
     77        global srcstate srclist srclist_bottom nametag numLayers 
     78 
    7679        set srcstate($src) 1 
     80 
     81        set layer 0 
     82        $src layer $layer [new SourceLayer] 
     83 
     84        # Create SourceLayer objs within the src as required 
     85        while { $numLayers > $layer } { 
     86                incr layer 
     87                $src layer $layer [new SourceLayer] 
     88        } 
     89         
    7790        if [info exists srclist] { 
    7891                set f [mediumfont]