1
2package require QuickTimeTcl 3.1
3
4set myFile [tk_getOpenFile]
5if {$myFile == ""} {
6    return
7}
8
9# Get screen size.
10set swidth  [winfo screenwidth .]
11set sheight [winfo screenheight .]
12
13set w .t
14toplevel $w -background black
15wm overrideredirect $w 1
16wm geometry $w ${swidth}x${sheight}+0+0
17bind $w <Command-q> exit
18bind $w <Command-.> exit
19bind $w <Escape> exit
20
21set m $w.m
22movie $m -file $myFile -controller 0
23foreach {mwidth mheight} [$m size] break
24array set timeArr [$m gettime]
25
26# Buttons.
27set dir [file dirname [info script]]
28set imquit [image create photo -file [file join $dir quit.gif]]
29set imstop [image create photo -file [file join $dir stop.gif]]
30set implay [image create photo -file [file join $dir start.gif]]
31set f [frame $w.f -bg black]
32label $f.ss   -bg black -bd 0 -image $implay
33label $f.quit -bg black -bd 0 -image $imquit
34pack $f.ss $f.quit -side left -padx 12 -pady 6
35pack $f -side bottom
36bind $f.ss   <Button-1> {Command play}
37bind $f.quit <Button-1> exit
38
39# Keep proportions.
40set rw [expr double($swidth)/$mwidth]
41set rh [expr double($sheight)/$mheight]
42if {$rw < $rh} {
43    set newwidth $swidth
44    set newheight [expr int($rw * $mheight)]
45    set side left
46} else {
47    set newheight $sheight
48    set newwidth [expr int($rh * $mwidth)]
49    set side top
50}
51proc End {token w mtime} {
52    exit
53}
54proc Command {what} {
55    global w implay imstop
56
57    $w.m $what
58    switch -- $what {
59	play {
60	    bind $w.f.ss <Button-1> {Command stop}
61	    $w.f.ss configure -image $imstop
62	}
63	stop {
64	    bind $w.f.ss <Button-1> {Command play}
65	    $w.f.ss configure -image $implay
66	}
67    }
68}
69if {[tk windowingsystem] eq "aqua"} {
70    quicktimetcl::systemui allhidden
71}
72$m configure -width $newwidth -height $newheight
73pack $m -side $side
74raise $w
75update
76Command play
77$m callback $timeArr(-movieduration) End
78
79
80