1# Simple edit with timecode track.
2
3package require QuickTimeTcl 3.1
4proc ControllerProc { w what {par {}} } {
5    global  selStart selDur movieTime timeId movieTimeHms selStartHms selDurHms
6
7    #puts "ControllerProc:: w=$w, what=$what, par=$par"
8    if {$w == ".fr.m"} {
9	if {$what == "setSelectionBegin"} {
10	    set selStart $par
11	    set selStartHms [converttohmstime $w $selStart]
12	} elseif {$what == "setSelectionDuration"} {
13	    set selDur $par
14	    set selDurHms [converttohmstime $w $selDur]
15	    update
16	} elseif {$what == "goToTime"} {
17	    set movieTime [lindex $par 1]
18	    set movieTimeHms [converttohmstime $w $movieTime]
19	    update
20	} elseif {$what == "play"} {
21	    if {$par != 0.0} {
22		#set movieTime ""
23		set timeId [after 100 MovieTimer $w]
24	    } else {
25		catch {after cancel $timeId}
26		set movieTime [$w time]
27		set movieTimeHms [converttohmstime $w $movieTime]
28	    }
29	}
30    }
31}
32
33proc converttohmstime {movie timemovie} {
34
35    array set timearr [$movie gettime]
36    set hunsecs [format {%02i}    \
37      [expr 100 * ($timemovie % $timearr(-movietimescale))/ \
38      $timearr(-movietimescale)]]
39    set totsecs [expr $timemovie/$timearr(-movietimescale)]
40    set totmins [expr $totsecs/60]
41    set tothours [expr $totmins/60]
42    set secs [format {%02i} [expr $totsecs % 60]]
43    set mins [format {%02i} [expr $totmins % 60]]
44
45    return "${tothours}:${mins}:${secs}.${hunsecs}"
46}
47
48proc MovieTimer {w} {
49    global  timeId movieTime movieTimeHms
50
51    set movieTime [$w time]
52    set movieTimeHms [converttohmstime $w $movieTime]
53    set timeId [after 100 MovieTimer $w]
54}
55
56# We use a variable 'this(platform)' that is more convenient for MacOS X.
57switch -- $tcl_platform(platform) {
58    unix {
59	set thisPlatform $tcl_platform(platform)
60	if {[package vcompare [info tclversion] 8.3] == 1} {
61	    if {[string equal [tk windowingsystem] "aqua"]} {
62		set thisPlatform "macosx"
63	    }
64	}
65    }
66    windows - macintosh {
67	set thisPlatform $tcl_platform(platform)
68    }
69}
70
71if {[string match "mac*" $thisPlatform]}  {
72    set sysFont(s) {Geneva 9 normal}
73    set sysFont(sb) {Geneva 9 bold}
74    set osmod Command
75} elseif {[string equal $thisPlatform "windows"]}  {
76    set sysFont(s) {Arial 8 normal}
77    set sysFont(sb) {Arial 8 bold}
78    set osmod Control
79}
80
81set bgCol #dedede
82. configure -bg $bgCol
83wm resizable . 0 0
84
85wm title . {Simple Edit}
86set myFile [tk_getOpenFile]
87if {$myFile == ""} {
88    exit
89}
90frame .fr -relief sunken -bd 1 -bg $bgCol
91set w [movie .fr.m -file $myFile -mccommand ControllerProc -mcedit 1]
92pack .fr -padx 8 -pady 8
93pack .fr.m -padx 8 -pady 8
94pack [frame .fr2 -bg $bgCol] -fill both -expand 1 -anchor w -padx 2 -side top
95label .fr2.lab1 -bg $bgCol -anchor w \
96  -text "Shift drag controller to select" -font $sysFont(s)
97label .fr2.labtime -bg $bgCol -anchor w \
98  -text "Movie time" -font $sysFont(s)
99label .fr2.labstart -bg $bgCol -anchor w \
100  -text "Select start" -font $sysFont(s)
101label .fr2.labdur -bg $bgCol -anchor w \
102  -text "Select duration" -font $sysFont(s)
103entry .fr2.enttime -width 8 -bg $bgCol -textvariable movieTime \
104  -highlightthickness 0 -bd 1 -relief sunken -font $sysFont(s)
105entry .fr2.entstart -width 8 -bg $bgCol -textvariable selStart \
106  -highlightthickness 0 -bd 1 -relief sunken -font $sysFont(s)
107entry .fr2.entdur -width 8 -bg $bgCol -textvariable selDur \
108  -highlightthickness 0 -bd 1 -relief sunken -font $sysFont(s)
109entry .fr2.enthms -width 8 -bg $bgCol -textvariable movieTimeHms \
110  -highlightthickness 0 -bd 1 -relief sunken -font $sysFont(s)
111entry .fr2.entstarthms -width 8 -bg $bgCol -textvariable selStartHms \
112  -highlightthickness 0 -bd 1 -relief sunken -font $sysFont(s)
113entry .fr2.entdurhms -width 8 -bg $bgCol -textvariable selDurHms \
114  -highlightthickness 0 -bd 1 -relief sunken -font $sysFont(s)
115
116grid .fr2.lab1 -column 0 -row 0 -columnspan 2 -sticky w -pady 0 -padx 2
117grid .fr2.labtime .fr2.labstart .fr2.labdur -sticky news -pady 1 -padx 2
118grid .fr2.enttime .fr2.entstart .fr2.entdur -sticky news -pady 3 -padx 2
119grid .fr2.enthms .fr2.entstarthms .fr2.entdurhms -sticky news -pady 4 -padx 2
120
121# Find first video track if any.
122set videoTrack -1
123if {[$w isvisual]} {
124    set desc [$w tracks full]
125    foreach trackDescList $desc {
126	array set arrDesc $trackDescList
127	if {$arrDesc(-mediatype) == "vide"} {
128	    set videoTrack $arrDesc(-trackid)
129	    break
130	}
131    }
132}
133set undoNo -1
134
135menu .menu -tearoff 0
136set m [menu .menu.file -tearoff 0]
137.menu add cascade -label {File } -menu $m
138$m add command -label {Save} -accelerator $osmod+S -command {
139    set fileName [$w save]
140}
141$m add command -label {Save As...} -command {
142    tk_messageBox -icon info -type ok -message  \
143      {The movie may not be saved self contained with this command.\
144      If you want to save a self contained movie, use the Flatten command.}
145    set f [tk_getSaveFile]
146    if {$f != ""} {
147	set fileName [$w saveas $f]
148    }
149}
150$m add command -label {Flatten...} -command {
151    set f [tk_getSaveFile]
152    if {$f != ""} {
153	$w flatten $f
154    }
155}
156$m add command -label {Compress...} -command {
157    set f [tk_getSaveFile]
158    if {$f != ""} {
159	$w compress $f 1
160    }
161}
162$m add command -label {Export...} -accelerator $osmod+E -command {
163    set fileName [$w export]
164}
165$m add command -label "Quit" -accelerator $osmod+Q -command exit
166
167set m [menu .menu.edit -tearoff 0]
168.menu add cascade -label {Edit } -menu $m
169$m add command -label {Undo} -accelerator $osmod+Z -command {
170    if {$undoNo >= 0} {
171	$w undo $undoNo
172	incr undoNo -1
173    }
174}
175$m add command -label {Cut} -accelerator $osmod+X -command {
176    set undoList [$w cut]
177    set undoNo [lindex [lindex $undoList 0] 1]
178}
179$m add command -label {Copy} -accelerator $osmod+C -command {
180    set undoList [$w copy]
181    set undoNo [lindex [lindex $undoList 0] 1]
182}
183$m add command -label {Paste} -accelerator $osmod+V -command {
184    set undoList [$w paste]
185    set undoNo [lindex [lindex $undoList 0] 1]
186}
187if {$tcl_platform(platform) == "macintosh"} {
188    $m add command -label {Paste...} -command {
189	set undoList [$w paste dialog]
190	set undoNo [lindex [lindex $undoList 0] 1]
191    }
192}
193$m add command -label {Add} -command {
194    set undoList [$w add]
195    set undoNo [lindex [lindex $undoList 0] 1]
196}
197$m add sep
198$m add command -label {Zero Source Effect...} -state disabled -command {
199    set selection [$w select]
200    set from [lindex $selection 0]
201    set duration [lindex $selection 1]
202    $w effect $from $duration
203}
204$m add command -label {One Source Effect...} -state disabled -command {
205    set selection [$w select]
206    set from [lindex $selection 0]
207    set duration [lindex $selection 1]
208    $w effect $from $duration $videoTrack
209}
210if {$videoTrack >= 0} {
211    .menu.edit entryconfigure "*Zero*" -state normal
212    .menu.edit entryconfigure "*One*" -state normal
213}
214. configure -menu .menu
215
216# Add timecode track assuming uniform fps.
217if {$videoTrack > -1} {
218    set nsamp [$w tracks media samplecount $videoTrack]
219    array set trackArr [$w tracks full $videoTrack]
220    set duration [expr $trackArr(-trackduration) / $nsamp]
221    array set timeArr [$w gettime]
222    set secsLen [expr $timeArr(-movieduration) / $timeArr(-movietimescale)]
223    set fps [expr int(double($nsamp)/double($secsLen))]
224
225    foreach {undo id} [$w timecode new 1 -foreground black -background white  \
226      -timescale $trackArr(-mediatimescale) -frameduration $duration  \
227      -framespersecond $fps] { break }
228    $w tracks configure $id -graphicsmode addmin
229}
230
231
232
233