Changeset 2067

Timestamp:

Jan 25, 2011, 10:39:36 PM (14 years ago)

Author:

dkearney

Message:

adding select function to mimic a button-1 press on a video from the video chooser.

Location:

trunk/gui/scripts

Files:

• videochooser.tcl (modified) (2 diffs)
• videochooserinfo.tcl (modified) (7 diffs)
• videopreview.tcl (modified) (1 diff)
• videoscreen.tcl (modified) (1 diff)

trunk/gui/scripts/videochooser.tcl

@@ -30 +30 @@
     }
 
-    public method load {path}
-    public method choose {path}
+    public method load {paths}
+    public method select {id}
     protected method _fixSize {}
 
     private variable _vcnt 0            ;# counter of videos
     private variable _variable ""       ;# variable to pass along to each choice
+    private variable _paths ""          ;# list of choice paths
     private variable _objs ""           ;# list of choice objects
 }
@@ -83 +84 @@
                     -variable ${_variable}]
         $ci load $path ""
-        pack $ci -expand yes -fill both -side right
+        pack $ci -expand yes -fill both -side left
 
         # add the object to the list of video info objs
+        lappend _paths $path
         lappend _objs $ci
     }
 
     _fixSize
+}
+
+# ----------------------------------------------------------------------
+# USAGE: select
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoChooser::select {id} {
+
+    set obj ""
+
+    if {[string is integer $id] == 1} {
+        # treat $id as the index
+        if {($id < 0) && ($id >= [llength ${_objs}])} {
+            error "invalid id \"$id\": must be in range 0 to [llength ${_objs}]"
+        }
+    } else {
+        # treat $id as a file path
+        set idx [lsearch -exact ${_paths} $id]
+        if {$idx == -1} {
+            error "invalid id \"$id\": not found in list of loaded objects"
+        }
+        set id $idx
+    }
+
+    # grab the object associated with the id
+    # and call it's select function.
+    set obj [lindex ${_objs} $id]
+    $obj select
 }
 

trunk/gui/scripts/videochooserinfo.tcl

@@ -32 +32 @@
 
     public method load {path about}
+    public method select {}
     public method query {what}
 
@@ -59 +60 @@
 
     itk_component add main {
-        canvas $itk_interior.main \
-            -background black
+        canvas $itk_interior.main
     } {
         usual
@@ -68 +68 @@
 
     blt::table $itk_interior \
-        0,0 $itk_component(main) -fill both -padx 2
+        0,0 $itk_component(main) -fill both -pady 2
 
     blt::table configure $itk_interior c* -resize both
@@ -96 +96 @@
 
     set movie [Rappture::Video file ${_path}]
-    $movie seek 50
+    $movie seek 60
 
     set _preview [image create photo]
@@ -115 +115 @@
 
     $itk_component(main) bind preview <ButtonPress-1> [itcl::code $this _bindings b1press]
+    $itk_component(main) bind preview <Enter> [itcl::code $this _bindings enter]
+    $itk_component(main) bind preview <Leave> [itcl::code $this _bindings leave]
 
     _fixSize
 }
+
+# ----------------------------------------------------------------------
+# USAGE: select
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoChooserInfo::select {} {
+    if {"" == $_variable} {
+        return
+    }
+    # send this object's movie to the preview window
+
+    upvar #0 $_variable var
+    set var ${_path}
+
+    foreach {x0 y0 x1 y1} [$itk_component(main) bbox preview] break
+    set x0 [expr 0]
+    set y0 [expr 2]
+    set x1 [expr [$itk_component(main) cget -width]-2]
+    set y1 [expr [$itk_component(main) cget -height]-2]
+
+    # there is something wrong with the way we place the
+    # images on the canvas, or how the canvas is shapeed.
+    # the placement of the small image seems to be off
+    # by a pixel or two. for now we fudge the numbers to
+    # make the red line accesnts look decent.
+
+    $itk_component(main) create line $x0 $y0 $x1 $y0 \
+        -fill red \
+        -width 3 \
+        -tags previewselected
+
+    $itk_component(main) create line $x0 $y1 $x1 $y1 \
+        -fill red \
+        -width 3 \
+        -tags previewselected
+
+#    $itk_component(main) create rectangle \
+        [$itk_component(main) bbox preview] \
+        -outline red \
+        -width 4 \
+        -tags previewselected
+#    $itk_component(main) configure -background red
+}
+
 
 # ----------------------------------------------------------------------
@@ -125 +170 @@
     switch -- $sequence {
         "b1press" {
-            if {"" == $_variable} {
-                return
-            }
-            # send this object's movie to the preview window
-
-            upvar #0 $_variable var
-            set var ${_path}
-            $itk_component(main) create rectangle \
-                [$itk_component(main) bbox preview] \
-                -outline red \
-                -width 4 \
-                -tags previewselected
-
+            select
+        }
+        "enter" {
+            $itk_component(main) itemconfigure previewselected -state hidden
+        }
+        "leave" {
+            $itk_component(main) itemconfigure previewselected -state normal
         }
         default {}
@@ -158 +197 @@
         # unselect this object
         $itk_component(main) delete previewselected
+        #$itk_component(main) configure -background black
     }
 }

trunk/gui/scripts/videopreview.tcl

@@ -333 +333 @@
     }
 
+    if {![winfo ismapped $itk_component(hull)]} {
+        return
+    }
+
     set cw [winfo width $itk_component(main)]
     set ch [winfo height $itk_component(main)]

trunk/gui/scripts/videoscreen.tcl

@@ -595 +595 @@
 
     if {[string compare "" ${_movie}] == 0} {
+        return
+    }
+
+    if {![winfo ismapped $itk_component(hull)]} {
         return
     }