← Back to branch summary

~ubuntu-branches/ubuntu/utopic/texlive-bin/utopic

« back to all changes in this revision

Viewing changes to utils/mtx/mtx-0.60d/notes.pas

  • Committer: Package Import Robot
  • Author(s): Norbert Preining
  • Date: 2012-05-07 10:47:49 UTC
  • mfrom: (1.2.4)
  • Revision ID: package-import@ubuntu.com-20120507104749-p00ot5sajjbkp1hp
Tags: 2011.20120507-1
* new upstream checkout: uptex 1.10
* drop patches for config file inclusion in (x)dvipdfmx, included upstream
* add man page for etex
* include pmpost patches and build it
* adapt/unfuzzify patches for current sources
* disable mtx building, we have prepmx package in Debian

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/mtx/mtx-0.60d/notes.pas
 
1
unit notes;
 
2
 
 
3
interface uses control;
 
4
 
 
5
const count64: array['0'..'9'] of integer =
 
6
         ( 64, 4, 32, 2, 16, 0, 1, 0, 8, 128 );
 
7
 
 
8
procedure processNote(var note, xnote: string; dur1: char; var dur: char;
 
9
  var count: integer);
 
10
function durationCode (note: string): char;
 
11
function octaveCode (note: string): char;
 
12
procedure removeOctaveCode(code: char; var note: string);
 
13
procedure insertOctaveCode(code: char; var note: string);
 
14
procedure translateSolfa(var nt: char);
 
15
 
 
16
implementation uses strings, globals;
 
17
 
 
18
type 
 
19
 
 
20
parsedNote = record
 
21
  name: char;
 
22
  duration: string[1];
 
23
  octave: string[8];
 
24
  accidental, whatever, dotgroup, xtuplet: string[16];
 
25
  shortcut: string[32];
 
26
end;
 
27
 
 
28
procedure printNote(n: parsedNote);
 
29
begin with n do writeln(name,'|',duration,'|',octave,'|',accidental,'|',
 
30
  whatever,'|',dotgroup,'|',xtuplet,'|',shortcut)  
 
31
end;
 
32
 
 
33
{ If rearrangeNote is TRUE, translate original note to the following form:
 
34
  1. Note name.
 
35
  2. Duration.
 
36
  3. Octave adjustments.
 
37
  4. Everything except the other six items.
 
38
  5. Accidental with adjustments (rest: height adjustment)
 
39
  6. Dot with adjustments.
 
40
  7. Xtuplet group.
 
41
}
 
42
 
 
43
procedure translateSolfa(var nt: char);
 
44
  var k: integer;
 
45
begin  if solfaNoteNames then
 
46
  begin k:=pos1(nt,solfa_names);  if k>0 then nt:=has_duration[k]
 
47
  end
 
48
end;
 
49
 
 
50
function durationCode (note: string): char;
 
51
  var code: char;
 
52
  begin  durationCode:=unspecified;  if length(note)>1 then
 
53
    begin  code:=note[2]; if pos1(code,durations)>0 then durationCode:=code
 
54
    end
 
55
  end;
 
56
 
 
57
function half ( dur: char ) : char;
 
58
  var k: integer;
 
59
  begin  k:= pos1 (dur, durations );  half := dur;
 
60
    if k=0 then error ('Invalid duration '+dur,print)
 
61
    else if k>ndurs then error (dur+' is too short to halve',print)
 
62
    else half := durations[k+1];
 
63
  end;
 
64
 
 
65
procedure addDuration ( var note: string; dur: char);
 
66
begin if insertDuration then insertchar(dur,note,2); end;
 
67
 
 
68
{ Extract procedures.  All of these remove part of "note" (sometimes
 
69
  the part is empty) and put it somewhere else.  The part may be anywhere
 
70
  in "note", except when otherwise specified.}
 
71
 
 
72
{ Unconditionally extracts the first character. } 
 
73
 
 
74
procedure extractFirst(var note: string; var first: char);
 
75
begin first:=note[1];  predelete(note,1)
 
76
end;
 
77
 
 
78
{ Extracts at most one of the characters in "hits". }
 
79
 
 
80
procedure extractOneOf(var note: string; hits: string; var hit: string);
 
81
  var i, l: integer;
 
82
begin  l:=length(note); hit:='';
 
83
  for i:=1 to l do  if pos1(note[i],hits)>0 then
 
84
  begin hit:=note[i]; delete1(note,i); exit;
 
85
  end;
 
86
end;
 
87
 
 
88
{ Extracts contiguous characters in "hits" until no more are found.
 
89
  There may be more later. }
 
90
 
 
91
procedure extractContiguous(var note: string; hits: string; var hit: string);
 
92
  var i, l, len: integer;
 
93
begin  l:=length(note); len:=l; hit:='';
 
94
  for i:=1 to l do  if pos1(note[i],hits)>0 then
 
