← 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/uptext.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/uptext.pas
 
1
unit uptext;
 
2
{ Insert and translate uptext }
 
3
 
 
4
interface
 
5
 
 
6
procedure initUptext;
 
7
procedure clearUptext;
 
8
function uptextLineNo(voice: integer): integer;
 
9
procedure setUptextLineNo(voice, lno: integer);
 
10
procedure addUptext(voice: integer; var no_uptext: boolean;
 
11
  var pretex: string);
 
12
 
 
13
implementation uses globals, strings, mtxline, utility;
 
14
 
 
15
type uptext_info = record
 
16
  uptext, uptext_adjust, uptext_lcz: integer;
 
17
  uptext_font: string;
 
18
  end;
 
19
 
 
20
var U: array[voice_index] of uptext_info;
 
21
 
 
22
function uptextLineNo(voice: integer): integer;
 
23
begin uptextLineNo := U[voice].uptext; end;
 
24
 
 
25
procedure setUptextLineNo(voice, lno: integer);
 
26
begin U[voice].uptext := lno; end;
 
27
 
 
28
procedure clearUptext;
 
29
  var voice: voice_index;
 
30
begin for voice:=1 to nvoices do U[voice].uptext:=0; end;
 
31
 
 
32
procedure initUptext;
 
33
  var voice: voice_index;
 
34
begin  for voice:=1 to nvoices do with U[voice] do
 
35
  begin
 
36
    uptext_adjust:=0; uptext_lcz:=3; uptext_font:='';
 
37
  end;
 
38
end;
 
39
 
 
40
procedure textTranslate(var uptext, font: string);
 
41
  var k: integer;
 
42
begin
 
43
  if uptext='' then exit;
 
44
  repeat k := pos1('%',uptext);
 
45
    if k>0 then uptext:=
 
46
      substr(uptext,1,k-1)+'{\mtxFlat}'+substr(uptext,k+1,length(uptext)-k);
 
47
  until k=0;
 
48
  repeat k := pos1('#',uptext);
 
49
    if k>0 then uptext:=
 
50
      substr(uptext,1,k-1)+'{\mtxSharp}'+substr(uptext,k+1,length(uptext)-k);
 
51
  until k=0;
 
52
  case uptext[1] of
 
53
  '<': if uptext='<' then uptext:='\mtxIcresc'
 
54
    else if uptext='<.' then uptext:='\mtxTcresc'
 
55
     else begin
 
56
       predelete(uptext,1); uptext:='\mtxCresc{'+uptext+'}'
 
57
     end;
 
58
  '>': if uptext='>' then uptext:='\mtxIdecresc'
 
59
    else if uptext='>.' then uptext:='\mtxTdecresc'
 
60
    else begin
 
61
      predelete(uptext,1); uptext:='\mtxDecresc{'+uptext+'}'
 
62
    end;
 
63
  else for k:=1 to length(uptext) do if pos1(uptext[k],'mpfzrs~')=0 then exit;
 
64
  end;
 
65
  font:='\mtxPF';
 
66
end;
 
67
 
 
68
procedure addUptext(voice: integer; var no_uptext: boolean;
 
69
  var pretex: string);
 
70
    var w, font: string;
 
71
        adj: integer;
 
72
    const default = 10;  under = -14;
 
73
          lcz: string[3] = 'lcz';
 
74
    procedure adjustUptext;
 
75
      var letter: char;
 
76
          force: boolean;
 
77
    begin  delete1(w,1); force:=false;
 
78
      while w<>'' do with U[voice] do
 
79
      begin letter:=w[1]; delete1(w,1); with U[voice] do
 
80
        case letter of
 
81
    '<':  if uptext_lcz>1 then dec(uptext_lcz);
 
82
    '>':  if uptext_lcz<3 then inc(uptext_lcz);
 
83
    '^':  uptext_adjust:=0;
 
84
    'v':  uptext_adjust:=under;
 
85
    '=':  force:=true;
 
86
'+','-':  begin if w<>'' then getNum(w,adj) else adj:=0;
 
87
            if letter = '-' then adj := -adj;
 
88
            if force then uptext_adjust := adj else inc(uptext_adjust,adj);
 
89
            w:='';
 
90
          end;
 
91
    else  error3(voice,'Unknown uptext adjustment');
 
92
        end;
 
93
      end;
 
94
      w:='!';
 
95
    end;
 
96
 
 
97
    begin  
 
98
    with U[voice] do begin
 
99
      if uptext=0 then no_uptext := true;
 
100
      if no_uptext then exit;
 
101
      repeat
 
102
        w := GetNextWord(P[uptext],blank,dummy);
 
103
        if (w=barsym) or (w='') then no_uptext:=true;
 
104
        if (w=tilde) or no_uptext then exit;
 
105
        if w[1]='!' then begin uptext_font:=w; uptext_font[1]:='\'; end;
 
106
        if w[1]='@' then adjustUptext;
 
107
      until w[1]<>'!';  { ! is a kludge, will get me in trouble later }
 
108
      font:=uptext_font;  textTranslate(w,font);
 
109
      if font<>'' then w:=font+'{'+w+'}';
 
110
      case lcz[uptext_lcz] of
 
111
'l':    w:='\mtxLchar{' + toString(default+uptext_adjust) + '}{' + w + '}';
 
112
'c':    w:='\mtxCchar{' + toString(default+uptext_adjust) + '}{' + w + '}';
 
113
'z':    w:='\mtxZchar{' + toString(default+uptext_adjust) + '}{' + w + '}';
 
114
      end;
 
115
      pretex:=pretex+w;
 
116
    end;
 
117
  end;
 
118
 
 
119
end.