1 2package require QuickTimeTcl 3wm title . {Two Source Effect} 4 5set ans [tk_messageBox -type yesno -message \ 6 {Two still images of the same size are required. Are they ready?}] 7if {$ans == "no"} { 8 return 9} 10 11# The track id's are 1 and 2. 12# Make two images in tk from two images on disk. 13# Preferrably of the same size as the video track, else they are scaled automatically. 14set firstImage [image create photo -file [tk_getOpenFile -title {First Image}]] 15set secondImage [image create photo -file [tk_getOpenFile -title {Second Image}]] 16 17set width [image width $firstImage] 18set height [image height $firstImage] 19 20if {$tcl_platform(platform) == "windows"} { 21 set effectFile [tk_getSaveFile -title {Effect File} \ 22 -initialfile VideoEffect.mov -initialdir [file dirname [info script]]] 23} else { 24 set effectFile [tk_getSaveFile -title {Effect File} \ 25 -initialfile VideoEffect.mov] 26} 27movie .m 28.m new $effectFile 29.m tracks new video $width $height 30.m tracks new video $width $height 31pack .m 32update 33.m tracks add picture 1 0 6000 $firstImage 34.m tracks add picture 2 0 6000 $secondImage 35 36# Shift the second track to make the desired overlap. 37.m tracks configure 2 -offset 3000 38 39# Pick the wanted effect in the dialog. Choose the overlap for the duration of 40.m effect 3000 3000 1 2 41tkwait variable quicktimetcl::effectfinished 42.m save 43 44#update 45#return 46 47set ans [.m tracks new text] 48set textTrackID [lindex $ans 1] 49.m tracks add text $textTrackID 0 3000 {Two source video effect. Here it comes...} \ 50 -scrollin 1 -scrollout 1 -font {Times 24 italic} 51.m tracks add text $textTrackID 6000 3000 {It is best if images are of same size.} \ 52 -scrollin 1 -scrollout 1 -scrollreverse 1 -font {Times 24 italic} 53.m tracks configure $textTrackID -graphicsmode transparent -graphicsmodecolor black 54.m save 55 56