95
  begin
 
96
    repeat if pos1(note[i],hits)=0 then exit;
 
97
      hit:=hit+note[i]; delete1(note,i); dec(len)
 
98
    until len<i;
 
99
    exit;
 
100
  end;
 
101
end;
 
102
 
 
103
{ Extracts the specified character and everything after it. }
 
104
 
 
105
procedure extractAfter(var note: string; delim: char; var tail: string);
 
106
  var newlen: integer;
 
107
begin  newlen:=pos1(delim,note);  tail:='';  if newlen=0 then exit;
 
108
  dec(newlen); tail:=note; predelete(tail,newlen); note[0]:=char(newlen);
 
109
end;
 
110
 
 
111
{ Extracts the dot shortcut part of a note: comma shortcut is no problem
 
112
  because a comma cannot be part of a number. }
 
113
 
 
114
procedure extractDotShortcut(var note: string; var tail: string);
 
115
  var names, tail2: string;
 
116
      l, lt: integer;
 
117
      ch: char;
 
118
begin extractAfter(note,'.',tail); l:=1; lt:=length(tail);
 
119
  if (l<lt) and (tail[2]='.') then l:=2;
 
120
  if solfaNoteNames then names:=solfa_names else names:=has_duration;
 
121
  if (l<lt) and (pos1(tail[l+1],names)>0) then
 
122
    begin translateSolfa(tail[l+1]); exit end;
 
123
  if l=2 then error('".." followed by non-note',print);
 
124
  if l>=lt then begin note:=note+tail; tail:=''; exit end;
 
125
  ch:=tail[1]; predelete(tail,1);
 
126
  extractDotShortcut(tail,tail2); note:=note+ch+tail; tail:=tail2;
 
127
end;
 
128
 
 
129
{ Extracts a signed number. }
 
130
 
 
131
procedure extractSignedNumber(var note, number: string);
 
132
  var k: integer;
 
133
      note0: string;
 
134
begin  k:=pos1('+',note); if k=0 then k:=pos1('-',note);
 
135
  number:=''; if k=0 then exit;
 
136
  note0:=note;
 
137
  repeat number:=number+note[k]; delete1(note,k)
 
138
  until (k>length(note)) or (note[k]<>'0') and (pos1(note[k],digits)=0);
 
139
  if length(number)=1 then begin note:=note0; number:='' end
 
140
end;
 
141
 
 
142
{ Extracts a symbol followed by optional +- or <> shift indicators }
 
143
 
 
144
procedure extractGroup(var note: string; delim: char; var group: string);
 
145
  var gl, k, k0: integer;
 
146
      probe, nonumber: boolean;
 
147
      tail: string;
 
148
  procedure tryMore;
 
149
  begin  while (k<=gl) and (group[k]=group[1]) do inc(k) end;
 
150
  procedure try(s: string);
 
151
  begin  probe:=(k<gl) and (pos1(group[k],s)>0);  if probe then inc(k)
 
152
  end;
 
153
  procedure tryNumber;
 
154
    var dot: boolean;
 
155
  begin  nonumber:=true;  dot:=false;
 
156
    while (k<=gl) and (pos1(group[k],digitsdot)>0) do
 
157
    begin inc(k);  if group[k]='.' then
 
158
      if dot then error('Extra dot in number',print) else dot:=true
 
159
      else  nonumber:=false
 
160
    end
 
161
  end;
 
162
begin  extractAfter(note,delim,group); if group='' then exit;
 
163
  gl:=length(group); k:=2;
 
164
  if (gl>1) and (group[2]=':') then k:=3   else
 
165
  begin  tryMore;
 
166
    k0:=k; try('+-<>'); if probe then tryNumber;  if nonumber then k:=k0;
 
167
    k0:=k; try('+-<>'); if probe then tryNumber;  if nonumber then k:=k0;
 
168
  end;
 
169
  tail:=group; dec(k); group[0]:=char(k); predelete(tail,k);
 
170
  note:=note+tail
 
171
end;
 
172
 
 
173
procedure parseNote(note: string; var pnote: parsedNote);
 
174
var onlymidi: string;
 
175
begin  with pnote do
 
176
  begin
 
177
    shortcut:=''; xtuplet:=''; accidental:=''; dotgroup:=''; 
 
178
    duration:=''; octave:=''; onlymidi:=''; 
 
179
    extractFirst(note,name); 
 
180
    extractAfter(note,'x',xtuplet);
 
181
    extractAfter(note,',',shortcut);
 
182
    if shortcut='' then extractDotShortcut(note,shortcut);
 
183
    if name<>rest then
 
184
    begin extractGroup(note,'s',accidental);
 
185
      if accidental='' then extractGroup(note,'f',accidental);
 
186
      if accidental='' then extractGroup(note,'n',accidental);
 
187
    end;
 
