summaryrefslogtreecommitdiff
path: root/Build/source/utils/m-tx/mtx-0.60d/notes.pas
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/utils/m-tx/mtx-0.60d/notes.pas')
-rw-r--r--Build/source/utils/m-tx/mtx-0.60d/notes.pas280
1 files changed, 280 insertions, 0 deletions
diff --git a/Build/source/utils/m-tx/mtx-0.60d/notes.pas b/Build/source/utils/m-tx/mtx-0.60d/notes.pas
new file mode 100644
index 00000000000..3fdb9edb3c2
--- /dev/null
+++ b/Build/source/utils/m-tx/mtx-0.60d/notes.pas
@@ -0,0 +1,280 @@
+unit notes;
+
+interface uses control;
+
+const count64: array['0'..'9'] of integer =
+ ( 64, 4, 32, 2, 16, 0, 1, 0, 8, 128 );
+
+procedure processNote(var note, xnote: string; dur1: char; var dur: char;
+ var count: integer);
+function durationCode (note: string): char;
+function octaveCode (note: string): char;
+procedure removeOctaveCode(code: char; var note: string);
+procedure insertOctaveCode(code: char; var note: string);
+procedure translateSolfa(var nt: char);
+
+implementation uses strings, globals;
+
+type
+
+parsedNote = record
+ name: char;
+ duration: string[1];
+ octave: string[8];
+ accidental, whatever, dotgroup, xtuplet: string[16];
+ shortcut: string[32];
+end;
+
+procedure printNote(n: parsedNote);
+begin with n do writeln(name,'|',duration,'|',octave,'|',accidental,'|',
+ whatever,'|',dotgroup,'|',xtuplet,'|',shortcut)
+end;
+
+{ If rearrangeNote is TRUE, translate original note to the following form:
+ 1. Note name.
+ 2. Duration.
+ 3. Octave adjustments.
+ 4. Everything except the other six items.
+ 5. Accidental with adjustments (rest: height adjustment)
+ 6. Dot with adjustments.
+ 7. Xtuplet group.
+}
+
+procedure translateSolfa(var nt: char);
+ var k: integer;
+begin if solfaNoteNames then
+ begin k:=pos1(nt,solfa_names); if k>0 then nt:=has_duration[k]
+ end
+end;
+
+function durationCode (note: string): char;
+ var code: char;
+ begin durationCode:=unspecified; if length(note)>1 then
+ begin code:=note[2]; if pos1(code,durations)>0 then durationCode:=code
+ end
+ end;
+
+function half ( dur: char ) : char;
+ var k: integer;
+ begin k:= pos1 (dur, durations ); half := dur;
+ if k=0 then error ('Invalid duration '+dur,print)
+ else if k>ndurs then error (dur+' is too short to halve',print)
+ else half := durations[k+1];
+ end;
+
+procedure addDuration ( var note: string; dur: char);
+begin if insertDuration then insertchar(dur,note,2); end;
+
+{ Extract procedures. All of these remove part of "note" (sometimes
+ the part is empty) and put it somewhere else. The part may be anywhere
+ in "note", except when otherwise specified.}
+
+{ Unconditionally extracts the first character. }
+
+procedure extractFirst(var note: string; var first: char);
+begin first:=note[1]; predelete(note,1)
+end;
+
+{ Extracts at most one of the characters in "hits". }
+
+procedure extractOneOf(var note: string; hits: string; var hit: string);
+ var i, l: integer;
+begin l:=length(note); hit:='';
+ for i:=1 to l do if pos1(note[i],hits)>0 then
+ begin hit:=note[i]; delete1(note,i); exit;
+ end;
+end;
+
+{ Extracts contiguous characters in "hits" until no more are found.
+ There may be more later. }
+
+procedure extractContiguous(var note: string; hits: string; var hit: string);
+ var i, l, len: integer;
+begin l:=length(note); len:=l; hit:='';
+ for i:=1 to l do if pos1(note[i],hits)>0 then
+ begin
+ repeat if pos1(note[i],hits)=0 then exit;
+ hit:=hit+note[i]; delete1(note,i); dec(len)
+ until len<i;
+ exit;
+ end;
+end;
+
+{ Extracts the specified character and everything after it. }
+
+procedure extractAfter(var note: string; delim: char; var tail: string);
+ var newlen: integer;
+begin newlen:=pos1(delim,note); tail:=''; if newlen=0 then exit;
+ dec(newlen); tail:=note; predelete(tail,newlen); note[0]:=char(newlen);
+end;
+
+{ Extracts the dot shortcut part of a note: comma shortcut is no problem
+ because a comma cannot be part of a number. }
+
+procedure extractDotShortcut(var note: string; var tail: string);
+ var names, tail2: string;
+ l, lt: integer;
+ ch: char;
+begin extractAfter(note,'.',tail); l:=1; lt:=length(tail);
+ if (l<lt) and (tail[2]='.') then l:=2;
+ if solfaNoteNames then names:=solfa_names else names:=has_duration;
+ if (l<lt) and (pos1(tail[l+1],names)>0) then
+ begin translateSolfa(tail[l+1]); exit end;
+ if l=2 then error('".." followed by non-note',print);
+ if l>=lt then begin note:=note+tail; tail:=''; exit end;
+ ch:=tail[1]; predelete(tail,1);
+ extractDotShortcut(tail,tail2); note:=note+ch+tail; tail:=tail2;
+end;
+
+{ Extracts a signed number. }
+
+procedure extractSignedNumber(var note, number: string);
+ var k: integer;
+ note0: string;
+begin k:=pos1('+',note); if k=0 then k:=pos1('-',note);
+ number:=''; if k=0 then exit;
+ note0:=note;
+ repeat number:=number+note[k]; delete1(note,k)
+ until (k>length(note)) or (note[k]<>'0') and (pos1(note[k],digits)=0);
+ if length(number)=1 then begin note:=note0; number:='' end
+end;
+
+{ Extracts a symbol followed by optional +- or <> shift indicators }
+
+procedure extractGroup(var note: string; delim: char; var group: string);
+ var gl, k, k0: integer;
+ probe, nonumber: boolean;
+ tail: string;
+ procedure tryMore;
+ begin while (k<=gl) and (group[k]=group[1]) do inc(k) end;
+ procedure try(s: string);
+ begin probe:=(k<gl) and (pos1(group[k],s)>0); if probe then inc(k)
+ end;
+ procedure tryNumber;
+ var dot: boolean;
+ begin nonumber:=true; dot:=false;
+ while (k<=gl) and (pos1(group[k],digitsdot)>0) do
+ begin inc(k); if group[k]='.' then
+ if dot then error('Extra dot in number',print) else dot:=true
+ else nonumber:=false
+ end
+ end;
+begin extractAfter(note,delim,group); if group='' then exit;
+ gl:=length(group); k:=2;
+ if (gl>1) and (group[2]=':') then k:=3 else
+ begin tryMore;
+ k0:=k; try('+-<>'); if probe then tryNumber; if nonumber then k:=k0;
+ k0:=k; try('+-<>'); if probe then tryNumber; if nonumber then k:=k0;
+ end;
+ tail:=group; dec(k); group[0]:=char(k); predelete(tail,k);
+ note:=note+tail
+end;
+
+procedure parseNote(note: string; var pnote: parsedNote);
+var onlymidi: string;
+begin with pnote do
+ begin
+ shortcut:=''; xtuplet:=''; accidental:=''; dotgroup:='';
+ duration:=''; octave:=''; onlymidi:='';
+ extractFirst(note,name);
+ extractAfter(note,'x',xtuplet);
+ extractAfter(note,',',shortcut);
+ if shortcut='' then extractDotShortcut(note,shortcut);
+ if name<>rest then
+ begin extractGroup(note,'s',accidental);
+ if accidental='' then extractGroup(note,'f',accidental);
+ if accidental='' then extractGroup(note,'n',accidental);
+ end;
+{ Look for 'i' or 'c' anywhere in what is left of note.}
+ if accidental<>'' then
+ begin extractOneOf(note,'ic',onlymidi); accidental:=accidental+onlymidi
+ end;
+ extractGroup(note,'d',dotgroup);
+ if name=rest then extractSignedNumber(note,accidental);
+ extractOneOf(note,durations,duration);
+ if note<>rest then extractContiguous(note,'=+-',octave);
+ if (length(note)>0) and (note[1]>='0') and (note[1]<='9')
+ then begin octave:=note[1]+octave; delete1(note,1) end;
+ whatever := note
+ end
+end;
+
+{ On input: "note" is a note word; "dur1" is the default duration.
+ On output: "note" has possibly been modified;
+ possibly been split into two parts, the second being "shortcut";
+ "dur" is the suggested new default duration;
+ "count" is the count of the total of "note" and "shortcut" }
+procedure processNote(var note, xnote: string; dur1: char; var dur: char;
+ var count: integer);
+var sc, origdur: string[2];
+ multiplicity, l: integer;
+ pnote: parsedNote;
+begin xnote:=''; dur:=dur1;
+ if (note='') or not isNoteOrRest(note) or isPause(note) then exit;
+ parseNote(note, pnote);
+ if debugMode then begin write(note,' => '); printNote(pnote) end;
+ with pnote do
+ begin
+ if pos1('.',whatever)>0 then warning('Suspicious dot in word '+note,print);
+ origdur := duration;
+ if duration='' then dur:=dur1 else dur:=duration[1];
+ count:=count64[dur]; if dotgroup<>'' then
+ begin inc(count,count div 2);
+ if startswith(dotgroup,'dd') then inc(count,count div 6)
+ end;
+ duration:=dur; if shortcut<>'' then
+ begin
+ if dotgroup<>'' then
+ error('You may not explicitly dot a note with a shortcut',print);
+ sc:=shortcut[1]; predelete(shortcut,1);
+ if sc='.' then
+ begin multiplicity:=1;
+ if shortcut[1]='.' then
+ begin inc(multiplicity); predelete(shortcut,1); sc:=sc+'.' end;
+ inc(count,count); dur1:=duration[1];
+ for l:=1 to multiplicity do
+ begin dotgroup:=dotgroup+dotcode; dur1:=half(dur1) end;
+ addDuration(shortcut,dur1);
+ end else
+ begin addDuration(shortcut,half(duration[1]));
+ inc(count,count div 2)
+ end
+ end;
+ if not insertDuration then duration := origdur;
+ if rearrangeNote
+ then note := name + duration + octave + whatever
+ + accidental + dotgroup + xtuplet
+ else shortcut:=' ';
+ if not insertDuration and (shortcut<>'') then shortcut:=sc+shortcut;
+ xnote:=shortcut
+ end
+end;
+
+function octaveCode (note: string): char;
+ var pnote: parsedNote;
+begin {if debugMode then write('Octave code in note "',note,'" is ');}
+ parseNote(note,pnote); with pnote do
+ begin {if debugMode then writeln('"',octave,'"');}
+ if octave='' then octaveCode:=' ' else octaveCode:=octave[1]; end
+end;
+
+procedure removeOctaveCode(code: char; var note: string);
+ var k, l: integer;
+begin {if debugMode then writeln('remove ',code,' from ',note);} l:=length(note);
+ for k:=1 to l do if note[k]=code then
+ if (k=l) or (note[k+1]<'0') or (note[k+1]>'9') then
+ begin delete1(note,k); exit end;
+ fatalError('Code not found in note')
+end;
+
+procedure insertOctaveCode(code: char; var note: string);
+ var l: integer;
+begin {if debugMode then writeln('insert ',code,' into ',note); }
+ l:=length(note);
+ if (l<2) or (note[2]<'0') or (note[2]>'9') then
+ fatalError('Trying to insert octave into note without duration');
+ if (l<=2) or (note[3]<'0') or (note[3]>'9') then insertChar(code,note,3)
+ else writeln('Not inserting "',code,'", note already has octave code"')
+end;
+
+end.