program chor2dtn; Uses SysUtils, Algemeen, MidiText; type gegeven = record naam : string; tonen : array[0..4] of byte; end; stel = array[0..12] of gegeven; const standaard : stel = ( (naam : 'C' ; tonen : ( 60, 64, 67,$80,$80) ), (naam : 'Cm' ; tonen : ( 60, 63, 67,$80,$80) ), (naam : 'C7' ; tonen : ( 60, 64, 67, 70,$80) ), (naam : 'C+' ; tonen : ( 60, 64, 68,$80,$80) ), (naam : 'Cdim' ; tonen : ( 60, 63, 66, 69,$80) ), (naam : 'C6' ; tonen : ( 60, 64, 67, 69,$80) ), (naam : 'Cm6' ; tonen : ( 60, 63, 67, 69,$80) ), (naam : 'Cm7' ; tonen : ( 60, 63, 67, 70,$80) ), (naam : 'C7-5' ; tonen : ( 60, 64, 66, 70,$80) ), (naam : 'C7+5' ; tonen : ( 60, 64, 68, 70,$80) ), (naam : 'Cmaj7'; tonen : ( 60, 64, 67, 71,$80) ), (naam : 'C9' ; tonen : ( 60, 64, 67, 70, 74) ), (naam : 'C7-9' ; tonen : ( 60, 64, 67, 70, 73) )); Ladder : array[1..7] of byte = (69, 71, 60, 62, 64, 65, 67 ); { A B C D E F G } var ITF,OTF : TextFile; procedure Some_Help; begin Writeln('CHOR2DTN'); Writeln; Writeln('Converts Chords to Time/Note Differences'); Writeln; Writeln('Syntax: [program] [ITF] [OTF]'); Writeln; Writeln('ITF = name of Input Chords TextFile'); Writeln('OTF = name of Output DTN TextFile'); end; procedure Read_Parameters(var OK : boolean); var Bron,Doel : string; begin OK := true; if ParamCount <> 2 then begin Some_Help; OK := false; Exit; end; Bron := ParamStr(1); Doel := ParamStr(2); if not FileExists(Bron) then begin Writeln(Bron + ': does Not exist'); OK := false; Exit; end; AssignFile(ITF, Bron); Reset(ITF); AssignFile(OTF, Doel); Rewrite(OTF); end; procedure Muziek(chord : string; var noten : bytes; var OK : boolean); var zwart : boolean; ligging,grond : byte; k,hier,let,L : integer; deze : string; begin SetLength(noten,0); OK := Length(chord) > 1; if not OK then begin Writeln(chord,' : is not a proper Chord'); Exit; end; OK := (chord[1] >= '1') and (chord[1] <= '5'); if not OK then begin Writeln(chord,' : wrong at character position 1'); Exit; end; OK := ((chord[2] >= 'A') and (chord[2] <= 'G')); if not OK then begin Writeln(chord,' : wrong at character position 2'); Exit; end; zwart := false; grond := Ladder[byte(chord[2]) - 64]; if Length(chord) > 2 then begin if chord[3] = '#' then grond := grond + 1; if chord[3] = 'b' then grond := grond - 1; if chord[3] in ['b','#'] then zwart := true; end; deze := ''; if not zwart then deze := Copy(chord,2,1) else deze := Copy(chord,2,2); if deze <> 'C' then chord := Vervang(chord,deze,'C'); hier := 0; OK := false; L := Length(chord); for k := 0 to 12 do begin if Copy(chord,2,L-1) = standaard[k].naam then begin hier := k; OK := true; Break; end; end; if not OK then begin Writeln(chord,' : not in Dictionary of Chords'); Exit; end; ligging := byte(chord[1]) - 48; SetLength(noten,5); for k := 0 to 4 do noten[k] := standaard[hier].tonen[k]; let := 5; for k := 4 downto 0 do if noten[k] = $80 then let := let - 1; OK := (ligging <= let); if not OK then begin Writeln(chord,' : impossible Chord to play'); Exit; end; SetLength(noten,let); for k := 0 to let-1 do noten[k] := noten[k] + grond - 60; for k := 0 to (ligging - 2) do noten[k] := noten[k] + 12; { Bass } SetLength(noten,let+1); for k := let downto 1 do noten[k] := noten[k-1]; noten[0] := grond - 12; end; function Verschil(one,two : bytes) : bytes; var V : set of byte; A,B,k : integer; n : byte; uit : bytes; begin A := Length(one); B := Length(two); V := []; for k := 0 to A-1 do V := V + [ one[k] ]; for k := 0 to B-1 do V := V - [ two[k] ]; k := 0; SetLength(uit,128); for n := 0 to 127 do if n in V then begin uit[k] := n; k := k + 1; end; SetLength(uit,k); Verschil := uit; end; procedure HoofdRoutine; var OK : boolean; regel,ch : string; reeks : lijst; R,k,n,L : integer; noten,vorig,hulp : bytes; procedure Afdruk(n : integer; toets,hard : byte); var riedel : bytes; begin SetLength(riedel,3); if n = 0 then riedel[0] := $92 else riedel[0] := $91; riedel[1] := toets; riedel[2] := hard; Writeln(OTF,Any_Event(riedel)); end; begin Read_Parameters(OK); if not OK then Exit; Writeln(OTF,'File 0 (1) 120'); Writeln(OTF,'Track'); { Writeln(OTF,'0'); } Writeln(OTF,'Program $1 $30'); { Writeln(OTF,'0'); } Writeln(OTF,'Program $2 $30'); Writeln(OTF,'480'); ch := '0'; SetLength(reeks,0); while not EoF(ITF) do begin Readln(ITF, regel); reeks := Woorden(regel); R := Length(reeks); SetLength(noten,0); SetLength(vorig,0); SetLength(hulp,0); for k := 0 to R-1 do begin L := Length(noten); SetLength(vorig,L); for n := 0 to L-1 do vorig[n] := noten[n]; Muziek(reeks[k],noten,OK); if not OK then Continue; hulp := Verschil(noten,vorig); L := Length(hulp); for n := 0 to L-1 do begin Afdruk(n,hulp[n],100); { if n < L-1 then Writeln(OTF,'0'); } end; hulp := Verschil(vorig,noten); L := Length(hulp); { if L > 0 then Writeln(OTF,'0'); } for n := L-1 downto 0 do begin { if n < L-1 then Writeln(OTF,'0'); } Afdruk(n,hulp[n],0); end; Writeln(OTF,'480 chord = ',reeks[k]); end; L := Length(noten); for n := L-1 downto 0 do begin { if n < L-1 then Writeln(OTF,'0'); } Afdruk(n,noten[n],0); end; Writeln(OTF,'0 NewLine'); end; if OK then Writeln(OTF,'Meta $2F(TrkEnd)') else Writeln(OTF,'Input Errors'); CloseFile(OTF); CloseFile(ITF); end; begin HoofdRoutine; end.