188
{ Look for 'i' or 'c' anywhere in what is left of note.}
 
189
    if accidental<>'' then
 
190
    begin extractOneOf(note,'ic',onlymidi); accidental:=accidental+onlymidi
 
191
    end;
 
192
    extractGroup(note,'d',dotgroup);
 
193
    if name=rest then extractSignedNumber(note,accidental);
 
194
    extractOneOf(note,durations,duration);
 
195
    if note<>rest then extractContiguous(note,'=+-',octave);
 
196
    if (length(note)>0) and (note[1]>='0') and (note[1]<='9')
 
197
      then begin octave:=note[1]+octave; delete1(note,1) end;
 
198
    whatever := note
 
199
  end
 
200
end;
 
201
 
 
202
{ On input: "note" is a note word; "dur1" is the default duration.
 
203
  On output: "note" has possibly been modified;
 
204
    possibly been split into two parts, the second being "shortcut";
 
205
    "dur" is the suggested new default duration;
 
206
    "count" is the count of the total of "note" and "shortcut" }     
 
207
procedure processNote(var note, xnote: string; dur1: char; var dur: char;
 
208
  var count: integer);
 
209
var sc, origdur: string[2];
 
210
  multiplicity, l: integer;
 
211
  pnote: parsedNote;
 
212
begin xnote:=''; dur:=dur1;  
 
213
  if (note='') or not isNoteOrRest(note) or isPause(note) then exit;
 
214
  parseNote(note, pnote); 
 
215
  if debugMode then begin write(note,' => '); printNote(pnote) end;
 
216
  with pnote do
 
217
  begin
 
218
    if pos1('.',whatever)>0 then warning('Suspicious dot in word '+note,print);
 
219
    origdur := duration;
 
220
    if duration='' then dur:=dur1 else dur:=duration[1];
 
221
    count:=count64[dur]; if dotgroup<>'' then
 
222
    begin inc(count,count div 2);
 
223
      if startswith(dotgroup,'dd') then inc(count,count div 6)
 
224
    end;
 
225
    duration:=dur; if shortcut<>'' then
 
226
    begin  
 
227
      if dotgroup<>'' then
 
228
      error('You may not explicitly dot a note with a shortcut',print);
 
229
      sc:=shortcut[1]; predelete(shortcut,1);
 
230
      if sc='.' then
 
231
      begin  multiplicity:=1;
 
232
        if shortcut[1]='.' then
 
233
        begin inc(multiplicity); predelete(shortcut,1); sc:=sc+'.' end;
 
234
        inc(count,count);  dur1:=duration[1];
 
235
        for l:=1 to multiplicity do
 
236
        begin dotgroup:=dotgroup+dotcode; dur1:=half(dur1) end;
 
237
        addDuration(shortcut,dur1);
 
238
      end  else
 
239
      begin addDuration(shortcut,half(duration[1]));
 
240
        inc(count,count div 2)
 
241
      end
 
242
    end;
 
243
    if not insertDuration then duration := origdur;
 
244
    if rearrangeNote 
 
245
       then note := name + duration + octave + whatever 
 
246
         + accidental + dotgroup + xtuplet 
 
247
       else shortcut:=' ';
 
248
    if not insertDuration and (shortcut<>'') then shortcut:=sc+shortcut;
 
249
    xnote:=shortcut
 
250
  end
 
251
end;
 
252
 
 
253
function octaveCode (note: string): char; 
 
254
  var pnote: parsedNote;
 
255
begin {if debugMode then write('Octave code in note "',note,'" is ');}
 
256
  parseNote(note,pnote); with pnote do
 
257
  begin {if debugMode then writeln('"',octave,'"');} 
 
258
    if octave='' then octaveCode:=' ' else octaveCode:=octave[1]; end
 
259
end;
 
260
 
 
261
procedure removeOctaveCode(code: char; var note: string);
 
262
  var k, l: integer;
 
263
begin {if debugMode then writeln('remove ',code,' from ',note);} l:=length(note);
 
264
  for k:=1 to l do if note[k]=code then
 
265
    if (k=l) or (note[k+1]<'0') or (note[k+1]>'9') then
 
266
    begin delete1(note,k); exit end;
 
267
  fatalError('Code not found in note')
 
268
end;
 
269
 
 
270
procedure insertOctaveCode(code: char; var note: string);
 
271
  var l: integer;
 
272
begin {if debugMode then writeln('insert ',code,' into ',note); }
 
273
  l:=length(note);
 
274
  if (l<2) or (note[2]<'0') or (note[2]>'9') then 
 
275
    fatalError('Trying to insert octave into note without duration');
 
276
  if (l<=2) or (note[3]<'0') or (note[3]>'9') then insertChar(code,note,3)
 
277
  else writeln('Not inserting "',code,'", note already has octave code"')
 
278
end;
 
279
 
 
280
end.