[Sumover-dev] [svn commit] r4655 - vic/branches/mpeg4/tcl

[sumover-dev at cs.ucl.ac.uk]

Author: douglask
Date: Mon Mar  1 12:46:30 2010
New Revision: 4655

Modified:
   vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl
   vic/branches/mpeg4/tcl/ui-grabber.tcl

Log:
Tcl/Tk code modifications for Blackmagic DeckLink grabber panel

Modified: vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl	(original)
+++ vic/branches/mpeg4/tcl/ui-ctrlmenu.tcl	Mon Mar  1 12:46:30 2010
@@ -711,7 +711,8 @@
 		pack forget $grabberPanel
 		unset grabberPanel
 	}
-	if { [info procs build.$devname] != "" } {
+	init_grabber_panel
+	if {[info procs build.$devname] != "" } {
 		if ![winfo exists $w] {
 			frame $w
 			build.$devname $w
@@ -1615,8 +1616,8 @@
 		} else {
 			close_device
 		}
-
 	}
+	set_software_scale_buttons_state
 }
 
 proc disable_large_button { } {
@@ -1635,6 +1636,25 @@
 	}
 }
 
+proc set_software_scale_buttons_state { } {
+	global inputSize softwareScaleButtons
+	if { [info exists softwareScaleButtons] } {
+		if { $inputSize == 1 } {
+			$softwareScaleButtons.b0 configure -state normal
+			$softwareScaleButtons.b1 configure -state normal
+			$softwareScaleButtons.b2 configure -state normal
+			$softwareScaleButtons.b3 configure -state normal
+			$softwareScaleButtons.b4 configure -state normal
+		} else {
+			$softwareScaleButtons.b0 configure -state disabled
+			$softwareScaleButtons.b1 configure -state disabled
+			$softwareScaleButtons.b2 configure -state disabled
+			$softwareScaleButtons.b3 configure -state disabled
+			$softwareScaleButtons.b4 configure -state disabled
+		}
+	}
+}
+
 set qscale_val(h261) 68
 set qscale_val(h261as) 68
 set qscale_val(h263) 68

Modified: vic/branches/mpeg4/tcl/ui-grabber.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-grabber.tcl	(original)
+++ vic/branches/mpeg4/tcl/ui-grabber.tcl	Mon Mar  1 12:46:30 2010
@@ -27,6 +27,10 @@
 # POSSIBILITY OF SUCH DAMAGE.
 #
 
+# init_grabber_panel if invoked ensures ui-grabber.tcl gets sourced
+proc init_grabber_panel {} {
+}
+
 proc build.dc10 w {
     build.v4l $w
 }
@@ -189,6 +193,52 @@
     pack $w.f -expand 1 -fill x
 }
 
+proc build.decklink w {
+    global setSoftwareScale softwareScaleButtons
+
+    label $w.title -text "Blackmagic DeckLink-Grabber"
+    frame $w.f -relief sunken -borderwidth 2
+
+    label $w.f.scaling -text "Software Scaling : "
+
+    if {$::tk_version > 8.4 && [windowingsystem] != "x11"} {
+        ttk::radiobutton $w.f.b0 -text "none" -command "grabber setSoftwareScale none" \
+           -variable setSoftwareScale -value "none"
+        ttk::radiobutton $w.f.b1 -text "960p" -command "grabber setSoftwareScale 960p" \
+            -variable setSoftwareScale -value "9600p"
+        ttk::radiobutton $w.f.b2 -text "720p" -command "grabber setSoftwareScale 720p" \
+            -variable setSoftwareScale -value "720p"
+        ttk::radiobutton $w.f.b3 -text "576p" -command "grabber setSoftwareScale 576p" \
+            -variable setSoftwareScale -value "576p"
+        ttk::radiobutton $w.f.b4 -text "480p" -command "grabber setSoftwareScale 480p" \
+            -variable setSoftwareScale -value "480p"
+    } else {
+        set f [smallfont]
+        radiobutton $w.f.b0 -text "none" -command "grabber setSoftwareScale none" \
+            -padx 0 -pady 0 \
+            -anchor w -variable setSoftwareScale -font $f -relief flat -value "none"
+        radiobutton $w.f.b1 -text "960p" -command "grabber setSoftwareScale 960p" \
+            -padx 0 -pady 0 \
+            -anchor w -variable setSoftwareScale -font $f -relief flat -value "9600p"
+        radiobutton $w.f.b2 -text "720p" -command "grabber setSoftwareScale 720p" \
+            -padx 0 -pady 0 \
+            -anchor w -variable setSoftwareScale -font $f -relief flat -value "720p"
+        radiobutton $w.f.b3 -text "576p" -command "grabber setSoftwareScale 576p" \
+            -padx 0 -pady 0 \
+            -anchor w -variable setSoftwareScale -font $f -relief flat -value "576p"
+        radiobutton $w.f.b4 -text "480p" -command "grabber setSoftwareScale 480p" \
+            -padx 0 -pady 0 \
+            -anchor w -variable setSoftwareScale -font $f -relief flat -value "480p"
+    }
+    pack $w.f.scaling $w.f.b0 $w.f.b1 $w.f.b2 $w.f.b3 $w.f.b4 -fill x -side left
+
+    pack $w.title $w.f -fill x -expand 1
+
+    set setSoftwareScale "none"
+    set softwareScaleButtons $w.f
+    set_software_scale_buttons_state
+}
+
 proc build.meteor w {
 #
 # The meteor has the same controls as the slicvideo, so just call that