[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[2023] | 2 | # ---------------------------------------------------------------------- |
---|
| 3 | # COMPONENT: videochooserinfo - video info |
---|
| 4 | # |
---|
| 5 | # ====================================================================== |
---|
| 6 | # AUTHOR: Derrick Kearney, Purdue University |
---|
[3177] | 7 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[2023] | 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 | |
---|
| 13 | package require Itk |
---|
| 14 | package require BLT |
---|
| 15 | package require Img |
---|
| 16 | package require Rappture |
---|
| 17 | |
---|
| 18 | itcl::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 "" |
---|
[2069] | 26 | itk_option define -thumbsdir thumbsdir Thumbsdir "" |
---|
[2023] | 27 | |
---|
| 28 | constructor { args } { |
---|
| 29 | # defined below |
---|
| 30 | } |
---|
| 31 | destructor { |
---|
| 32 | # defined below |
---|
| 33 | } |
---|
| 34 | |
---|
| 35 | public method load {path about} |
---|
[2067] | 36 | public method select {} |
---|
[2023] | 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 | |
---|
| 55 | itk::usual VideoChooserInfo { |
---|
| 56 | } |
---|
| 57 | |
---|
| 58 | # ---------------------------------------------------------------------- |
---|
| 59 | # CONSTRUCTOR |
---|
| 60 | # ---------------------------------------------------------------------- |
---|
| 61 | itcl::body Rappture::VideoChooserInfo::constructor {args} { |
---|
| 62 | |
---|
| 63 | itk_component add main { |
---|
[2067] | 64 | canvas $itk_interior.main |
---|
[2023] | 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 \ |
---|
[2067] | 72 | 0,0 $itk_component(main) -fill both -pady 2 |
---|
[2023] | 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 | # ---------------------------------------------------------------------- |
---|
| 83 | itcl::body Rappture::VideoChooserInfo::destructor {} { |
---|
| 84 | image delete ${_preview} |
---|
| 85 | image delete ${_selected} |
---|
| 86 | } |
---|
| 87 | |
---|
| 88 | # ---------------------------------------------------------------------- |
---|
| 89 | # USAGE: load |
---|
| 90 | # ---------------------------------------------------------------------- |
---|
| 91 | itcl::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 |
---|
[2069] | 98 | set preview_fname "" |
---|
| 99 | set selected_fname "" |
---|
[2023] | 100 | |
---|
| 101 | set _preview [image create photo] |
---|
| 102 | set _selected [image create photo] |
---|
| 103 | |
---|
[2069] | 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 | |
---|
[2023] | 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] |
---|
[2067] | 146 | $itk_component(main) bind preview <Enter> [itcl::code $this _bindings enter] |
---|
| 147 | $itk_component(main) bind preview <Leave> [itcl::code $this _bindings leave] |
---|
[2023] | 148 | |
---|
| 149 | _fixSize |
---|
| 150 | } |
---|
| 151 | |
---|
| 152 | # ---------------------------------------------------------------------- |
---|
[2067] | 153 | # USAGE: select |
---|
| 154 | # ---------------------------------------------------------------------- |
---|
| 155 | itcl::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 | # ---------------------------------------------------------------------- |
---|
[2023] | 196 | # USAGE: _bindings |
---|
| 197 | # ---------------------------------------------------------------------- |
---|
| 198 | itcl::body Rappture::VideoChooserInfo::_bindings {sequence} { |
---|
| 199 | switch -- $sequence { |
---|
| 200 | "b1press" { |
---|
[2067] | 201 | select |
---|
[2023] | 202 | } |
---|
[2067] | 203 | "enter" { |
---|
| 204 | $itk_component(main) itemconfigure previewselected -state hidden |
---|
| 205 | } |
---|
| 206 | "leave" { |
---|
| 207 | $itk_component(main) itemconfigure previewselected -state normal |
---|
| 208 | } |
---|
[2023] | 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 | # ---------------------------------------------------------------------- |
---|
| 220 | itcl::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 |
---|
[2067] | 228 | #$itk_component(main) configure -background black |
---|
[2023] | 229 | } |
---|
| 230 | } |
---|
| 231 | |
---|
| 232 | # ---------------------------------------------------------------------- |
---|
| 233 | # USAGE: _fixSize |
---|
| 234 | # ---------------------------------------------------------------------- |
---|
| 235 | itcl::body Rappture::VideoChooserInfo::_fixSize {} { |
---|
| 236 | $itk_component(main) configure -width ${_selectedwidth} -height ${_selectedheight} |
---|
| 237 | } |
---|
| 238 | |
---|
| 239 | # ---------------------------------------------------------------------- |
---|
| 240 | # USAGE: query |
---|
| 241 | # ---------------------------------------------------------------------- |
---|
| 242 | itcl::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 | # ---------------------------------------------------------------------- |
---|
| 253 | itcl::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 | # ---------------------------------------------------------------------- |
---|
| 275 | itcl::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 | # ---------------------------------------------------------------------- |
---|
| 287 | itcl::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 | # ---------------------------------------------------------------------- |
---|
| 299 | itcl::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 | # ---------------------------------------------------------------------- |
---|
| 311 | itcl::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 | } |
---|