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