1
2package require QuickTimeTcl
3
4set ans [tk_messageBox -type yesno -icon info -message  \
5  {Open as many images you like, press cancel when you have opened\
6  the last one. Proceed?}]
7if {$ans == "no"} {
8    return
9}
10set theFile [tk_getOpenFile -title {Pick Image}]
11if {$theFile == ""} {
12    return
13}
14set imageList [image create photo -file $theFile]
15set width [image width $imageList]
16set height [image height $imageList]
17while {$theFile != ""} {
18    set theFile [tk_getOpenFile -title {Pick Image}]
19    if {$theFile != ""} {
20	set newImage [image create photo -file $theFile]
21	lappend imageList $newImage
22    }
23}
24set theFile [tk_getSaveFile -title {Save File}  \
25  -initialfile sequence.mov]
26movie .m
27.m new $theFile
28.m tracks new video $width $height
29pack .m
30update
31.m tracks add picture 1 0 300 $imageList -dialog 1 -compressor {smc } -colordepth 8
32#.m tracks add picture 1 0 300 $imageList -dialog 1 -compressor jpeg
33.m save
34