Program MidiPond; Uses SysUtils,Algemeen, MidiDoos, LilyBiep; var Bron,Doel : string; normaal : integer; procedure Some_Help; begin Writeln('MIDIPOND'); Writeln; Writeln('Converts MidiFile to LilyPond input file'); Writeln; Writeln('Syntax: [program] [IMF] [OTF]'); Writeln; Writeln('IMF = name of input MidiFile'); Writeln('OTF = name of output LY File'); Writeln; Writeln('Warning. MidiFile (special) type 1 to be preferred'); Writeln('First track containing Meta events (no lyric) only'); Writeln('Each other track corresponding with 1 midi channel'); Writeln('ONE2NUL/NUL2ONE may be useful to accomplish things'); Writeln('Known shortcomings: NO tuplets other than triplets'); Writeln; Writeln('Syntax: [program] [IMF]'); Writeln; Writeln('Extracts IMF TimeStamp & Key Signature statistics'); Writeln('Key Signature on top is the default Key Signature'); end; procedure Read_Parameters(var OK : boolean); var tel : byte; begin OK := true; tel := ParamCount; normaal := tel; if (tel < 1) or (tel > 2) then begin Some_Help; OK := false; Exit; end; Bron := ParamStr(1); if not FileExists(Bron) then begin Writeln(Bron + ': does Not exist'); OK := false; Exit; end; Doel := ''; if tel = 2 then Doel := ParamStr(2); end; function merk(S : string; nr : integer; letter : char) : string; var C,U : string; begin U := S; SetLength(C,2); C[1] := char(nr + $41); C[2] := letter; if Pos('#',S) > 0 then U := vervang(S,'#',C); merk := U; end; procedure MidiTime(tikken : integer; noot : gegevens; var onthou : gegevens); var dt,k,L : integer; begin L := Length(noot); for k := 1 to L-1 do begin dt := noot[k].stamp - noot[k-1].stamp; opslaan(onthou,dt); end; end; procedure Overzicht(tikken : integer; onthou : gegevens); var OK : boolean; getal,grond,power : integer; k,L : integer; R,ly : string; begin grond := basis(tikken); power := macht(tikken); Writeln; Writeln('----------------------------'); Writeln('Quarter Note Ticks = ',tikken); Writeln('----------------------------'); Writeln('Basic Time Unit = ',grond); Writeln('----------------------------'); Writeln('Quarter Note Power = ',power); Writeln('----------------------------'); Straight(onthou); L := Length(onthou); Writeln('Value':6,'Times':6,'Binary':20,'LilyPond':20); Writeln('=====':6,'=====':6,'======':20,'========':20); OK := true; for k := 0 to L-1 do begin getal := onthou[k].stamp; R := ''; if (getal mod grond) = 0 then R := Binair(getal div grond); ly := LilyTime(getal,tikken,false); ly := vervang(ly,' ','~'); if Length(ly) > 20 then ly := Copy(ly,1,16) + ' OK'; if getal = 0 then ly := 'OK'; if Length(ly) = 0 then OK := false; Writeln(getal:6,onthou[k].getal:6,R:20,ly:20); end; if OK then Writeln('Free Sheet Music with LilyPond possible in principle') else Writeln('Errors in LY file: NO good Sheet Music with LilyPond'); end; procedure HoofdRoutine; { Beginning of Main program } const kopje : array[0..0] of string = ('\version "2.14.0" % necessary for upgrading to future LilyPond versions' ); start : array[0..2] of string = ('' ,'part# = \new Staff {' ,'%' ); einde : array[0..1] of string = ('%' ,'}' ); een : array[0..2] of string = ('' ,'\score {' ,' <<' ); twee : array[0..0] of string = (' \part#' ); drie : array[0..3] of string = (' >>' ,' \layout{}' ,'% \midi{}' ,'}' ); zingt : array[0..2] of string = ('' ,'part# = \new Lyrics' ,' \lyricmode {' ); var MF : Midi; OTF : TextFile; OK,bas : boolean; muziek,lyriek : array of boolean; maat,noot,staf,aard,zang,onthou : gegevens; punt,k,L,trk,max,sleutel : integer; begin Read_Parameters(OK); if not OK then Exit; MF := Midi.Create; MF.Read_MidiFile(Bron); MF.Check_Structure(OK); if not OK then Exit; if normaal > 1 then begin AssignFile(OTF,Doel); Rewrite(OTF); end; SetLength(onthou,0); max := MaxTime(MF); SetLength(staf,0); TimeSigs(MF,max,staf); SetLength(maat,0); Get_Measures(staf,maat); L := Length(maat); for k := 0 to L-1 do maat[k].tekst := '% ' + Letterlijk(k); sleutel := Key_information(MF,(normaal<2)); KeySigs(MF,aard,sleutel); L := Length(kopje); if normaal > 1 then for k := 0 to L-1 do Writeln(OTF,kopje[k]); punt := 14; SetLength(muziek,MF.Tracks); for trk := 0 to MF.Tracks-1 do begin muziek[trk] := Notatie(MF,punt,noot); if not muziek[trk] then Continue; Krimpen(noot); bas := BassKey(noot); noot := TwoMerge(noot,kopieer(maat,'se')); if normaal < 2 then MidiTime(MF.Ticks,noot,onthou); Aanpassen(noot); L := Length(start); if normaal > 1 then for k := 0 to L-1 do Writeln(OTF,merk(start[k],trk,'M')); if normaal > 1 then if bas then Writeln(OTF,' \clef bass') else Writeln(OTF,' \clef treble'); noot := TwoMerge(kopieer(staf,'segt'),noot); noot := TwoMerge(kopieer(aard,'segt'),noot); noot := TwoMerge(kopieer(maat,'segt'),noot); LilyScore(MF.Ticks,noot); L := Length(noot); if normaal > 1 then for k := 0 to L-1 do if Length(noot[k].tekst) > 0 then begin Write(OTF,' ',noot[k].tekst); if noot[k].tekst[1] = '%' then Writeln(OTF); end; L := Length(einde); if normaal > 1 then for k := 0 to L-1 do Writeln(OTF,einde[k]); end; punt := 14; SetLength(lyriek,MF.Tracks); for trk := 0 to MF.Tracks-1 do begin lyriek[trk] := Lilyriek(MF,punt,zang); if not lyriek[trk] then Continue; L := Length(maat); for k := 0 to L-1 do maat[k].tekst := '_'; zang := TwoMerge(kopieer(maat,'segt'),zang); if normaal < 2 then MidiTime(MF.Ticks,zang,onthou); LilyText(MF.Ticks,zang); L := Length(zingt); if normaal > 1 then for k := 0 to L-1 do Writeln(OTF,merk(zingt[k],trk,'L')); L := Length(maat); for k := 0 to L-1 do maat[k].tekst := '% ' + Letterlijk(k); zang := TwoMerge(kopieer(maat,'segt'),zang); L := Length(zang); if normaal > 1 then for k := 0 to L-1 do if Length(zang[k].tekst) > 0 then begin Write(OTF,' ',zang[k].tekst); if zang[k].tekst[1] = '%' then Writeln(OTF); end; L := Length(einde); if normaal > 1 then for k := 0 to L-1 do Writeln(OTF,einde[k]); end; if normaal < 2 then Overzicht(MF.Ticks,onthou); if normaal < 2 then Exit; L := Length(een); for k := 0 to L-1 do Writeln(OTF,een[k]); L := Length(twee); for trk := 0 to MF.Tracks-1 do begin if muziek[trk] then for k := 0 to L-1 do Writeln(OTF,merk(twee[k],trk,'M')); if lyriek[trk] then for k := 0 to L-1 do Writeln(OTF,merk(twee[k],trk,'L')); end; L := Length(drie); for k := 0 to L-1 do Writeln(OTF,drie[k]); Close(OTF); end; begin HoofdRoutine; end.