program mididuur; uses SysUtils, Algemeen, MidiDoos; var Bron : string; procedure Some_Help; begin Writeln('MIDIDUUR'); Writeln; Writeln('Calculate duration of type 0 MidiFile'); Writeln; writeln('Syntax: [program] [IMF]'); Writeln; Writeln('IMF = name of 0-type MidiFile (Input)'); end; procedure Read_Parameters(var OK : boolean); var tel : integer; begin OK := true; tel := ParamCount; if tel <> 1 then begin Some_Help; OK := false; Exit; end; Bron := ParamStr(1); if not FileExists(Bron) then begin Writeln(Bron + ': does Not exist'); OK := false; end; end; function Tempo(zaken : bytes) : integer; var veel : integer; k : integer; begin veel := 0; for k := 0 to 2 do veel := (veel shl 8) or zaken[k+2]; Tempo := veel; end; function schrijf(getal : double) : string; var M,S : string; ss : integer; begin M := Letterlijk(Trunc(getal/60)); ss := Trunc(getal) mod 60; S := Letterlijk(ss); if ss < 10 then S := '0' + S; schrijf := M + ':' + S; end; procedure verwerk(IM : Midi); var punt,aantal,tikken : integer; p,d : integer; haast,tijd : double; OK : boolean; let,tmp : byte; riedel : bytes; begin tikken := IM.Ticks; punt := 14; IM.Check_Track_Header(punt,aantal,OK); p := punt; tijd := 0; haast := 1; while (p < punt+aantal) do begin d := IM.Get_Delta_Time(p); tijd := tijd + d*haast/tikken; IM.Data_Any_Event(p,riedel); let := riedel[0]; tmp := riedel[1]; if (let = $FF) and (tmp = $51) then haast := 0.000001*Tempo(riedel); end; Writeln; Writeln('Duration = ',schrijf(tijd)); end; procedure HoofdRoutine; { Beginning of Main program } var IM : Midi; OK : boolean; begin Read_Parameters(OK); if not OK then Exit; IM := Midi.Create; IM.Read_MidiFile(Bron); IM.Check_Structure(OK); if not OK then Exit; OK := (IM.Type01 = 0) and (IM.Tracks = 1); if not OK then begin Writeln('Input MidiFile is not type 0 with one track'); Writeln; Some_help; Exit; end; { We have a Go } verwerk(IM); end; BEGIN HoofdRoutine; END.