summaryrefslogtreecommitdiff
path: root/Build/source/utils/m-tx/mtx-0.60d/uptext.pas
blob: 16bebc7556f0a11cf94899781025b54084bcfbba (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
unit uptext;
{ Insert and translate uptext }

interface

procedure initUptext;
procedure clearUptext;
function uptextLineNo(voice: integer): integer;
procedure setUptextLineNo(voice, lno: integer);
procedure addUptext(voice: integer; var no_uptext: boolean;
  var pretex: string);

implementation uses globals, strings, mtxline, utility;

type uptext_info = record
  uptext, uptext_adjust, uptext_lcz: integer;
  uptext_font: string;
  end;

var U: array[voice_index] of uptext_info;

function uptextLineNo(voice: integer): integer;
begin uptextLineNo := U[voice].uptext; end;

procedure setUptextLineNo(voice, lno: integer);
begin U[voice].uptext := lno; end;

procedure clearUptext;
  var voice: voice_index;
begin for voice:=1 to nvoices do U[voice].uptext:=0; end;

procedure initUptext;
  var voice: voice_index;
begin  for voice:=1 to nvoices do with U[voice] do
  begin
    uptext_adjust:=0; uptext_lcz:=3; uptext_font:='';
  end;
end;

procedure textTranslate(var uptext, font: string);
  var k: integer;
begin
  if uptext='' then exit;
  repeat k := pos1('%',uptext);
    if k>0 then uptext:=
      substr(uptext,1,k-1)+'{\mtxFlat}'+substr(uptext,k+1,length(uptext)-k);
  until k=0;
  repeat k := pos1('#',uptext);
    if k>0 then uptext:=
      substr(uptext,1,k-1)+'{\mtxSharp}'+substr(uptext,k+1,length(uptext)-k);
  until k=0;
  case uptext[1] of
  '<': if uptext='<' then uptext:='\mtxIcresc'
    else if uptext='<.' then uptext:='\mtxTcresc'
     else begin
       predelete(uptext,1); uptext:='\mtxCresc{'+uptext+'}'
     end;
  '>': if uptext='>' then uptext:='\mtxIdecresc'
    else if uptext='>.' then uptext:='\mtxTdecresc'
    else begin
      predelete(uptext,1); uptext:='\mtxDecresc{'+uptext+'}'
    end;
  else for k:=1 to length(uptext) do if pos1(uptext[k],'mpfzrs~')=0 then exit;
  end;
  font:='\mtxPF';
end;

procedure addUptext(voice: integer; var no_uptext: boolean;
  var pretex: string);
    var w, font: string;
        adj: integer;
    const default = 10;  under = -14;
          lcz: string[3] = 'lcz';
    procedure adjustUptext;
      var letter: char;
          force: boolean;
    begin  delete1(w,1); force:=false;
      while w<>'' do with U[voice] do
      begin letter:=w[1]; delete1(w,1); with U[voice] do
        case letter of
    '<':  if uptext_lcz>1 then dec(uptext_lcz);
    '>':  if uptext_lcz<3 then inc(uptext_lcz);
    '^':  uptext_adjust:=0;
    'v':  uptext_adjust:=under;
    '=':  force:=true;
'+','-':  begin if w<>'' then getNum(w,adj) else adj:=0;
            if letter = '-' then adj := -adj;
            if force then uptext_adjust := adj else inc(uptext_adjust,adj);
            w:='';
          end;
    else  error3(voice,'Unknown uptext adjustment');
        end;
      end;
      w:='!';
    end;

    begin  
    with U[voice] do begin
      if uptext=0 then no_uptext := true;
      if no_uptext then exit;
      repeat
        w := GetNextWord(P[uptext],blank,dummy);
        if (w=barsym) or (w='') then no_uptext:=true;
        if (w=tilde) or no_uptext then exit;
        if w[1]='!' then begin uptext_font:=w; uptext_font[1]:='\'; end;
        if w[1]='@' then adjustUptext;
      until w[1]<>'!';  { ! is a kludge, will get me in trouble later }
      font:=uptext_font;  textTranslate(w,font);
      if font<>'' then w:=font+'{'+w+'}';
      case lcz[uptext_lcz] of
'l':    w:='\mtxLchar{' + toString(default+uptext_adjust) + '}{' + w + '}';
'c':    w:='\mtxCchar{' + toString(default+uptext_adjust) + '}{' + w + '}';
'z':    w:='\mtxZchar{' + toString(default+uptext_adjust) + '}{' + w + '}';
      end;
      pretex:=pretex+w;
    end;
  end;

end.