[Sumover-dev] [svn commit] r4011 - vic/branches/mpeg4/tcl
sumover-dev at cs.ucl.ac.uk
sumover-dev at cs.ucl.ac.uk
Tue May 8 00:53:36 BST 2007
Author: piers
Date: Tue May 8 00:53:19 2007
New Revision: 4011
Modified:
vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl
vic/branches/mpeg4/tcl/ui-main.tcl
vic/branches/mpeg4/tcl/ui-resource.tcl
vic/branches/mpeg4/tcl/ui-util.tcl
vic/branches/mpeg4/tcl/ui-windows.tcl
Log:
A few changes
- Made tcl/tk-8.0 compatible - changed calls to tk windowingsystem (tk8.4 only) to a new util proc windowingsys
- Fixed bug where frame and bit rates werent being updated (just re-instated a missing global declaration that was accidentanlly deleted before previous commit)
- Added feature so that sender thumbnail is displayed as 'raised' window
Modified: vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl (original)
+++ vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl Tue May 8 00:53:19 2007
@@ -212,7 +212,7 @@
frame $w.nb.frame.b
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
button $w.nb.frame.b.stats -text "Global Stats" -padx 10 \
-anchor c -font $f -command create_global_window
button $w.nb.frame.b.members -text Members -padx 10 \
@@ -395,7 +395,7 @@
global V
# XXX: bypassing the pure virtual funtion call problem under macosx
# need to figure out where is the bug
- if { ![string equal [tk windowingsystem] "aqua"]} {
+ if { ![string match [ windowingsystem] "aqua"]} {
delete $V(encoder)
delete $V(grabber)
unset V(grabber)
@@ -717,7 +717,7 @@
set f [smallfont]
set m $w.menu
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w -menu $m -text Device -width 8 -pady 4
} else {
menubutton $w -menu $m -text Device... \
@@ -914,7 +914,7 @@
proc build.port w {
set f [smallfont]
# create the menubutton but don't defer the menu creation until later
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w -menu $w.menu -text Port -width 8 -pady 4 \
-state disabled
} else {
@@ -958,7 +958,7 @@
set f [smallfont]
set m $w.menu
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w -text Signal -menu $m -width 8 -pady 4 \
-state disabled
} else {
@@ -996,7 +996,7 @@
set useHardwareComp [yesno useHardwareComp]
set f [smallfont]
set m $w.menu
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w -text Options -menu $m -width 8 -pady 4
} else {
menubutton $w -text Options... -menu $m -relief raised -width 10 \
@@ -1009,7 +1009,7 @@
-variable useJPEGforH261 -font $f -command restart
$m add checkbutton -label "Use Hardware Encode" \
-variable useHardwareComp -font $f -command restart
- if { $tcl_platform(platform) == "windows" || [string equal [tk windowingsystem] "aqua"] } {
+ if { $tcl_platform(platform) == "windows" || [string match [ windowingsystem] "aqua"] } {
$m add checkbutton -label "Configure on Transmit" \
-variable configOnTransmit -font $f \
-command "grabber useconfig \$configOnTransmit"
@@ -1019,7 +1019,7 @@
proc build.tile w {
set f [smallfont]
set m $w.menu
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w -text Tile -menu $m -width 8 -pady 4
} else {
menubutton $w -text Tile... -menu $m -relief raised -width 10 \
@@ -1039,7 +1039,7 @@
proc build.decoder_options w {
set f [smallfont]
set m $w.menu
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w -text Options -menu $m -width 8 -pady 4
} else {
menubutton $w -text Options... -menu $m -relief raised -width 10 \
@@ -1527,7 +1527,7 @@
proc init_grabber { grabber } {
global V configOnTransmit tcl_platform
- if { $tcl_platform(platform) == "windows" || [string equal [tk windowingsystem] "aqua"] } {
+ if { $tcl_platform(platform) == "windows" || [string match [ windowingsystem] "aqua"] } {
$grabber useconfig $configOnTransmit
}
@@ -1559,7 +1559,7 @@
global inputPort inputType portButton typeButton
# MacOS-X requires port and input type to be set before decimate
# is called otherwise the channel device's input may be busy
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
if { [$portButton cget -state] == "normal" } {
$grabber port $inputPort
}
@@ -1574,7 +1574,7 @@
set cmd [lindex [$qscale configure -command] 4]
$cmd [$qscale get]
}
- if !{[string equal [tk windowingsystem] "aqua"]} {
+ if !{[string match [ windowingsystem] "aqua"]} {
if { [$portButton cget -state] == "normal" } {
$grabber port $inputPort
}
Modified: vic/branches/mpeg4/tcl/ui-main.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-main.tcl (original)
+++ vic/branches/mpeg4/tcl/ui-main.tcl Tue May 8 00:53:19 2007
@@ -58,7 +58,7 @@
global title
frame $w.bar -borderwidth 0
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
global V
set net $V(data-net)
label $w.bar.title -text "Address: [$net addr] Port: [$net port] TTL: [$net ttl]" -font [smallfont] -justify left
@@ -317,7 +317,7 @@
if { ![yesno relateInterface] && [array size active] == 0 } {
pack forget $V(grid)
destroy $V(grid)
- pack .top.label -before .top.bar -anchor c -expand 1
+ pack .top.label -before .top.barholder -anchor c -expand 1
}
}
@@ -543,7 +543,7 @@
set stamp $w.stamp
frame $stamp -relief ridge -borderwidth 2
bind $stamp <Enter> "%W configure -background gray90"
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
bind $stamp <Enter> "%W configure -background CornflowerBlue"
} else {
bind $stamp <Enter> "%W configure -background gray90"
@@ -556,7 +556,7 @@
# disable xvideo fro stamp video
attach_window $src $stamp.video false
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
pack $stamp.video -side left -padx 2 -pady 2
pack $stamp -side left -anchor nw -padx {4 2} -pady 2
frame $w.r -padx 2
@@ -565,13 +565,19 @@
pack $stamp -side left -fill y
frame $w.r
}
-
- frame $w.r.cw -relief groove -borderwidth 2
+
+ global V
+# Show sender window as raised
+ if { $src == [srctab local] } {
+ frame $w.r.cw -relief raised -borderwidth 2
+ } else {
+ frame $w.r.cw -relief groove -borderwidth 2
+ }
pack $w.r.cw -side left -expand 1 -fill both -anchor w -padx 0
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
label $w.r.cw.name -textvariable src_nickname($src) -font $f \
-padx 2 -pady 1 -borderwidth 0 -anchor w
label $w.r.cw.addr -textvariable src_info($src) -font $f \
@@ -596,13 +602,14 @@
label $w.r.cw.rateinfo.loss -textvariable ltext($src) -width 6 \
-font $f -pady 0 -borderwidth 0
+
frame $w.r.ctrl -borderwidth 0
global mutebutton V
set mutebutton($src) $V(muteNewSources)
$src mute $mutebutton($src)
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
checkbutton $w.r.ctrl.mute -text mute -borderwidth 2 \
-font $f -width 4 \
-command "$src mute \$mutebutton($src)" \
@@ -627,7 +634,7 @@
}
set m $w.r.ctrl.info.menu$src
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menubutton $w.r.ctrl.info -text info -borderwidth 2 \
-font $f -pady 4 -menu $m
} else {
@@ -638,7 +645,7 @@
}
build_info_menu $src $m
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
pack $w.r.ctrl.mute -side left -expand 1
pack $w.r.ctrl.color -side left -expand 1
pack $w.r.ctrl.info -side left -fill x -expand 1
@@ -992,6 +999,7 @@
}
proc update_src src {
+ global ftext updated
if ![info exists ftext($src)] {
return
Modified: vic/branches/mpeg4/tcl/ui-resource.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-resource.tcl (original)
+++ vic/branches/mpeg4/tcl/ui-resource.tcl Tue May 8 00:53:19 2007
@@ -32,7 +32,7 @@
#
global font
-if {[string equal [tk windowingsystem] "aqua"]} {
+if {[string match [ windowingsystem] "aqua"]} {
font create medfont -family {Lucida Grande} -size 12 -weight bold
font create smallfont -family {Lucida Grande} -size 10 -weight bold
font create minifont -family {Lucida Grande} -size 4
@@ -117,7 +117,7 @@
#
# use 2 pixels of padding by default, except with MacOSX Aqua
#
- if {![string equal [tk windowingsystem] "aqua"]} {
+ if {![string match [ windowingsystem] "aqua"]} {
option add *video*padX 0
option add *video*padY 0
option add *padX 1
@@ -235,7 +235,7 @@
option add Vic.overlayY "0" startupFile
# Init fonts
- if {![string equal [tk windowingsystem] "aqua"]} {
+ if {![string match [ windowingsystem] "aqua"]} {
init_fonts
}
Modified: vic/branches/mpeg4/tcl/ui-util.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-util.tcl (original)
+++ vic/branches/mpeg4/tcl/ui-util.tcl Tue May 8 00:53:19 2007
@@ -32,22 +32,29 @@
#
# @(#) $Header$ (LBL)
+proc windowingsystem {} {
+ if [ catch {set tkws [tk windowingsystem]}] {
+ set tkws x11
+ }
+ return $tkws
+}
+
proc smallfont { } {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [windowingsystem] "aqua"]} {
return smallfont
}
return [resource smallfont]
}
proc minifont { } {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
return minifont
}
return [resource minifont]
}
proc mediumfont { } {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
return smallfont
}
return [resource medfont]
@@ -55,21 +62,21 @@
proc helpfont { } {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
return helpfont
}
return [resource helpfont]
}
proc disfont { } {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
return disablefont
}
return [resource disablefont]
}
proc entryfont { } {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
return entryfont
}
return [resource entryfont]
@@ -106,7 +113,7 @@
# adjust for virtual desktops
incr x [winfo vrootx .]
incr y [winfo vrooty .]
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
if { $y < 25 } { set y 25 }
} else {
if { $y < 0 } { set y 0 }
@@ -127,7 +134,7 @@
} else {
wm deiconify $w
}
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
raise $w
}
}
@@ -288,7 +295,7 @@
proc mk.key w {
global V
frame $w.key
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
checkbutton $w.key.button -text Key: -relief flat \
-font [smallfont] -command "toggleKey $w.key" \
-variable V(encrypt) -disabledforeground gray40 -padx 3
Modified: vic/branches/mpeg4/tcl/ui-windows.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-windows.tcl (original)
+++ vic/branches/mpeg4/tcl/ui-windows.tcl Tue May 8 00:53:19 2007
@@ -228,7 +228,7 @@
-width 8 -font $f
menu $m
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
menu $w.mbar -tearoff 0
$w configure -menu $w.mbar
$w.mbar add cascade -label File -menu $w.mbar.file
@@ -256,7 +256,7 @@
menubutton $w.bar.size -text Size... -menu $m -relief raised -width 8 \
-font $f
menu $m
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
$w.mbar add cascade -label Size -menu $m
}
$m add radiobutton -label QCIF -command "resize $v 176 144" \
@@ -292,7 +292,7 @@
# Marcus ...
set m $w.bar.decoder.menu
menubutton $w.bar.decoder -text Decoder... -menu $m -relief raised -width 8 -font $f
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[string match [ windowingsystem] "aqua"]} {
$w.mbar add cascade -label Decoder -menu $m
}
menu $m
More information about the Sumover-dev
mailing list