diff options
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.pas | 280 |
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. |