(* version 2.15 *)
{---------------------------------------------------------------------------}
{ finds the '.' initiating the postfix of the given file name }
function pos_postfix(xx : string) : integer;
var
i : integer;
begin
pos_postfix:=0;
for i:=1 to length(xx) do
begin
if (xx[i]='.') then pos_postfix:=i
else if (xx[i]=']') then pos_postfix:=0
else if (xx[i]='/') then pos_postfix:=0
else if (xx[i]='\') then pos_postfix:=0
else if (xx[i]=':') then pos_postfix:=0
; {END IF}
end
; {END DO}
end;
{---------------------------------------------------------------------------}
{ the signed variant of str(n,stg) }
procedure sign_str(num : integer; var out_sign_str : string24);
var
sign_work : string255;
begin
str(num, sign_work);
(* if (num<0) then out_sign_str:='-'+sign_work *)
if (num<0) then out_sign_str:=truncate24('-'+sign_work)
else out_sign_str:=truncate24(sign_work)
; {END IF}
end;
{---------------------------------------------------------------------------}
{ prints/displays a message }
procedure print_msg (verbose_level : integer; msg : string);
begin
if (verbose >= verbose_level) then write(msg);
if write_log then write(logfile, msg);
end;
{---------------------------------------------------------------------------}
{ prints/displays a message with RETURN }
procedure println_msg (verbose_level : integer; msg : string);
begin
if (verbose >= verbose_level) then writeln(msg);
if write_log then writeln(logfile, msg);
end;
{ ======================================================================= }
{ used at initialization to store one size name (Latex) and its magnitudes }
procedure sizeone(i : integer; s : string; j,k,l : integer;
mag10, mag11, mag12 : integer);
begin
sizekey[i]:=truncate24(s);
sizeval[1,i]:=j; sizemags[1,i]:=mag10;
sizeval[2,i]:=k; sizemags[2,i]:=mag11;
sizeval[3,i]:=l; sizemags[3,i]:=mag12;
end;
{ ======================================================================= }
{ initialization of LaTeX font heights <==> size keywords }
procedure sizeinit;
var
k : integer;
begin
sizeone(1, 'HUGE', 720, 720, 840, 2986, 2986, 3583);
sizeone(2, 'Huge', 600, 600, 720, 2488, 2488, 2986);
sizeone(3, 'huge', 500, 500, 600, 2074, 2074, 2488);
sizeone(4, 'LARGE', 440, 440, 500, 1728, 1728, 2074);
sizeone(5, 'Large', 360, 360, 440, 1440, 1440, 1728);
sizeone(6, 'large', 280, 280, 360, 1200, 1200, 1440);
sizeone(7, 'normalsize', 240, 272, 290, 1000, 1095, 1200);
sizeone(8, 'small', 220, 240, 272, 900, 1000, 1095);
sizeone(9,'footnotesize',190, 220, 240, 800, 900, 1000);
sizeone(10,'scriptsize', 160, 190, 190, 700, 800, 800);
sizeone(11,'tiny' , 120, 140, 140, 500, 600, 600);
for k:=12 to 16 do sizeone(k,'tiny',0,0,0,500,600,600);
num_diff_sizes:=11;
for k:=0 to 10 do environ_type[k]:='\RTFerror';
environ_type[0]:='document'; environ_type[1]:='center';
environ_type[2]:='flushright';
end;
{ ======================================================================= }
procedure mac_init;
var
k : integer;
begin
{ install the conversions of RTF accents (coded \'xx in hexa) }
{ build a list of conversion of accented letters }
for k:=0 to 255 do acc_transl[k]:='';
acc_transl[hs_to_i('80')]:='"A';
acc_transl[hs_to_i('81')]:='\AA{}';
acc_transl[hs_to_i('82')]:='\c{C}';
acc_transl[hs_to_i('83')]:='\''E';
acc_transl[hs_to_i('84')]:='\~N';
acc_transl[hs_to_i('85')]:='\"O';
acc_transl[hs_to_i('86')]:='\"U';
acc_transl[hs_to_i('87')]:='\''a';
acc_transl[hs_to_i('88')]:='\`a';
acc_transl[hs_to_i('89')]:='\^a';
acc_transl[hs_to_i('8a')]:='\"a';
acc_transl[hs_to_i('8b')]:='\~a';
acc_transl[hs_to_i('8c')]:='\aa{}';
acc_transl[hs_to_i('8d')]:='\c{c}';
acc_transl[hs_to_i('8e')]:='\''e';
acc_transl[hs_to_i('8f')]:='\`e';
acc_transl[hs_to_i('90')]:='\^e';
acc_transl[hs_to_i('91')]:='\"e';
acc_transl[hs_to_i('93')]:='\''{\i}';
acc_transl[hs_to_i('93')]:='\`{\i}';
acc_transl[hs_to_i('94')]:='\^{\i}';
acc_transl[hs_to_i('95')]:='\"{\i}';
acc_transl[hs_to_i('96')]:='\~n';
acc_transl[hs_to_i('97')]:='\''o';
acc_transl[hs_to_i('98')]:='\`o';
acc_transl[hs_to_i('99')]:='\^o';
acc_transl[hs_to_i('9a')]:='\"o';
acc_transl[hs_to_i('9b')]:='\~o';
acc_transl[hs_to_i('9c')]:='\''u';
acc_transl[hs_to_i('9d')]:='\`u';
acc_transl[hs_to_i('9e')]:='\^u';
acc_transl[hs_to_i('9f')]:='\"u';
acc_transl[hs_to_i('a0')]:='\dag{}';
acc_transl[hs_to_i('a1')]:='\degree{}';
acc_transl[hs_to_i('a3')]:='\pound{}';
acc_transl[hs_to_i('a4')]:='\S{}';
acc_transl[hs_to_i('a7')]:='\ss{}';
acc_transl[hs_to_i('ae')]:='\AE{}';
acc_transl[hs_to_i('af')]:='\O{}';
acc_transl[hs_to_i('b0')]:='$\infty ';
acc_transl[hs_to_i('b1')]:='$\pm ';
acc_transl[hs_to_i('b2')]:='$\leq ';
acc_transl[hs_to_i('b3')]:='$\geq ';
acc_transl[hs_to_i('b5')]:='$\mu ';
acc_transl[hs_to_i('b6')]:='$\partial ';
acc_transl[hs_to_i('b7')]:='$\Sigma ';
acc_transl[hs_to_i('b8')]:='$\Pi ';
acc_transl[hs_to_i('b9')]:='$\pi ';
acc_transl[hs_to_i('bd')]:='${1\over2}';
acc_transl[hs_to_i('bf')]:='\o{}';
acc_transl[hs_to_i('c6')]:='$\Delta ';
acc_transl[hs_to_i('c9')]:='...';
acc_transl[hs_to_i('cb')]:='\`A';
acc_transl[hs_to_i('cc')]:='\~A';
acc_transl[hs_to_i('cd')]:='\~O';
acc_transl[hs_to_i('ce')]:='\OE{}';
acc_transl[hs_to_i('cf')]:='\oe{}';
acc_transl[hs_to_i('d0')]:='--{}';
acc_transl[hs_to_i('d1')]:='---{}';
acc_transl[hs_to_i('d2')]:='``';
acc_transl[hs_to_i('d3')]:='''''';
acc_transl[hs_to_i('d4')]:='`{}';
acc_transl[hs_to_i('d5')]:='''{}';
acc_transl[hs_to_i('d6')]:='$\div ';
acc_transl[hs_to_i('d8')]:='\"y';
acc_transl[hs_to_i('e1')]:='$\cdot ';
acc_transl[hs_to_i('e4')]:='\"a';
acc_transl[hs_to_i('e5')]:='\^A';
acc_transl[hs_to_i('e6')]:='\^E';
acc_transl[hs_to_i('e7')]:='\''A';
acc_transl[hs_to_i('e8')]:='\"E';
acc_transl[hs_to_i('e9')]:='\`E';
acc_transl[hs_to_i('ea')]:='\''I';
acc_transl[hs_to_i('eb')]:='\^I';
acc_transl[hs_to_i('ec')]:='\"I';
acc_transl[hs_to_i('ed')]:='\`I';
acc_transl[hs_to_i('ee')]:='\''O';
acc_transl[hs_to_i('ef')]:='\^O';
acc_transl[hs_to_i('f1')]:='\`O';
acc_transl[hs_to_i('f2')]:='\''U';
acc_transl[hs_to_i('f3')]:='\^U';
acc_transl[hs_to_i('f4')]:='\`U';
acc_transl[hs_to_i('f6')]:='\"o';
acc_transl[hs_to_i('fb')]:='\degree{}';
acc_transl[hs_to_i('fc')]:='\"u';
end;
{ ======================================================================= }
procedure ansi_init;
var
k : integer;
begin
{ install the conversions of RTF accents (coded \'xx in hexa) }
{ build a list of conversion of accented letters }
for k:=0 to 255 do acc_transl[k]:='';
acc_transl[hs_to_i('a1')]:='!`';
acc_transl[hs_to_i('a3')]:='\pound{}';
acc_transl[hs_to_i('a7')]:='\S{}';
acc_transl[hs_to_i('a8')]:='\"{ }';
acc_transl[hs_to_i('a9')]:='\copyright{}';
acc_transl[hs_to_i('ab')]:='<<';
acc_transl[hs_to_i('b0')]:='\degree{}';
acc_transl[hs_to_i('b1')]:='$\pm ';
acc_transl[hs_to_i('b4')]:='\''{ }';
acc_transl[hs_to_i('b5')]:='$\mu ';
acc_transl[hs_to_i('b7')]:='$\cdot ';
acc_transl[hs_to_i('b8')]:='\c{ }';
acc_transl[hs_to_i('bb')]:='>>';
acc_transl[hs_to_i('bc')]:='${1\over4}';
acc_transl[hs_to_i('bd')]:='${1\over2}';
acc_transl[hs_to_i('be')]:='${3\over4}';
acc_transl[hs_to_i('bf')]:='?`';
acc_transl[hs_to_i('c0')]:='\`A';
acc_transl[hs_to_i('c1')]:='\''A';
acc_transl[hs_to_i('c2')]:='\^A';
acc_transl[hs_to_i('c3')]:='\~A';
acc_transl[hs_to_i('c4')]:='\"A';
acc_transl[hs_to_i('c5')]:='\AA{}';
acc_transl[hs_to_i('c6')]:='\AE{}';
acc_transl[hs_to_i('c7')]:='\c{C}';
acc_transl[hs_to_i('c8')]:='\`E';
acc_transl[hs_to_i('c9')]:='\''E';
acc_transl[hs_to_i('ca')]:='\^E';
acc_transl[hs_to_i('cb')]:='\"E';
acc_transl[hs_to_i('cc')]:='\`I';
acc_transl[hs_to_i('cd')]:='\''I';
acc_transl[hs_to_i('ce')]:='\^I';
acc_transl[hs_to_i('cf')]:='\"I';
acc_transl[hs_to_i('d1')]:='\~N';
acc_transl[hs_to_i('d2')]:='\`O';
acc_transl[hs_to_i('d3')]:='\''O';
acc_transl[hs_to_i('d4')]:='\^O';
acc_transl[hs_to_i('d5')]:='\~O';
acc_transl[hs_to_i('d6')]:='\"O';
acc_transl[hs_to_i('d8')]:='\O';
acc_transl[hs_to_i('d9')]:='\`U';
acc_transl[hs_to_i('da')]:='\''U';
acc_transl[hs_to_i('db')]:='\^U';
acc_transl[hs_to_i('dc')]:='\"U';
acc_transl[hs_to_i('dd')]:='\''Y';
acc_transl[hs_to_i('df')]:='\ss{}';
acc_transl[hs_to_i('e0')]:='\`a';
acc_transl[hs_to_i('e1')]:='\''a';
acc_transl[hs_to_i('e2')]:='\^a';
acc_transl[hs_to_i('e3')]:='\~a';
acc_transl[hs_to_i('e4')]:='\"a';
acc_transl[hs_to_i('e5')]:='\aa{}';
acc_transl[hs_to_i('e6')]:='\ae{}';
acc_transl[hs_to_i('e7')]:='\c{c}';
acc_transl[hs_to_i('e8')]:='\`e';
acc_transl[hs_to_i('e9')]:='\''e';
acc_transl[hs_to_i('ea')]:='\^e';
acc_transl[hs_to_i('eb')]:='\"e';
acc_transl[hs_to_i('ec')]:='\`i';
acc_transl[hs_to_i('ed')]:='\''i';
acc_transl[hs_to_i('ee')]:='\^i';
acc_transl[hs_to_i('ef')]:='\"i';
acc_transl[hs_to_i('f1')]:='\~n';
acc_transl[hs_to_i('f2')]:='\`o';
acc_transl[hs_to_i('f3')]:='\''o';
acc_transl[hs_to_i('f4')]:='\^o';
acc_transl[hs_to_i('f5')]:='\~o';
acc_transl[hs_to_i('f6')]:='\"o';
acc_transl[hs_to_i('f8')]:='\o';
acc_transl[hs_to_i('f9')]:='\`u';
acc_transl[hs_to_i('fa')]:='\''u';
acc_transl[hs_to_i('fb')]:='\^u';
acc_transl[hs_to_i('fc')]:='\"u';
acc_transl[hs_to_i('fd')]:='\''y';
acc_transl[hs_to_i('ff')]:='\"y';
end;
{ ======================================================================= }
procedure charinit;
var
K : integer;
begin
for K:=0 to 255 do catcode[K]:=12;
for K:=ord('A') to ord('Z') do catcode[K]:=11;
for K:=ord('a') to ord('z') do catcode[K]:=11;
for K:=ord('0') to ord('9') do catcode[K]:=16;
K:=ord(' '); catcode[K]:=10;
K:=ord('{'); catcode[K]:=1;
K:=ord('}'); catcode[K]:=2;
K:=ord('('); catcode[K]:=3;
K:=ord(')'); catcode[K]:=4;
K:=ord('\'); catcode[K]:=0;
icharz:=ord('0');
{ build an empty list of conversion of accented letters }
for K:=0 to 255 do acc_transl[K]:='';
{ Now install the conversions of "ftech" characters into math codes
.. or letters}
for K:=0 to 255 do ftech_transl[K]:='';
ftech_transl[ord('a')]:='\alpha ';
ftech_transl[ord('A')]:='\Alpha ';
ftech_transl[ord('b')]:='\beta ';
ftech_transl[ord('B')]:='\Beta ';
ftech_transl[ord('c')]:='\chi ';
ftech_transl[ord('C')]:='\Chi ';
ftech_transl[ord('d')]:='\delta ';
ftech_transl[ord('D')]:='\Delta ';
ftech_transl[ord('e')]:='\varepsilon ';
ftech_transl[ord('E')]:='\Epsilon ';
ftech_transl[ord('f')]:='\phi ';
ftech_transl[ord('F')]:='\Phi ';
ftech_transl[ord('g')]:='\gamma ';
ftech_transl[ord('G')]:='\Gamma ';
ftech_transl[ord('h')]:='\eta ';
ftech_transl[ord('H')]:='\Eta ';
ftech_transl[ord('i')]:='\iota ';
ftech_transl[ord('I')]:='\Iota ';
ftech_transl[ord('j')]:='\varphi ';
ftech_transl[ord('J')]:='\vartheta ';
ftech_transl[ord('k')]:='\kappa ';
ftech_transl[ord('K')]:='\Kappa ';
ftech_transl[ord('l')]:='\lambda ';
ftech_transl[ord('L')]:='\Lambda ';
ftech_transl[ord('m')]:='\mu ';
ftech_transl[ord('M')]:='\Mu ';
ftech_transl[ord('n')]:='\nu ';
ftech_transl[ord('N')]:='\Nu';
ftech_transl[ord('o')]:='o';
ftech_transl[ord('O')]:='\Omicron ';
ftech_transl[ord('p')]:='\pi ';
ftech_transl[ord('P')]:='\Pi ';
ftech_transl[ord('q')]:='\theta ';
ftech_transl[ord('Q')]:='\Theta ';
ftech_transl[ord('r')]:='\rho ';
ftech_transl[ord('R')]:='\Rho ';
ftech_transl[ord('s')]:='\sigma ';
ftech_transl[ord('S')]:='\Sigma ';
ftech_transl[ord('t')]:='\tau ';
ftech_transl[ord('T')]:='\Tau ';
ftech_transl[ord('u')]:='\upsilon ';
ftech_transl[ord('U')]:='\varUpsilon ';
ftech_transl[ord('v')]:='\varpi ';
ftech_transl[ord('V')]:='\varsigma ';
ftech_transl[ord('w')]:='\omega ';
ftech_transl[ord('W')]:='\Omega ';
ftech_transl[ord('x')]:='\xi ';
ftech_transl[ord('X')]:='\Xi ';
ftech_transl[ord('y')]:='\psi ';
ftech_transl[ord('Y')]:='\Psi ';
ftech_transl[ord('z')]:='\zeta ';
ftech_transl[ord('Z')]:='\Zeta ';
ftech_transl[ord('@')]:='\cong ';
ftech_transl[ord('~')]:='\sim ';
ftech_transl[ord('"')]:='\forall ';
ftech_transl[ord('$')]:='\exists ';
ftech_transl[hs_to_i('27')]:='\ni ';
ftech_transl[hs_to_i('5e')]:='\bot ';
ftech_transl[hs_to_i('a0')]:='\dag ';
ftech_transl[hs_to_i('a1')]:='\Upsilon ';
ftech_transl[hs_to_i('a2')]:='''';
ftech_transl[hs_to_i('a3')]:='\leq ';
ftech_transl[hs_to_i('a4')]:='/';
ftech_transl[hs_to_i('a5')]:='\infty ';
ftech_transl[hs_to_i('a6')]:='\cap ';
ftech_transl[hs_to_i('a7')]:='\clubsuit ';
ftech_transl[hs_to_i('a9')]:='\heartsuit ';
ftech_transl[hs_to_i('aa')]:='\spadesuit ';
ftech_transl[hs_to_i('ab')]:='\leftrightarrow ';
ftech_transl[hs_to_i('ac')]:='\leftarrow ';
ftech_transl[hs_to_i('ad')]:='\uparrow ';
ftech_transl[hs_to_i('ae')]:='\rightarrow ';
ftech_transl[hs_to_i('af')]:='\downarrow ';
ftech_transl[hs_to_i('b0')]:='^{\circ}';
ftech_transl[hs_to_i('b1')]:='\pm ';
ftech_transl[hs_to_i('b2')]:='''''';
ftech_transl[hs_to_i('b3')]:='\geq ';
ftech_transl[hs_to_i('b4')]:='\times ';
ftech_transl[hs_to_i('b5')]:='\propto ';
ftech_transl[hs_to_i('b6')]:='\partial ';
ftech_transl[hs_to_i('b7')]:='\bullet ';
ftech_transl[hs_to_i('b8')]:='\div ';
ftech_transl[hs_to_i('b9')]:='\neq ';
ftech_transl[hs_to_i('ba')]:='\equiv ';
ftech_transl[hs_to_i('bb')]:='\approx ';
ftech_transl[hs_to_i('bc')]:='\ldots ';
ftech_transl[hs_to_i('bd')]:='\mid ';
ftech_transl[hs_to_i('c0')]:='\aleph ';
ftech_transl[hs_to_i('c1')]:='\Im ';
ftech_transl[hs_to_i('c2')]:='\Re ';
ftech_transl[hs_to_i('c3')]:='\wp ';
ftech_transl[hs_to_i('c4')]:='\otimes ';
ftech_transl[hs_to_i('c5')]:='\oplus ';
ftech_transl[hs_to_i('c6')]:='\oslash ';
ftech_transl[hs_to_i('c7')]:='\cap ';
ftech_transl[hs_to_i('c8')]:='\cup ';
ftech_transl[hs_to_i('c9')]:='\supset ';
ftech_transl[hs_to_i('ca')]:='\supseteq ';
ftech_transl[hs_to_i('cb')]:='\not\subset ';
ftech_transl[hs_to_i('cc')]:='\subset ';
ftech_transl[hs_to_i('cd')]:='\subseteq ';
ftech_transl[hs_to_i('ce')]:='\in ';
ftech_transl[hs_to_i('cf')]:='\not\in ';
ftech_transl[hs_to_i('d0')]:='\angle ';
ftech_transl[hs_to_i('d1')]:='\nabla ';
ftech_transl[hs_to_i('d2')]:='\registered ';
ftech_transl[hs_to_i('d3')]:='\copyright ';
ftech_transl[hs_to_i('d4')]:='\trademark ';
ftech_transl[hs_to_i('d5')]:='\prod ';
ftech_transl[hs_to_i('d7')]:='\cdot ';
ftech_transl[hs_to_i('d8')]:='\neg ';
ftech_transl[hs_to_i('d9')]:='\wedge ';
ftech_transl[hs_to_i('da')]:='\vee ';
ftech_transl[hs_to_i('db')]:='\Leftrightarrow ';
ftech_transl[hs_to_i('dc')]:='\Leftarrow ';
ftech_transl[hs_to_i('dd')]:='\Uparrow ';
ftech_transl[hs_to_i('de')]:='\Rightarrow ';
ftech_transl[hs_to_i('df')]:='\Downarrow ';
ftech_transl[hs_to_i('e0')]:='\diamondsuit ';
ftech_transl[hs_to_i('e1')]:='\langle ';
ftech_transl[hs_to_i('e2')]:='\registered ';
ftech_transl[hs_to_i('e3')]:='\copyright ';
ftech_transl[hs_to_i('e4')]:='\trademark ';
ftech_transl[hs_to_i('e5')]:='\sum ';
ftech_transl[hs_to_i('e9')]:='\lceil ';
ftech_transl[hs_to_i('ea')]:='\mid ';
ftech_transl[hs_to_i('eb')]:='\lfloor ';
ftech_transl[hs_to_i('f1')]:='\rangle ';
ftech_transl[hs_to_i('f2')]:='\int ';
end_math_code:='$';
end;
{ ======================================================================= }
{ this procedure returns a set of 4 chars, the size preamble of a non std font }
function sizealpha(i : integer) : string5;
var
h : integer;
begin
h:=i div 2;
if h<= 5 then sizealpha:='\fiv'
else if h<= 6 then sizealpha:='\six'
else if h<= 7 then sizealpha:='\sev'
else if h<= 8 then sizealpha:='\egt'
else if h<= 9 then sizealpha:='\nin'
else if h<= 10 then sizealpha:='\ten'
else if h<= 11 then sizealpha:='\elv'
else if h<= 13 then sizealpha:='\twl'
else if h<= 15 then sizealpha:='\frt'
else if h<= 18 then sizealpha:='\svtn'
else if h<= 23 then sizealpha:='\twty'
else if h<= 28 then sizealpha:='\twfv'
else sizealpha:='\thtw'
; {END IF}
end;
{ ======================================================================= }
{ write "help" information }
procedure write_help;
begin
writeln('Usage: RTFLATEX [options] <input-file> [options] <output-file>');
writeln('Options:');
writeln(' -b : set explicit \baselineskip at par ends');
writeln(' -d<nnn> : debug level: 1=default, 0=quiet, >1=verbose');
writeln(' -f<templ> : file template to put figures (need a * )');
writeln(' -l<style> : latex style (default is "report")');
writeln(' -m : put debugging marks in output TeX');
writeln(' -o<option> : latex style option (cumulative)');
writeln(' -p<value> : std font size (10, 11, 12)');
writeln(' -r<file> : LOG output file (default is none)');
writeln(' -s : use slanted instead of italic');
writeln(' -t : omit LaTeX \documentstyle etc.');
writeln(' -v : convert text and fonts, not spacings');
writeln(' -x : inhibit output simplification');
writeln(' -z<file> : file containing list of ignored keywords');
writeln(' -209 : assume ancient Latex209');
halt;
end;
{---------------------------------------------------------------------------}
{ this procedure open files and set the -xxxx options }
procedure open_files;
var
skipname, outputname, inputname, logname, optstr : string128;
testio, cat, ikar, kparm, L, pospt : integer;
first_char, kar : char;
success : boolean;
inskipk : string24;
kkk, number_params : integer;
begin
figure_path:='rtf*.bit'; figure_type:='';
stdsize:=12; stdkz:=3; { standard LaTeX size : 10, 11, 12 pt }
inputname:=''; outputname:=''; skipname:=paramstr(0); kparm:=0;
num_skip_strings:=1;
for L:=1 to max_skip_strings do skip_strings[L]:='';
pospt:=pos_postfix(skipname);
if pospt>0 then
begin
if (copy(skipname,pospt,length(skipname))='.EXE') then
skipname:=copy(skipname,1,pospt)+'SKW'
else if (copy(skipname,pospt,length(skipname))='.exe') then
skipname:=copy(skipname,1,pospt)+'skw'
;
end
else skipname:=skipname+'.skw'
; {END IF}
number_params:=paramcount;
for kkk:=1 to number_params do
begin
kparm:=kkk; optstr:=paramstr(kparm); first_char:=optstr[1];
if first_char='-' then
begin
writeln(first_char,'Option :>',optstr,'<');
if optstr[2]='p' then
begin
stdsize:=0;
for L:=3 to length(optstr) do
begin
ikar:=ord(optstr[L]); cat:=catcode[ikar];
if(cat=16) then
stdsize:=10*stdsize+ikar-icharz
else
begin
writeln ('Illegal character in -p option: ',optstr); halt;
end
;
end
;
writeln('Standard size found: ',stdsize,'pt');
if(stdsize < 11) then stdkz:=1
else if(stdsize=11) then stdkz:=2
else stdkz:=3
; {END IF}
end
else if (optstr[2]='2') then latex209:=TRUE
else if (optstr[2]='v') then no_space_conv:=TRUE
else if (optstr[2]='s') then use_sl:=TRUE
else if (optstr[2]='t') then latex_header:=FALSE
else if (optstr[2]='x') then simplify_ok:=FALSE
else if (optstr[2]='b') then base_flag:=TRUE
else if (optstr[2]='z') then skipname:=copy(optstr,3,999)
else if (optstr[2]='l') then
begin latex_style:=truncate24(optstr);
if latex_style='' then latex_style:='report';
end
else if (optstr[2]='o') then
begin
if (num_latex_options >= maxstyles) then
writeln('Too many style options, ',optstr,' ignored !')
else
begin
num_latex_options:=num_latex_options+1;
latex_options[num_latex_options]:=
truncate24(copy(optstr,3,bfslen));
end
; {END IF num_latex_options}
end
else if (optstr[2]='f') then
begin figure_path:=copy(optstr,3,999); writeln('-f:',figure_path);
end
else if (optstr[2]='r') then
begin logname:=copy(optstr,3,999); write_log:=TRUE;
end
else if (optstr[2]='m') then
tex_verbose:=1 { insert marks in TeX output }
else if (optstr[2]='d') then
begin
verbose:=0;
for L:=3 to length(optstr) do
begin ikar:=ord(optstr[L]); cat:=catcode[ikar];
if(cat=16) then
verbose:=10*verbose+ikar-icharz
else
begin
writeln ('Illegal character in -d option: ',optstr); halt;
end
; {END IF}
if verbose>0 then writeln('Verbose=',verbose);
end
end
else writeln('Unsupported option, ignored: ',optstr)
; {END IF}
end
else if (inputname='') then inputname:=optstr
else if (outputname='') then outputname:=optstr
else if (optstr <> '') then
begin writeln ('Too many non option args : ',optstr);
writeln ('This one ignored !');
end
; {END IF}
end
; {END WHILE}
pospt:=pos('*',figure_path);
if(pospt=0) then
begin
writeln('NO * in -f<path> option'); halt;
end;
figure_type:=copy(figure_path,pospt+1,999);
figure_path:=copy(figure_path,1,pospt-1);
if inputname='' then write_help; (* stops if help written *)
if (pos_postfix(inputname)=0) then inputname:=inputname+'.rtf';
{$I-}
assign(inputfile,inputname); reset(inputfile);
testio:=ioresult; success:=(testio=0);
if (not success) then
begin
writeln('Unable to open input file ',inputname,' ; code=',testio); halt;
end;
if outputname='' then
begin
pospt:=pos_postfix(inputname); outputname:=copy(inputname,1,pospt)+'tex';
writeln('Output name taken from input: ',outputname);
end;
if(outputname=inputname) then
begin
writeln('Input and output files have same names, abort!');
writeln(' Input: ',inputname); writeln(' Output: ',inputname);
close(inputfile); halt;
end;
assign(outputfile,outputname); rewrite(outputfile);
testio:=ioresult; success:=(testio=0);
if not success then
begin
writeln('ioresult (output)=',testio);
writeln('Unable to open output file ',outputname,' ; code=',testio);
close(inputfile); halt;
end
;
(* opening skip file to eliminate useless output \RTFxxx keywords *)
if skipname='' then
begin
pospt:=pos_postfix(inputname); skipname:=copy(inputname,1,pospt)+'skw';
writeln('keyword skip file name taken from input: ',skipname);
end;
if(skipname=inputname) then
begin
writeln('Input and skip files have same names, abort!');
writeln(' Input: ',inputname); writeln(' skip: ',inputname);
close(inputfile); halt;
end;
assign(skipfile,skipname); reset(skipfile);
testio:=ioresult; success:=(testio=0);
if not success then
begin
writeln('ioresult (keyword skip file)=',testio);
writeln('Unable to open keyword skip file ',skipname,' ; code=',testio);
close(inputfile); halt;
end
;
{$I-}
if write_log then
begin
if (logname='') then
begin
pospt:=pos_postfix(inputname); logname:=copy(inputname,1,pospt)+'log';
writeln('Log name taken from input : ',logname);
end
; {END IF logname}
if(logname=inputname) or (logname=outputname) then
begin
writeln('Log and input or output files have same names, abort!');
writeln(' Log: ',logname); close(inputfile); halt;
end
; {END IF logname}
assign(logfile,logname); rewrite(logfile); testio:=ioresult;
write_log:=(testio=0);
if not write_log then
begin
writeln('ioresult (Log)=',testio);
writeln('Unable to open log file ',logname,' ; code=',testio);
close(inputfile); halt;
end
; {END IF not success}
{$I-}
write(logname,', ');
end
; {END IF write_log}
writeln(inputname,', ',skipname,' and ',outputname,' successfully opened.');
while (not eof(skipfile)) do
begin
readln(skipfile,inskipk); println_msg(2,'Cancelling "'+inskipk+'"');
if inskipk<> '' then
begin
if length(inskipk)+length(skip_strings[num_skip_strings])<255 then
skip_strings[num_skip_strings]:=
skip_strings[num_skip_strings]+inskipk+' '
else if num_skip_strings<max_skip_strings then
begin num_skip_strings:=num_skip_strings+1;
skip_strings[num_skip_strings]:=
skip_strings[num_skip_strings]+inskipk+' '
end
else
println_msg(1,'Too many keywords to ignore, '+inskipk+' not recorded!')
; {END IF}
end
; {END IF}
end
; {END DO}
end;
{---------------------------------------------------------------------------}
{ clean the output line }
procedure cleanout;
begin
for i:=1 to olmx do exline[i]:=' '; kout:=0;
end;
{---------------------------------------------------------------------------}
{ prints/displays the current stored output line }
procedure print_line (verbose_level : integer);
var
i : integer;
begin
for i:=1 to kout do print_msg(verbose_level,exline[i]);
println_msg(verbose_level,'<<<');
end;
{---------------------------------------------------------------------------}
{ makes the pos function in an array of type exline_type }
function array_pos (oldstring : string; testline : exline_type;
array_long : integer) : integer;
var
string_found : boolean;
lth1, jpos, kpos : integer;
begin
array_pos:=0; lth1:=length(oldstring);
for kpos:=1 to array_long-lth1+1 do
begin
string_found:=TRUE;
for jpos:=1 to lth1 do
string_found:=string_found and (oldstring[jpos]=testline[kpos+jpos-1])
; {END DO}
if string_found then
begin
array_pos:=kpos; exit;
end
; {END IF}
end
; {END DO}
end;
{---------------------------------------------------------------------------}
{ substitute a string with another in output line }
procedure outsubstitute (oldstring, newstring : string);
var
string_found : boolean;
lth1, lth2, jpos, kpos, oldkout : integer;
oldline : exline_type;
begin
string_found:=TRUE; lth1:=length(oldstring); lth2:=length(newstring);
while string_found do
begin
kpos:=array_pos(oldstring,exline,kout);
string_found:=(kpos>0);
if string_found then
begin
oldline:=exline; oldkout:=kout; kout:=kpos-1;
for jpos:=1 to lth2 do
begin
kout:=kout+1; exline[kout]:=newstring[jpos];
end
; {END DO}
for jpos:=kpos+lth1 to oldkout do
begin
kout:=kout+1; exline[kout]:=oldline[jpos];
end
; {END DO}
for jpos:=kout+1 to olmx do exline[jpos]:=' '
; {END DO}
end
; {END IF}
end
; {END DO}
end;
{---------------------------------------------------------------------------}
{ converts an integer number of twips into a decimal string }
procedure str_twips_pt(numval: integer; var outpts: string24);
var
k, l: integer;
wk: string24;
begin
k:=5*numval; { convert to hundredth of pts }
sign_str(k,wk); if(length(wk)<2) then wk:=truncate24('00'+wk);
l:=length(wk); outpts:=truncate24(copy(wk,1,l-2)+'.'+copy(wk,l-1,2));
end;
{---------------------------------------------------------------------------}
{ eliminates end replaces useless sequences in output -- pragmatic feature }
procedure simplify (oldstring, newstring : string);
begin if simplify_ok then outsubstitute(oldstring, newstring);
end;
{---------------------------------------------------------------------------}
{ read the future chars, excluding control chars < ord(' ') }
procedure read_next_char;
var
next_ikar : integer;
next_char : char;
begin
next_ikar:=0; next_char:=chr(next_ikar);
while ((not eof(inputfile)) and (next_ikar < ord(' ')) and
(length(next_rtf)<8)) do
begin
read(inputfile,next_char); next_ikar:=ord(next_char);
if next_ikar=13 then
begin input_line_number:=input_line_number+1;
prev_line:=inpline; prev_kinp:=kinp; kinp:=0;
end
else if (next_ikar >= ord(' ')) then
next_rtf:=next_rtf+next_char
; {END IF}
end
; {END DO}
end;
{---------------------------------------------------------------------------}
{ read one char except nulls }
procedure read_char;
begin
if (length(next_rtf)>0) then
begin kar:=next_rtf[1]; delete(next_rtf,1,1); read_next_char;
end
else
kar:=chr(26)
; {END IF}
ikar:=ord(kar); cat:=catcode[ikar];
if (length(next_rtf)=0) then next_rtf:=next_rtf+chr(26)
; {END IF}
if kinp<lmx then
begin kinp:=kinp+1; inpline[kinp]:=kar;
end
; {END IF}
end;
{---------------------------------------------------------------------------}
{ outputs the stored output line }
procedure output_line;
var
i : integer;
simpl_pattern : string24;
begin
numl:=numl+1;
simplify('{{}','{'); simplify('{}}','}'); simplify('{}{}','{}');
for i:=1 to num_diff_sizes do
begin simpl_pattern:=truncate24('\'+sizekey[i]);
simplify(simpl_pattern+'{}\',simpl_pattern+'\');
simplify(simpl_pattern+'}','}');
end
; {END DO}
simplify('\root{}\of{','\sqrt{');
for i:=1 to kout do write(outputfile, exline[i]);
writeln(outputfile);
if((NUML mod 100)=0) then
begin
if (verbose>0) then
begin sign_str(NUML,works); print_msg(1,'Output : '+works+' lines ');
for j:=1 to bracelvl do print_msg(1,'{'); println_msg(1,'');
end
else write('.')
;
end
; {END IF NUML}
cleanout;
end;
{---------------------------------------------------------------------------}
{ write a character into output line }
procedure output_real_line;
begin
if (kout>0) then output_line;
end;
{---------------------------------------------------------------------------}
{ write a character into output line }
procedure outchr (CHARAC : char);
var
oldchar, newchar : char;
begin
newchar:=CHARAC;
if(kout > 0) then
begin oldchar:=exline[kout];
if((oldchar=' ') and (newchar=' ')) then exit;
end
else if ((kout=0) and last_percent and (CHARAC=' ')) then
begin kout:=1; EXLINE[kout]:='\';
end
; {END IF}
last_percent:=FALSE;
if(kout < olmx-2) then
begin kout:=kout+1; exline[kout]:=newchar;
if(newchar='}') and (kout > 80) then
begin
if (EXLINE[kout-1]=';') then
begin EXLINE[kout]:='\';
kout:=kout+1; EXLINE[KOUT]:='r';
kout:=kout+1; EXLINE[KOUT]:='e';
kout:=kout+1; EXLINE[KOUT]:='l';
kout:=kout+1; EXLINE[KOUT]:='a';
kout:=kout+1; EXLINE[KOUT]:='x'; output_line;
kout:=kout+1; EXLINE[KOUT]:=' ';
kout:=kout+1; EXLINE[KOUT]:=newchar;
end
else if (kout > 120) then
begin
kout:=kout+1; EXLINE[KOUT]:='%';
kout:=kout+1; EXLINE[KOUT]:='%';
output_line; last_percent:=TRUE;
end
; {END IF}
end
else if(newchar=' ') and (kout > 64) then output_line
; {END IF}
end
else
begin sign_str(KOUT,works); println_msg(0,'Output overflow, KOUT:='+works);
end
; {END IF}
end;
{ ===================================================================== }
{ change contents of bfslcode[bracelvl] : replace first arg with 2nd }
{ but do not declare font, since output will be standard }
procedure font_subs2e(old, new: string);
var
workstg : string[48];
positn : integer;
begin
positn:=pos(old,bfslcode[bracelvl]); if(positn=0) then exit;
if lvlcode[bracelvl]= 9 then exit; (* ignore new fonts in header/footer *)
if (verbose>=2) then
write('font_subs2e: ',old,'|',bfslcode[bracelvl],'|',new)
;
workstg:=bfslcode[bracelvl]; delete(workstg,positn,length(old));
if (pos(new,workstg)=0) then insert(new,workstg,positn);
bfslcode[bracelvl]:=truncate24(workstg);
if (verbose>=2) then
writeln('=>',workstg)
;
end;
{---------------------------------------------------------------------------}
{ inserts a new font specification like \bf \rm \sc into bfslcode[bracelvl] }
procedure add_to_bfsl(kod : string);
var
bfsl_try : string[64]; bfsl_old : string[64];
begin (* bfsl_old:=bfslcode[bracelvl]; *)
bfsl_try:=bfslcode[bracelvl]+'\';
if (pos(kod+'\',bfsl_try)>0) then exit;
bfslcode[bracelvl]:=truncate24(bfslcode[bracelvl]+kod);
(* writeln('add_to:',bfsl_old,'+',kod,'=',bfslcode[bracelvl]); *)
end;
{---------------------------------------------------------------------------}
{ output one character capitalized if needed }
procedure outchrc (CHARAC : char);
var
kar : char;
begin
if(lvlcode[bracelvl]=2) then kar:=upcase(CHARAC)
else kar:=CHARAC; outchr(kar);
end;
{---------------------------------------------------------------------------}
{ write a string into output line }
procedure outstg (CHARACs : string);
var
k : integer;
begin for k:=1 to length(CHARACs) do outchr(CHARACs[k]);
end;
{ ===================================================================== }
{ checks the presence of a string at end of current output }
function last_is(CHARACs : string) : boolean;
var
k, long : integer;
begin
long:=length(CHARACs); last_is:=FALSE;
if(kout < long) then exit;
for k:=1 to long do
if (exline[kout-long+k] <> CHARACs[k]) then exit;
last_is:=TRUE;
end;
{ ===================================================================== }
{ remove one string from output }
procedure outrem(CHARACs : string);
var
k, l, long : integer;
begin
long:=length(CHARACs); removed_OK:=last_is(CHARACs);
if(not removed_OK) then exit;
for k:=kout-long+1 to kout do exline[kout]:=' ';
kout:=kout-long;
end;
{ ===================================================================== }
{ remove all empty pairs of braces at the end of output }
procedure outrem_empty_braces;
var
num_removed : integer;
begin
num_removed:=0; removed_OK:=TRUE;
while removed_OK do
begin
outrem('{}'); if removed_OK then num_removed:=num_removed+1;
end
; {END WHILE}
removed_OK:=(num_removed>0);
end;
{---------------------------------------------------------------------------}
{ output a TeX keyword ( the \ not in args ) on output line EXLINE }
procedure outkeyw(CHARACs : string);
var
k : integer;
begin
{ eliminate useless brace pairs terminating a previous keyword}
outrem_empty_braces;
outchr('\'); for k:=1 to length(CHARACs) do outchr(CHARACs[k]);
end;
{---------------------------------------------------------------------------}
{ outputs the new \bf \sl code if different from current at that level }
procedure output_bfsl;
begin
if bfslcode[bracelvl]=currbfsl[bracelvl] then exit
else if bfslcode[bracelvl]='\relax' then exit
else if math_mode[bracelvl]>0 then exit
else
begin outrem_empty_braces; outrem(currbfsl[bracelvl]);
font_subs2e('\rm\bf','\bf');
font_subs2e('\rm\tt','\tt');
font_subs2e('\rm\it','\it');
font_subs2e('\rm\sf','\sf');
font_subs2e('\rm\sl','\sl');
if(latex209) then
else (* latex2e *)
begin
font_subs2e('\bf\it','\bfit');
font_subs2e('\it\bf','\bfit');
font_subs2e('\bf\sl','\bfsl');
font_subs2e('\sl\bf','\bfsl');
font_subs2e('\bf\sf','\sfbf');
font_subs2e('\sf\bf','\sfbf');
font_subs2e('\sf\it','\sfit');
font_subs2e('\sf\sl','\sfsl');
font_subs2e('\tt\bf','\ttbf');
font_subs2e('\tt\it','\ttit');
font_subs2e('\tt\sl','\ttsl');
font_subs2e('\bf\tt','\ttbf');
font_subs2e('\it\tt','\ttit');
font_subs2e('\sl\tt','\ttsl');
font_subs2e('\sfit\bf','\sfbfit');
font_subs2e('\sfsl\bf','\sfbfsl');
font_subs2e('\bfit\sf','\sfbfit');
font_subs2e('\bfsl\sf','\sfbfsl');
end
; {END IF latex209}
outstg(bfslcode[bracelvl]); outstg('{}');
currbfsl[bracelvl]:=bfslcode[bracelvl];
end
end;
{---------------------------------------------------------------------------}
{ outputs the new \large code if different from current at that level }
procedure output_size ( codesize : string24 );
begin
if codesize=currsize[bracelvl] then exit
else if codesize='relax' then exit
else if lvlcode[bracelvl]=8 then exit
else if lvlcode[bracelvl]=9 then exit
else if math_mode[bracelvl]>0 then exit
else
begin outkeyw(codesize);
if (not base_flag) then
begin outstg('{}'); currsize[bracelvl]:=codesize;
end
; {END IF}
currbfsl[bracelvl]:='\relax';
end
end;
{ ----------------------------------------------------------------------}
procedure ensure_sizebfsl;
begin
if(par_to_begin) then exit;
if last_is('{') then output_size(sizecode[bracelvl]);
output_bfsl;
end;
{ ----------------------------------------------------------------------}
procedure output_skips;
begin
if(leftcurskip<>leftskip) then
begin str_twips_pt(leftskip,worksa);
outkeyw('global\leftskip '); outstg(worksa); outstg('pt\relax');
leftcurskip:=leftskip;
end;
if(rightcurskip<>rightskip) then
begin str_twips_pt(rightskip,worksa);
outkeyw('global\rightskip '); outstg(worksa); outstg('pt\relax');
rightcurskip:=rightskip;
end;
end;
{---------------------------------------------------------------------------}
procedure close_files;
begin
close(outputfile); close(inputfile); if write_log then close(logfile);
end;
{ ===================================================================== }
{ remove one keyword from output }
procedure outkrem(CHARACs : string);
begin
outrem('\'+CHARACs);
end;
{ --------------------------------------------------------------------------}
{ open brace and increment bracelvl }
procedure open_brace;
begin
if(bracelvl < maxlevel) then
begin bracelvl:=bracelvl+1;
bfslcode[bracelvl]:=bfslcode[bracelvl-1];
tab_nb_cellx[bracelvl]:=tab_nb_cellx[bracelvl-1];
tab_cellx[bracelvl]:=0;
sizecode[bracelvl]:=sizecode[bracelvl-1];
currsize[bracelvl]:=currsize[bracelvl-1];
currbfsl[bracelvl]:=currbfsl[bracelvl-1];
spacingcode[bracelvl]:=spacingcode[bracelvl-1];
lvlcode[bracelvl]:=lvlcode[bracelvl-1];
if(bracelvl<maxlevel) then lvlcode[bracelvl+1]:=0;
active_RTFf[bracelvl]:=active_RTFf[bracelvl-1];
{ propagate math_mode, but say 2 if previous was 1 to avoid extra closins by $ }
math_mode[bracelvl]:=math_mode[bracelvl-1];
if(math_mode[bracelvl]=1) then math_mode[bracelvl]:=2;
flushright_flag[bracelvl]:=flushright_flag[bracelvl-1];
if(flushright_flag[bracelvl]=2) then flushright_flag[bracelvl]:=3;
center_flag[bracelvl]:=center_flag[bracelvl-1];
if(center_flag[bracelvl]=2) then center_flag[bracelvl]:=3;
underl_flag[bracelvl]:=FALSE;
auto_close[bracelvl]:=FALSE; form_code[bracelvl]:=''; close_kar[bracelvl]:=' ';
if(lvlcode[bracelvl]=3) then lvlcode[bracelvl]:=4
else if(lvlcode[bracelvl]=10) then {in objects}
lvlcode[bracelvl]:=-lvlcode[bracelvl]
else if(lvlcode[bracelvl]=15) then {brace opened after \RTFintbl => set normal}
lvlcode[bracelvl]:=0
else if(lvlcode[bracelvl] >= 16) then {in formulas}
lvlcode[bracelvl]:=-lvlcode[bracelvl]
; {END IF}
end
else
begin sign_str(maxlevel,works);
print_msg(0,'Too many brace levels, max is '+works);
sign_str(NUML+1,works); println_msg(0,' at line'+works);
print_line(0); if write_log then close_files; halt;
end
; {END IF bracelvl<maxlevel}
end;
{---------------------------------------------------------------------------}
{ output \begin(<arg>) }
procedure begin_env(environ : integer);
begin
if (kout>0) then output_line; outkeyw('begin{');
outstg(environ_type[environ]); outstg('}\strut');
open_brace; output_line;
end;
{ ----------------------------------------------------------------------}
(* execute \begin{center}/{flushright} is center_flag set to 1 *)
procedure make_center;
begin
if center_flag[bracelvl]=1 then
begin begin_env(1); center_flag[bracelvl]:=2;
end
;
if flushright_flag[bracelvl]=1 then
begin begin_env(2); flushright_flag[bracelvl]:=2;
end
;
end;
{ ----------------------------------------------------------------------}
procedure begin_par;
var
k : integer;
begin if (not par_to_begin) then exit;
if (lvlcode[bracelvl]=6) then exit;
if (lvlcode[bracelvl]=8) then exit;
if (lvlcode[bracelvl]=9) then exit;
if ((center_flag[bracelvl]+flushright_flag[bracelvl])=0) then
output_skips;
space_after:=save_skip; save_skip:=0;
if (num_indent=0) and (lvlcode[bracelvl]<>15)
and (center_flag[bracelvl]=0) and (flushright_flag[bracelvl]=0) then
outkeyw('noindent ');
for k:=2 to num_indent do outkeyw('indent '); num_indent:=0; make_center;
output_size(sizecode[bracelvl]); output_bfsl;
outkeyw('beginparagraph{}');
par_to_begin:=FALSE;
end;
{---------------------------------------------------------------------------}
{ write a string into math mode onto output line, and leave in math mode }
procedure out_math_leave (CHARACs : string);
begin
if math_mode[bracelvl]>0 then outchr(' ')
else
begin outrem_empty_braces; outrem('$');
if removed_OK then math_mode[bracelvl]:=1;
end
; {END IF math_mode}
if math_mode[bracelvl]=0 then
begin begin_par; outchr('$'); math_mode[bracelvl]:=1;
end
; {END IF math_mode=0}
outstg(CHARACs);
end;
{---------------------------------------------------------------------------}
{ close math_mode if possible, i.e. =1 }
procedure close_math;
begin
if math_mode[bracelvl]=1 then
begin outstg(end_math_code); math_mode[bracelvl]:=0;
end
; {END IF math_mode}
end;
{---------------------------------------------------------------------------}
{ write a string into math mode onto output and close math mode if possible}
procedure out_math (CHARACs : string);
begin
out_math_leave(CHARACs); close_math;
end;
{ ===================================================================== }
{ output one string and capitalize it if required }
procedure outstgc(CHARACs : string);
var
k : integer;
begin
for k:=1 to length(CHARACS) do outchrc(CHARACs[K]);
end;
{ ===================================================================== }
{ output a number }
procedure output_num(numb : integer);
var
wkk : string24;
begin
sign_str(numb, wkk);
outstg(wkk);
end;
{ ===================================================================== }
{ output one keyword and capitalize it }
procedure outkeywc(CHARACs : string);
var
k : integer;
begin
outrem_empty_braces; outchr('\');
for K:=1 to length(CHARACS) do outchrc(CHARACs[K]);
end;
{ ===================================================================== }
{ close brace pair and remove all sub/superscripted empty pairs at end of output }
procedure close_subs;
begin
if(math_mode[bracelvl]>0) then outrem(' '); outchr('}');
outrem('^{}'); outrem('_{}'); outrem('^{ }'); outrem('_{ }');
end;
{ ===================================================================== }
{ declares a new font as \global, and record it }
procedure declare_font(font_id, fontname: string; magnification : integer);
var
i,j : integer;
begin
for i:=1 to numfonts do
if (newfonts[i]=font_id) then exit;
if (numfonts >= maxfonts) then
begin
println_msg(0,'Font '+font_id+' cannot be declared... too many fonts !'); exit;
end
; {END IF}
numfonts:=numfonts+1; newfonts[numfonts]:=truncate24(font_id);
if(kout > 1) then output_line; { to have font decl at left of a line }
outstg('\ifx'); outstg(font_id); outstg('\undefined \global\font');
outstg(font_id); outstg('=\FontHdg\FontHdge '); outstg(fontname);
sign_str(magnification,works);
outstg(' scaled '); outstg(works); outstg('\fi'); output_line;
end;
{ ===================================================================== }
{ change contents of bfslcode[bracelvl] : replace first arg with 2nd }
procedure font_subs(old, new, fontname: string; magnification : integer);
var
workstg : string[48];
positn : integer;
begin
positn:=pos(old,bfslcode[bracelvl]); if(positn=0) then exit;
if lvlcode[bracelvl]= 9 then exit; (* ignore new fonts in header/footer *)
workstg:=bfslcode[bracelvl]; delete(workstg,positn,length(old));
if (pos(new,bfslcode[bracelvl])=0) then insert(new,workstg,positn);
bfslcode[bracelvl]:=truncate24(workstg);
declare_font(new, fontname, magnification);
end;
{---------------------------------------------------------------------------}
{ builds the correct LaTeX font size according to NUMVAL (unit=1/2 pt) }
{ stores it in sizecode[bracelvl] ; uses the global variable "stdsize" }
procedure outfsize (numval : integer; var magnif : integer);
var
ll, selectsize, latex_size, best_diff: integer;
begin
{ I select the nearest sizemags }
latex_size:=numval*50; (* convert from half points to hundredths of points *)
best_diff:=30000; (* big integer *)
sizecode[bracelvl]:='tiny'; selectsize:=0;
for LL:=1 to numsizes do
begin
if(abs(sizemags[stdkz,ll]-latex_size) < best_diff) then
begin sizecode[bracelvl]:=sizekey[LL]; selectsize:=sizemags[stdkz,ll];
magnif:=sizemags[stdkz,ll]; best_diff:=abs(selectsize-latex_size);
end
; {END IF}
end
; {END DO}
sign_str(selectsize,works); println_msg(2,' selectsize='+works+' xkey='+sizecode[bracelvl]);
end;
{---------------------------------------------------------------------------}
procedure font_clean (sizeheader : string; magnification : integer);
begin
if(latex209) then
begin
font_subs('\rm\bf\it',sizeheader+'bfit','bxti10',magnification);
font_subs('\rm\it\bf',sizeheader+'bfit','bxti10',magnification);
font_subs('\rm\bf\sl',sizeheader+'bfsl','bxsl10',magnification);
font_subs('\rm\sl\bf',sizeheader+'bfsl','bxsl10',magnification);
font_subs('\rm\bf\sf',sizeheader+'sfbf','ssbx10',magnification);
font_subs('\rm\sf\bf',sizeheader+'sfbf','ssbx10',magnification);
font_subs('\bf\it',sizeheader+'bfit','bxti10',magnification);
font_subs('\it\bf',sizeheader+'bfit','bxti10',magnification);
font_subs('\bf\sl',sizeheader+'bfsl','bxsl10',magnification);
font_subs('\sl\bf',sizeheader+'bfsl','bxsl10',magnification);
font_subs('\bf\sf',sizeheader+'sfbf','ssbx10',magnification);
font_subs('\sf\bf',sizeheader+'sfbf','ssbx10',magnification);
if magnification>2000 then
begin {definir explicitement les grosses polices}
font_subs('\rm\oul',sizeheader+'obf','obx10',magnification);
font_subs('\rm\sf',sizeheader+'sf','ss10',magnification);
font_subs('\rm\it',sizeheader+'it','ti10',magnification);
font_subs('\rm\sl',sizeheader+'sl','sl10',magnification);
font_subs('\rm\sc',sizeheader+'sc','csc10',magnification);
font_subs('\rm\tt',sizeheader+'tt','tt10',magnification);
font_subs('\sf',sizeheader+'sf','ss10',magnification);
font_subs('\it',sizeheader+'it','ti10',magnification);
font_subs('\sl',sizeheader+'sl','sl10',magnification);
font_subs('\sc',sizeheader+'sc','csc10',magnification);
font_subs('\tt',sizeheader+'tt','tt10',magnification);
end
;
end
else (* latex2e *)
begin
font_subs2e('\rm\bf\it','\bfit');
font_subs2e('\rm\it\bf','\bfit');
font_subs2e('\rm\bf\sl','\bfsl');
font_subs2e('\rm\sl\bf','\bfsl');
font_subs2e('\rm\bf\sf','\sfbf');
font_subs2e('\rm\sf\bf','\sfbf');
font_subs2e('\rm\sf\it','\sfit');
font_subs2e('\rm\sf\sl','\sfsl');
font_subs2e('\bf\it','\bfit');
font_subs2e('\it\bf','\bfit');
font_subs2e('\bf\sl','\bfsl');
font_subs2e('\sl\bf','\bfsl');
font_subs2e('\bf\sf','\sfbf');
font_subs2e('\sf\bf','\sfbf');
font_subs2e('\sf\it','\sfit');
font_subs2e('\sf\sl','\sfsl');
if magnification>2000 then
begin {definir explicitement les grosses polices}
font_subs('\rm\oul',sizeheader+'obf','obx10',magnification);
font_subs('\rm\sf',sizeheader+'sf','ss10',magnification);
font_subs('\rm\it',sizeheader+'it','ti10',magnification);
font_subs('\rm\sl',sizeheader+'sl','sl10',magnification);
font_subs('\rm\sc',sizeheader+'sc','csc10',magnification);
font_subs('\rm\tt',sizeheader+'tt','tt10',magnification);
font_subs('\sf',sizeheader+'sf','ss10',magnification);
font_subs('\it',sizeheader+'it','ti10',magnification);
font_subs('\sl',sizeheader+'sl','sl10',magnification);
font_subs('\sc',sizeheader+'sc','csc10',magnification);
font_subs('\tt',sizeheader+'tt','tt10',magnification);
end
;
end
; {END IF latex209}
font_subs('\rm\oul',sizeheader+'obf','obx10',magnification);
end;
{---------------------------------------------------------------------------}
{ output the correct LaTeX spacing size according to NUMVAL (unit=1/20 pt) }
{ stores it in spacingcode[bracelvl] ; uses the global variable "stdsize" }
procedure outpsize (numval : integer);
var
ll, selectsize, best_diff: integer;
begin
if base_flag then
begin str_twips_pt(numval,worksa);
spacingcode[bracelvl]:=truncate24('baselineskip'+worksa+'pt');
end
else
begin
{ I select the nearest sizeval -- spacings in twips }
best_diff:=30000; (* big integer *)
spacingcode[bracelvl]:='tiny'; selectsize:=0;
for LL:=1 to numsizes do
begin
if(abs(sizeval[stdkz,ll]-numval) < best_diff) then
begin
spacingcode[bracelvl]:=sizekey[ll]; selectsize:=sizeval[stdkz,ll];
best_diff:=abs(sizeval[stdkz,ll]-numval);
end
; {END IF}
end
; {END DO}
sign_str(numval,works); sign_str(selectsize,worksa);
print_msg(2,'--> (\par)numval='+works+' selectsize='+worksa+
' pkey='+spacingcode[bracelvl]);
end
; {END IF}
end;
{---------------------------------------------------------------------------}
{ remove $^ before, and remove math_mode if possible }
procedure remove_mathat;
begin
if(math_mode[bracelvl]>0) then
begin
if(auto_close[bracelvl]) then
begin outrem('{'); if removed_OK then bracelvl:=bracelvl-1;
end;
outrem('^'); outrem('\relax');
if(math_mode[bracelvl]=1) then
begin outrem('$'); if(removed_ok) then math_mode[bracelvl]:=0;
end;
end
; {END IF math_mode}
outrem('{}');
end;
{ --------------------------------------------------------------------------}
{ close brace and decrement bracelvl }
procedure close_brace;
begin
if(bracelvl <= 0) then
begin sign_str(NUML+1,works); println_msg(0,'Too many } at line '+works);
print_line(0); outstg('}%%%%% *****');
end
else
if lvlcode[bracelvl]<>6 then
if tex_verbose>1 then
begin sign_str(bracelvl,worksa); sign_str(lvlcode[bracelvl], works);
outstg('\closebr{'+worksa+'['+works+']}\relax'); output_line;
end
;
bracelvl:=bracelvl-1;
{ reset footnote cleaning }
if(lvlcode[bracelvl]= 3) then lvlcode[bracelvl]:=0;
; {END IF bracelvl}
end;
{---------------------------------------------------------------------------}
{ output \end(<arg>) }
procedure end_env(environ : integer);
begin
output_line; outkeyw('end{'); outstg(environ_type[environ]); outchr('}');
close_brace; output_line;
end;
{---------------------------------------------------------------------------}
{ stores a new couple of word font chars and number taken in
decl_font_num which is a global variable }
procedure store_word_font(font_type : string);
var
k : integer;
new_fnt_name : string[255];
loc_brace_count : integer;
begin
sign_str(decl_font_num,works);
for k:=1 to num_word_fonts do
if word_font_num[k]=decl_font_num then
begin println_msg(0,'RTF font No. '+works+'/'+font_type+
' already declared; this one ignored.'); exit;
end
; {END/IF + END FOR}
if num_word_fonts >= maxfonts then
begin println_msg(0,'Too many RTF fonts: '+works+
'/'+font_type+'; this one ignored.'); exit;
end
; {END IF}
new_fnt_name:=''; loc_brace_count :=0;
while ((kar<>';') and (kar<>'}')) or (loc_brace_count>0) do
(* while (kar<>';') do *)
begin
if kar='{' then loc_brace_count:=loc_brace_count+1;
if kar='}' then loc_brace_count:=loc_brace_count-1;
read_char; if kar<>' ' then new_fnt_name:=new_fnt_name+kar;
end
;
outrem_empty_braces; num_word_fonts:=num_word_fonts+1;
word_font_num[num_word_fonts]:=decl_font_num;
word_fonts[num_word_fonts]:=truncate24(font_type);
sign_str(num_word_fonts,worksa);
if (pos('Courier',new_fnt_name)>0) then
equiv_fonts[num_word_fonts]:='\tt'
else if (pos('TTY',new_fnt_name)>0) then
equiv_fonts[num_word_fonts]:='\tt'
else if (pos('Helvetica',new_fnt_name)>0) then
equiv_fonts[num_word_fonts]:='\sf'
else if (pos('SansSerif',new_fnt_name)>0) then
equiv_fonts[num_word_fonts]:='\sf'
else
equiv_fonts[num_word_fonts]:=''
; {END IF}
println_msg(2,worksa+' Font '+works+' stored: "'+font_type+'" = '
+new_fnt_name);
end;
