source: trunk/gui/scripts/videochooserinfo.tcl @ 6235

Last change on this file since 6235 was 5659, checked in by ldelgass, 9 years ago

whitespace
File size: 10.6 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: videochooserinfo - video info
4#
5# ======================================================================
6#  AUTHOR:  Derrick Kearney, Purdue University
7#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
8#
9# See the file "license.terms" for information on usage and redistribution of
10# this file, and for a DISCLAIMER OF ALL WARRANTIES.
11# ======================================================================
12
13package require Itk
14package require BLT
15package require Img
16package require Rappture
17
18itcl::class Rappture::VideoChooserInfo {
19    inherit itk::Widget
20
21    itk_option define -width width Width 96
22    itk_option define -height height Height 54
23    itk_option define -selectedwidth selectedwidth Selectedwidth 112
24    itk_option define -selectedheight selectedheight Selectedheight 63
25    itk_option define -variable variable Variable ""
26    itk_option define -thumbsdir thumbsdir Thumbsdir ""
27
28    constructor { args } {
29        # defined below
30    }
31    destructor {
32        # defined below
33    }
34
35    public method load {path about}
36    public method select {}
37    public method query {what}
38
39    protected method _fixSize {}
40    protected method _fixValue {args}
41
42    private method _bindings {sequence}
43
44    private variable _preview           ""
45    private variable _selected          ""
46    private variable _path              ""
47    private variable _width             0
48    private variable _height            0
49    private variable _selectedwidth     0
50    private variable _selectedheight    0
51    private variable _variable          "" ;# variable associated with -variable
52}
53
54
55itk::usual VideoChooserInfo {
56}
57
58# ----------------------------------------------------------------------
59# CONSTRUCTOR
60# ----------------------------------------------------------------------
61itcl::body Rappture::VideoChooserInfo::constructor {args} {
62
63    itk_component add main {
64        canvas $itk_interior.main
65    } {
66        usual
67        rename -background -controlbackground controlBackground Background
68    }
69    bind $itk_component(main) <Configure> [itcl::code $this _fixSize]
70
71    blt::table $itk_interior \
72        0,0 $itk_component(main) -fill both -pady 2
73
74    blt::table configure $itk_interior c* -resize both
75    blt::table configure $itk_interior r0 -resize both
76
77    eval itk_initialize $args
78}
79
80# ----------------------------------------------------------------------
81# DESTRUCTOR
82# ----------------------------------------------------------------------
83itcl::body Rappture::VideoChooserInfo::destructor {} {
84    image delete ${_preview}
85    image delete ${_selected}
86}
87
88# ----------------------------------------------------------------------
89# USAGE: load
90# ----------------------------------------------------------------------
91itcl::body Rappture::VideoChooserInfo::load {path about} {
92
93    if {![file readable $path]} {
94        error "bad path $path: file not readable"
95    }
96
97    set _path $path
98    set preview_fname ""
99    set selected_fname ""
100
101    set _preview [image create photo]
102    set _selected [image create photo]
103
104    if {[string compare "" $itk_option(-thumbsdir)] != 0} {
105        set root [file tail [file rootname ${_path}]]
106        set preview_fname [file join $itk_option(-thumbsdir) ${root}_${_width}x${_height}.png]
107        set selected_fname [file join $itk_option(-thumbsdir) ${root}_${_selectedwidth}x${_selectedheight}.png]
108
109        if {[file readable $preview_fname] && [file readable $selected_fname]} {
110            set fid [open $preview_fname r]
111            fconfigure $fid -translation binary
112            ${_preview} put [read $fid]
113            close $fid
114
115            set fid [open $selected_fname r]
116            fconfigure $fid -translation binary
117            ${_selected} put [read $fid]
118            close $fid
119        }
120    } else {
121        # there are some incomplete movies that don't open up
122        set err [catch {
123            set movie [Rappture::Video file ${_path}]
124            $movie seek 60
125
126            ${_preview} put [$movie get image ${_width} ${_height}]
127            ${_selected} put [$movie get image ${_selectedwidth} ${_selectedheight}]
128
129            $movie release
130        }]
131        if {$err} {
132            puts stderr "Error while opening movie: $movie"
133            return
134        }
135    }
136
137    set cw [expr round(${_selectedwidth}/2.0)]
138    set ch [expr round(${_selectedheight}/2.0)]
139    $itk_component(main) create image $cw $ch \
140        -anchor center \
141        -image ${_preview} \
142        -activeimage ${_selected} \
143        -tags preview
144
145    $itk_component(main) bind preview <ButtonPress-1> [itcl::code $this _bindings b1press]
146    $itk_component(main) bind preview <Enter> [itcl::code $this _bindings enter]
147    $itk_component(main) bind preview <Leave> [itcl::code $this _bindings leave]
148
149    _fixSize
150}
151
152# ----------------------------------------------------------------------
153# USAGE: select
154# ----------------------------------------------------------------------
155itcl::body Rappture::VideoChooserInfo::select {} {
156    if {"" == $_variable} {
157        return
158    }
159    # send this object's movie to the preview window
160
161    upvar #0 $_variable var
162    set var ${_path}
163
164    foreach {x0 y0 x1 y1} [$itk_component(main) bbox preview] break
165    set x0 [expr 0]
166    set y0 [expr 2]
167    set x1 [expr [$itk_component(main) cget -width]-2]
168    set y1 [expr [$itk_component(main) cget -height]-2]
169
170    # there is something wrong with the way we place the
171    # images on the canvas, or how the canvas is shapeed.
172    # the placement of the small image seems to be off
173    # by a pixel or two. for now we fudge the numbers to
174    # make the red line accesnts look decent.
175
176    $itk_component(main) create line $x0 $y0 $x1 $y0 \
177        -fill red \
178        -width 3 \
179        -tags previewselected
180
181    $itk_component(main) create line $x0 $y1 $x1 $y1 \
182        -fill red \
183        -width 3 \
184        -tags previewselected
185
186#    $itk_component(main) create rectangle \
187        [$itk_component(main) bbox preview] \
188        -outline red \
189        -width 4 \
190        -tags previewselected
191#    $itk_component(main) configure -background red
192}
193
194
195# ----------------------------------------------------------------------
196# USAGE: _bindings
197# ----------------------------------------------------------------------
198itcl::body Rappture::VideoChooserInfo::_bindings {sequence} {
199    switch -- $sequence {
200        "b1press" {
201            select
202        }
203        "enter" {
204            $itk_component(main) itemconfigure previewselected -state hidden
205        }
206        "leave" {
207            $itk_component(main) itemconfigure previewselected -state normal
208        }
209        default {}
210    }
211}
212
213# ----------------------------------------------------------------------
214# USAGE: _fixValue ?<name1> <name2> <op>?
215#
216# Invoked automatically whenever the -variable associated with this
217# widget is modified.  Copies the value to the current settings for
218# the widget.
219# ----------------------------------------------------------------------
220itcl::body Rappture::VideoChooserInfo::_fixValue {args} {
221    if {"" == $itk_option(-variable)} {
222        return
223    }
224    upvar #0 $itk_option(-variable) var
225    if {[string compare $var ${_path}] != 0} {
226        # unselect this object
227        $itk_component(main) delete previewselected
228        #$itk_component(main) configure -background black
229    }
230}
231
232# ----------------------------------------------------------------------
233# USAGE: _fixSize
234# ----------------------------------------------------------------------
235itcl::body Rappture::VideoChooserInfo::_fixSize {} {
236    $itk_component(main) configure -width ${_selectedwidth} -height ${_selectedheight}
237}
238
239# ----------------------------------------------------------------------
240# USAGE: query
241# ----------------------------------------------------------------------
242itcl::body Rappture::VideoChooserInfo::query {what} {
243    switch -- $what {
244        "preview" {return ${_preview}}
245        "selected" {return ${_selected}}
246        "file" {return ${_path}}
247    }
248}
249
250# ----------------------------------------------------------------------
251# CONFIGURE: -variable
252# ----------------------------------------------------------------------
253itcl::configbody Rappture::VideoChooserInfo::variable {
254    if {"" != $_variable} {
255        upvar #0 $_variable var
256        trace remove variable var write [itcl::code $this _fixValue]
257    }
258
259    set _variable $itk_option(-variable)
260
261    if {"" != $_variable} {
262        upvar #0 $_variable var
263        trace add variable var write [itcl::code $this _fixValue]
264
265        # sync to the current value of this variable
266        if {[info exists var]} {
267            _fixValue
268        }
269    }
270}
271
272# ----------------------------------------------------------------------
273# OPTION: -width
274# ----------------------------------------------------------------------
275itcl::configbody Rappture::VideoChooserInfo::width {
276    # $_dispatcher event -idle !fixsize
277    if {[string is integer $itk_option(-width)] == 0} {
278        error "bad value: \"$itk_option(-width)\": width should be an integer"
279    }
280    set _width $itk_option(-width)
281    after idle [itcl::code $this _fixSize]
282}
283
284# ----------------------------------------------------------------------
285# OPTION: -height
286# ----------------------------------------------------------------------
287itcl::configbody Rappture::VideoChooserInfo::height {
288    # $_dispatcher event -idle !fixsize
289    if {[string is integer $itk_option(-height)] == 0} {
290        error "bad value: \"$itk_option(-height)\": height should be an integer"
291    }
292    set _height $itk_option(-height)
293    after idle [itcl::code $this _fixSize]
294}
295
296# ----------------------------------------------------------------------
297# OPTION: -selectedwidth
298# ----------------------------------------------------------------------
299itcl::configbody Rappture::VideoChooserInfo::selectedwidth {
300    # $_dispatcher event -idle !fixsize
301    if {[string is integer $itk_option(-selectedwidth)] == 0} {
302        error "bad value: \"$itk_option(-selectedwidth)\": selectedwidth should be an integer"
303    }
304    set _selectedwidth $itk_option(-selectedwidth)
305    after idle [itcl::code $this _fixSize]
306}
307
308# ----------------------------------------------------------------------
309# OPTION: -selectedheight
310# ----------------------------------------------------------------------
311itcl::configbody Rappture::VideoChooserInfo::selectedheight {
312    # $_dispatcher event -idle !fixsize
313    if {[string is integer $itk_option(-selectedheight)] == 0} {
314        error "bad value: \"$itk_option(-selectedheight)\": selectedheight should be an integer"
315    }
316    set _selectedheight $itk_option(-selectedheight)
317    after idle [itcl::code $this _fixSize]
318}
Note: See TracBrowser for help on using the repository browser.