program agmath2a; {produziert aus verschiedenen Ausgangsmengen als
Grenzmengen: Farn, Blatt, Drache, Gras, selbstdefiniert; erlaubt Collagen f�r
gew�nschte Grenzmengen, Bildpunkte, Urbildpunkte zu konstruieren und
Abbildungsdaten auszugeben.
Voreinstellung Optionen/Memory/Stack: 65520}

uses crt,graph,graph0,dialog2,xpzeich1;

type triple = array[1..3] of word; {(tr[1],tr[2])=Pixel, tr[3]=Farbe}
     screenfile = file of triple;  {nimmt Pixelpunkt mit Farbe auf}
     chart = array[0..9] of byte;   {registriert die Farben f�r IFS-Abb.}
     matrix = array[1..2,1..2] of real;
     vector = array[1..2] of real;  {f�r affine Abbildung f(z)=A*z+b}
     polygon = record
                 zahl:integer;  {Anzahl der Eckpunkte}
                 punkt:array[1..10] of vector;
                 end;
     vectripel = array[1..3] of vector;
     matarray =  array[0..5] of matrix;
     vecarray = array[0..5] of vector;
     trarray = array[0..5] of vectripel;
     sarray = array[1..5] of real;   {Verk�rzungen f�r Dimensionsberechnung}
     coll=record
            hg,h:integer; {Anzahl und Nummer der Collage-Komponenten}
            A:matrix;     {Collage-Matrix}
            b:vector;     {Collage-Verschiebungsvektor}
            end;
     collagefile = file of coll;
     inventar = file of string;
     polyfile = file of polygon;

var A:matrix;
    Aa:matarray;
    b,d,o,zf:vector;
    ba,fix:vecarray;
    tr:triple;
    screen:screenfile;
    colorchart,oldcolorchart:chart;
    pol,bildpol:polygon;
    hg:array[0..7] of integer;
    ch,chm,chi,che,chpol:char;
    imin,imax,jmin,jmax,nenner,
    am,g,h,hg5,k,n,l,i,j,graphdriver,graphmode,
      x0,y0,x1,y1,x2,y2,x3,y3:integer;
    links,rechts,unten,oben,c1,c2,phi,sc,c,r,dim:real;
    tra,trb:vectripel;
    trar:trarray;
    sar:sarray;        {Žhnlichkeitsfaktoren f�r Dimensionsberechnung}
    collfile:collagefile;
    invfile:inventar;
    colpolyfile,polfile:polyfile;
    readpol,neu:boolean;

procedure polygonausgabe(pol:polygon);
  var i:integer;
begin
writeln;
with pol do
  for i:=1 to zahl do
    writeln('  P[',i,'] = (',punkt[i,1]:4:2,',',punkt[i,2]:4:2,')');
end;  {polygonausgabe}

procedure readpolyfile(var pol:polygon;var polfile:polyfile;
                        var invfile:inventar; var readpol:boolean);
  var                  {das in der Inventardatei "Polygone" verzeichnete}
      polstr:string;  {Polygon "polstr" wird in die Variable pol }
      h,k,k0:integer;  {aufgenommen}
begin
clrscr;
k:=-1;
k0:=0;
writeln;
assign(invfile,'Polygone');   {Ausgabe der Eintr„ge in der Inventardatei}
reset(invfile);               {'Polygone}
writeln(' Die folgenden Polygone k”nnen eingelesen werden:');
while not eof(invfile) do
  begin
  k:=k+1;
  read(invfile,polstr);
  writeln('     ',polstr,' ... ',k);
  end;  {while}
k0:=k;
close(invfile);                {Ende der Ausgabe}
writeln;
write(' Abgerufen wird das Polygon Nummer k =');
repeat readgwritexy(wherex,wherey,2,k)
  until ((0<=k) and (k<=k0));
reset(invfile);                 {Aus der Inventarfile 'Polygone' wird}
seek(invfile,k);                {der Name des gew�nschten Polygons}
read(invfile,polstr);           {entnommen}
close(invfile);
writeln;
assign(polfile,polstr+'.pol');
reset(polfile);                 {Die Polygondatei mit dem Namen polstr}
read(polfile,pol);              {ge”ffnet und das Polygon in der Variablen}
close(polfile);                 {pol �bernommen}
readpol:=true;
polygonausgabe(pol);
ch:=readkey;
end;  {readpolyfile}

procedure readrsafe(var r:real;grafik:boolean);
 var code:integer;
     st:string;
     x,y:integer;
begin
x:=wherex;
y:=wherey;
if grafik then
  if y>4 then y:=1;
repeat
  gotoxy(x,y);
  reset(input);
  read(st);
  val(st,r,code);
  until code=0;
end;  { readrsafe }

procedure xpnumberxy(z:real;a,d,x,y,color:integer;var xarr:xarray);
  var i,j,k,xz,yz,n,c,code,
      oldcolor:integer;            {Ausgabe der Zahl z im Grafikmodus f�r}
      st:string;                   {das Betriebssystem XP; Anfang im linken}
      ch,chi:char;                 {oberen Pixelpunkt (x,y), in Farbe color}
begin
oldcolor:=getcolor;
setcolor(color);
xar(color,xarr);
str(z:a:d,st);
for i:=1 to length(st) do
  begin
  xz:=x+(i-1)*width;
  yz:=y;
  chi:=st[i];
  n:=ord(chi);
  for j:=0 to 7 do
    for k:=0 to 7 do
      begin
      xz:=x+(i-1)*8+k;
      yz:=y+j;
      c:=xarr[n,j,k];
      if c<>0 then c:=color;
      putpixel(xz,yz,c);
      end;   {k-Schleife}
  end;  {i-Schleife}
setcolor(oldcolor);
end;  {xpnumberxy}

procedure xptextxy(st:string;x,y,color:integer;var xarr:xarray);
  var i,j,k,xz,yz,n,
      c,oldcolor:integer;  {Ausgabe des Strings st im Grafikmodus f�r das}
      ch,chi:char;         {Betriebssystem XP; Anfang im linken}
                           {oberen Pixelpunkt (x,y), in Farbe color}
begin
setbkcolor(15);
oldcolor:=getcolor;
setcolor(color);
xar(color,xarr);
for i:=1 to length(st) do
  begin
  xz:=x+(i-1)*width;
  yz:=y;
  chi:=st[i];
  n:=ord(chi);
  if n>63 then outtextxy(xz,yz,chi)    {chi = gew”hnlicher Buchstabe}
    else                               {chi = Zeichen}
    for j:=0 to 7 do
      for k:=0 to 7 do
        begin
        xz:=x+(i-1)*8+k;
        yz:=y+j;
        putpixel(xz,yz,xarr[n,j,k]);
        end;   {k-Schleife}
  end;  {i-Schleife}
setcolor(oldcolor);
end;  {xptextxy}

procedure axes(color:word);          {Koordinatenachsen}
begin
setcolor(color);
line(width,y0,maxx-width,y0);
line(x0,height,x0,maxy-height);
horimarkexy(x0,y1);
vertmarkexy(x1,y0);
xpnumberxy(0,1,0,x0-10,y0+height,color,xarr);
xpnumberxy(1,1,0,x1,y0+height,color,xarr);
xpnumberxy(1,1,0,x0-10,y1,color,xarr);
end;  {axes}


procedure bild(var links,rechts,unten,oben,s:real;
               var x0,y0,x1,y1:integer);
begin
links:=-0.6/s;
rechts:=1.2/s;
unten:=-0.2/s;
oben:=1.2/s;
x0:=bildx(links,rechts,0);
y0:=bildy(unten,oben,0);
x1:=bildx(links,rechts,1);
y1:=bildy(unten,oben,1);
end;  {bild}

procedure kolorierung(ch:char;var colorchart:chart);
  var i:integer;
begin
case ch of
  '1':for i:=0 to 9 do colorchart[i]:=1;
  'v':for i:=0 to 9 do colorchart[i]:=i;
  end;  {case ch}
end;  {kolorierung}

procedure zeroaffine(var A:matrix; var b:vector);
  var i,j:integer;
begin
for i:=1 to 2 do
  begin
  b[i]:=0;
  for j:=1 to 2 do
    A[i,j]:=0;
  end; {i-Schleife}
end;  {zeroaffine}

procedure emptypol(var pol:polygon);  {Initialisierung eines Polynoms}
  var i:integer;
begin
pol.zahl:=0;
for i:=1 to 10 do
  begin
  pol.punkt[i,1]:=0;
  pol.punkt[i,2]:=0;
  end; {i-Schleife}
end;  {emptypol}

procedure affin(A:matrix;b:vector;var z,za:vector);
  var i:byte;                           {affine Abbildung z->za=A*z+b}
begin
for i:=1 to 2 do
  za[i]:=A[i,1]*z[1]+A[i,2]*z[2]+b[i];
end;  {affine}

procedure invers(var A,AI:matrix);
  var d:real;     {A*AI=I}
      i,j:byte;
begin
d:=A[1,1]*A[2,2]-A[1,2]*A[2,1];
for i:=1 to 2 do
  AI[i,i]:=A[3-i,3-i]/d;
AI[1,2]:=-A[1,2]/d;
AI[2,1]:=-A[2,1]/d;
end;   {invers}

procedure affinvers(A:matrix;b:vector;var z,zi:vector);
  var d:real;    {zu gegebenem z wird zi mit z=A.zi+b ausgegeben}
begin
d:=A[1,1]*A[2,2]-A[1,2]*A[2,1];
zi[1]:=(A[1,1]*(z[1]-b[1])-A[2,1]*(z[2]-b[2]))/d;
zi[2]:=(-A[1,2]*(z[1]-b[1])+A[2,2]*(z[2]-b[2]))/d;
end;   {affinvers}

procedure initiateaffine(g,h:integer;phi,r:real;var A:matrix;var b,d:vector);
begin               {A und b werden geladen; g...Nummer der Grenzwertmenge}
case g of           {h...Nummer der zugeh”rigen Collage-Abbildung}
1:begin    { Barnsley-Farn } {phi und d sind Positionsparameter f�r das Gras}
  case h of
    1:begin
     A[1,1]:=0;
     A[1,2]:=0;
     A[2,1]:=0;
     A[2,2]:=0.16;
     b[1]:=0.5;
     b[2]:=0;
     end;
    2:begin
     A[1,1]:=0.849;
     A[1,2]:=0.037;
     A[2,1]:=-0.037;
     A[2,2]:=0.8495;
     b[1]:=0.075;
     b[2]:=0.183;
     end;
   3:begin
     A[1,1]:=0.197;
     A[1,2]:=-0.226;
     A[2,1]:=0.226;
     A[2,2]:=0.197;
     b[1]:=0.4;
     b[2]:=0.049;
     end;
   4:begin
     A[1,1]:=-0.15;
     A[1,2]:=0.283;
     A[2,1]:=0.26;
     A[2,2]:=0.237;
     b[1]:=0.575;
     b[2]:=-0.084;
     end;
    end{case h}
  end; {g=1, Barnsley-Farn }
2:begin             {Blatt}
 case h of
   1:begin
     A[1,1]:=r*0.6;
     A[1,2]:=0;
     A[2,1]:=0;
     A[2,2]:=r*0.6;
     b[1]:=r*0.18;
     b[2]:=r*0.36;
     end;
   2:begin
     A[1,1]:=r*0.6;
     A[1,2]:=0;
     A[2,1]:=0;
     A[2,2]:=r*0.6;
     b[1]:=r*0.18;
     b[2]:=r*0.12;
     end;
   3:begin
     A[1,1]:=r*0.4;
     A[1,2]:=r*0.3;
     A[2,1]:=-r*0.3;
     A[2,2]:=r*0.4;
     b[1]:=r*0.27;
     b[2]:=r*0.36;
     end;
   4:begin
     A[1,1]:=r*0.4;
     A[1,2]:=-r*0.3;
     A[2,1]:=r*0.3;
     A[2,2]:=r*0.4;
     b[1]:=r*0.27;
     b[2]:=r*0.09;
     end;
   end{case h}
 end; {g=2, Blatt}
3:begin             {Drache}
 case h of
   1:begin
    A[1,1]:=r*0.5;
    A[1,2]:=-r*0.61;
    A[2,1]:=r*0.35;
    A[2,2]:=r*0.47;
    b[1]:=r*0.34;
    b[2]:=r*0.4;
    end;
  2:begin
    A[1,1]:=r*0.5;
    A[1,2]:=-r*0.61;
    A[2,1]:=r*0.35;
    A[2,2]:=r*0.47;
    b[1]:=r*0.5;
    b[2]:=r*0.1;
    end;
   end; {case h}
 end;  {g=3, Drache}
4:begin             {Gras}
  case h of
     1:begin         {Stiel}
      A[1,1]:=0;
      A[1,2]:=0;
      A[2,1]:=0;
      A[2,2]:=r*d[2];
      b[1]:=r*0.5;
      b[2]:=r*0.11;
      end;
    2:begin          {Mittelteil}
      A[1,1]:=r*(0.60*cos(phi)-0.0324*sin(phi));
      A[1,2]:=r*(-0.6984*sin(phi));
      A[2,1]:=r*(0.0324*cos(phi)+0.60*sin(phi));
      A[2,2]:=r*(0.6984*cos(phi));
      b[1]:=r*((0.2-d[1])*cos(phi)-(0.2-d[2])*sin(phi)+d[1]);
      b[2]:=r*((0.26-d[2])*cos(phi)+(0.26-d[1])*sin(phi)+d[2]);
      end;
    3:begin          {linkes Blatt}
      A[1,1]:=r*0.3216;
      A[1,2]:=-r*0.414;
      A[2,1]:=r*0.2784;
      A[2,2]:=r*0.414;
 (*     b[1]:=r*0.408;
      b[2]:=r*0.042;*)
      b[1]:=r*0.404;
      b[2]:=r*0.008;
      end;
    4:begin          {rechtes Blatt}
      A[1,1]:=r*0.246;
      A[1,2]:=r*0.4368;
      A[2,1]:=-r*0.2232;
      A[2,2]:=r*0.3492;
      b[1]:=r*0.3116;
      b[2]:=r*0.368;
      end;
    end{case h}
  end; {g=4, Gras}
5:begin             {selbstdefiniert}
  case h of
     1:begin
      A:=Aa[1];
      b:=ba[1];
      end;
    2:begin
      A:=Aa[2];
      b:=ba[2];
      end;
    3:begin
      A:=Aa[3];
      b:=ba[3];
      end;
    4:begin
      A:=Aa[4];
      b:=ba[4];
      end;
    5:begin
      A:=Aa[5];
      b:=ba[5];
      end;
    end{case h}
  end; {g=5, selbstdefiniert}
end;  {case g, Nummer der Grenzwertmenge}
end;  {initiateaffine}

procedure applyifs(g:integer;var screen:screenfile;colorchart:chart);
  var tr:triple;   {auf die Punkte z, die den Bildschirmpixeln entsprechen,}
      i,j,p:word;  {werden die Collage-Affinit„ten ausge�bt; die den}
      dx,dy,x,y,xf,yf:real;  {Bildpunkten za entsprechenden Pixel werden}
      b,z,za:vector;         {zusammen mit dem Farbwert als Tripel tr in}
      A:matrix;              {der Datei screen0 abgelegt}
begin
dx:=(rechts-links)/maxx;     {Pixel-Inkrement in x-Richtung}
dy:=(oben-unten)/maxy;       {Pixel-Inkrement in y-Richtung}
assign(screen,'screen0');
rewrite(screen);             {Tripel-Datei 'screen0' nimmt Bild-Tripel auf}
for i:=0 to maxx do          {Bildschirm wird Spaltenweise bearbeitet}
  begin
  z[1]:=dx*(i-x0);
  for j:=0 to maxy-10 do
    if getpixel(i,j)<>0 then   {zur Urbildmenge geh”rige Pixel werden erfaát}
      begin
      z[2]:=dy*(y0-j);
      for h:=1 to hg[g] do
        begin
        tr[3]:=colorchart[h];       {ihre Bilder mit der Farbe der Collage-}
        initiateaffine(g,h,phi,r,A,b,d);  {Abbildung Nummer h versehen}
        affin(A,b,z,za);            {die zugeh”rigen Punkte abgebildet}
        tr[1]:=bildx(links,rechts,za[1]);   {und die zugeh”rigen Pixel}
        tr[2]:=bildy(unten,oben,za[2]);
        write(screen,tr);                   {in 'screen0' gespeichert}
        end;  {k-Schleife}
      end;  {getpixel(i,j)<>0}
  end;  {i-Schleife}
close(screen);
cleardevice;                         {in den geleerten Bildschirm}
reset(screen);
repeat
  read(screen,tr);                   {werden die aus 'screen0' eingelesenen}
  putpixel(tr[1],tr[2],tr[3]);       {Bildpixel eingesetzt}
  until eof(screen);                 {und so das Collage-Bild ausgegeben}
close(screen);
end;  {applyifs}

procedure initiatescreen(var screen:screenfile;am:integer);
  var i,j:word;         {die mit am nummerierte Initialmenge wird pixelweise}
      dx,dy,x,y:real;   {in die Datei 'screen0' in roter Farbe eingegeben}
      tr:triple;
      boole1,boole2,boole3,boole4,boole:boolean;
begin
dx:=(rechts-links)/maxx;
dy:=(oben-unten)/maxy;
tr[3]:=4;                  {rote Pixelfarbe}
randomize;                 {f�r eine eventuelle Zufalls-Ausgangsmenge}
assign(screen,'screen0');
rewrite(screen);
for i:=0 to maxx do        {spaltenweise Eingabe}
  begin
  tr[1]:=i;
  x:=dx*(i-x0);            {Abszisse des Pixels (i,j)}
  for j:=0 to maxy -2*height do
    begin
    tr[2]:=j;
    y:=dy*(y0-j);          {Ordinate des Pixels (i,j)}
    case am of             {Charakterisierung der Ausgangsmengen-Pixel}
      1:begin
        boole1:=((abs(x-0.5)<=0.5) and (abs(y)<0.005));    {Quadratseiten}
        boole2:=((abs(x-0.5)<=0.5) and (abs(y-1)<0.005));  {Einheitsquadrat}
        boole3:=((abs(y-0.5)<=0.5) and (abs(x)<0.005));
        boole4:=((abs(y-0.5)<=0.5) and (abs(x-1)<0.005));
        boole:=(boole1 or boole2 or boole3 or boole4)
        end;  {1}
      2:boole:=((abs(x-0.5)<=0.5) and (abs(y-0.5)<=0.5));   {Vollquadrat}
      3:boole:=((x>=0) and (y>=0) and (x*x+y*y<=1));        {Viertelkreis}
      4:boole:=(x-0.5)*(x-0.5)+(y-0.5)*(y-0.5)<=0.25;       {Vollkreis}
      5:boole:=((abs(x-0.5)<=0.5) and (abs(y-0.5)<=0.5) and (random(n)=1));
      6:boole:=((x>=0) and (y>=0) and (x+y<=1));            {Dreieck}
      7:begin
        boole1:=((abs(x-0.5)<=0.25) and (abs(y-0.25)<0.005)); {Quadratseiten}
        boole2:=((abs(x-0.5)<=0.25) and (abs(y-0.75)<0.005)); {Kleinquadrat}
        boole3:=((abs(y-0.5)<=0.25) and (abs(x-0.25)<0.005));
        boole4:=((abs(y-0.5)<=0.25) and (abs(x-0.75)<0.005));
        boole:=(boole1 or boole2 or boole3 or boole4)
        end;  {7}
      8:boole:=((abs(x-0.5)<=0.25) and (abs(y-0.5)<=0.25)); {kleines Vollqu.}
      9:boole:=((abs(x-0.5)<=0.5) and (abs(y)<0.005));    {Einheitsintervall}
      end;  {case}
    if boole then
      begin
      putpixel(i,j,1);       {falls Pixel (i,j) zur Ausgangsmenge geh”rt,}
      write(screen,tr);      {wird es als Tripel mit Farbe blau in 'screen0'}
      end;  {boole}          {aufgenommen}
    end;  {j-Schleife}
  end;    {i-Schelife}
close(screen);
end;  {initiatescreen}

procedure polygongraph(pol:polygon;color:word);
var i:integer;          {das durch den record pol gegebene Polyon wird}
   bpx,bpy:array[1..11] of integer;
begin                   {auf dem Bildschirm in Farbe color ausgegeben}
axes(7);
setcolor(color);
with pol do
  begin
  bpx[zahl+1]:=bildx(links,rechts,punkt[1,1]);  {Vorbereitung der Verbindung}
  bpy[zahl+1]:=bildy(unten,oben,punkt[1,2]);    {des ersten Polygonpunktes}
  for i:=1 to zahl do                           {mit dem letzten}
    begin
    bpx[i]:=bildx(links,rechts,punkt[i,1]);
    bpy[i]:=bildy(unten,oben,punkt[i,2]);      {Verbindungslinie aufeinander}
    end; {i-Schleife}                          {folgender Punkte, angefangen}
  for i:=1 to zahl do line(bpx[i],bpy[i],bpx[i+1],bpy[i+1]);{mit dem letzten}
  end; {pol}
end; {polygongraph}

procedure abbildung(tra,trb:vectripel;var A:matrix;var b:vector);
type dmatrix = array[1..3,1..3] of real;
var DM:dmatrix;   {Konstruktion einer affinen Abbildung x-->Ax+b,}
    i,j:integer;  {die drei Punkte (tra) in drei Punkte (trb) �berf�hrt}
    d:real;
    tr:array[1..2,1..3] of real;
begin
d:=(tra[2,1]-tra[1,1])*(tra[3,2]-tra[1,2])- {Determinante der 3x3-Matrix DM}
(tra[2,2]-tra[1,2])*(tra[3,1]-tra[1,1]);
DM[1,1]:=(tra[2,2]-tra[3,2])/d;
DM[2,1]:=(tra[3,1]-tra[2,1])/d;
DM[3,1]:=(tra[2,1]*tra[3,2]-tra[2,2]*tra[3,1])/d;
DM[1,2]:=(tra[3,2]-tra[1,2])/d;
DM[2,2]:=(tra[1,1]-tra[3,1])/d;
DM[3,2]:=(tra[3,1]*tra[1,2]-tra[3,2]*tra[1,1])/d;
DM[1,3]:=(tra[1,2]-tra[2,2])/d;
DM[2,3]:=(tra[2,1]-tra[1,1])/d;
DM[3,3]:=(tra[1,1]*tra[2,2]-tra[1,2]*tra[2,1])/d;
for j:=1 to 2 do
for i:=1 to 3 do
  tr[j,i]:=DM[i,1]*trb[1,j]+DM[i,2]*trb[2,j]+DM[i,3]*trb[3,j];
for j:=1 to 2 do
  begin
  b[j]:=tr[j,3];
  for i:=1 to 2 do
    A[j,i]:=tr[j,i];
  end; {j-Schleife}
end;  {abbildung}

procedure grid(color:word);{�berdeckt das Einheitsquadrat im Graphmodus}
begin                      {mit Koorinatenlinien}
setcolor(color);
for i:=0 to 10 do
  begin
  line(bildx(links,rechts,i/10),y0,bildx(links,rechts,i/10),y1);
  line(x0,bildy(unten,oben,i/10),x1,bildy(unten,oben,i/10));
  xpnumberxy(i/10,3,1,bildx(links,rechts,i/10),y0+2*height,color,xarr);
  xpnumberxy(i/10,3,1,x0-4*width,bildy(unten,oben,i/10),color,xarr);
  end;  {i-Schleife}
setcolor(1);  {blau}
end;  {grid}

procedure punktewahl(var tra,trb:vectripel);
var i,j:integer;   {Wahl im Graphikbildschirm zweier Punktetripel tra und}
    pol:polygon;   {trb, wobei tra in trb �bergef�hrt werden soll}
    tr:array[1..2] of vectripel;
    color:word;
begin
color:=1;                           {Urbildpolygon (j=1) in blau}
pol.zahl:=3;
for j:=1 to 2 do                    {Urbild: j=1; Bildpolygon: j=2}
  repeat                            {bis Eingabe akzeptabel}
    setcolor(color);                {Urbildpolygon blau, Bildpolygon rot}
    if j=1 then xptextxy
      ('Eingabe dreier Urbildpunkte:',5*width,height,1,xarr)
      else xptextxy('Eingabe dreier Bildpunkte:',5*width,height,1,xarr);
    for i:=1 to 3 do                {Nummer der Polygon-Punkte}
      begin
      xptextxy('x[',5*width,(1+4*i)*height,1,xarr);
      xpnumberxy(i,1,0,7*width,(1+4*i)*height,1,xarr);
      xptextxy('] =',8*width,(1+4*i)*height,1,xarr);
      readrsafe(tr[j,i,1],true);   {Eingabe der ersten Koordinate des i-ten}
      xpnumberxy(tr[j,i,1],4,2,12*width,(1+4*i)*height,1,xarr);   {Punktes}
      pol.punkt[i,1]:=tr[j,i,1];
      xptextxy('y[',5*width,(3+4*i)*height,1,xarr);
      xpnumberxy(i,1,0,7*width,(3+4*i)*height,1,xarr);
      xptextxy('] =',8*width,(3+4*i)*height,1,xarr);
      readrsafe(tr[j,i,2],true);   {Eingabe der zweiten Koordinate des i-ten}
      xpnumberxy(tr[j,i,2],4,2,12*width,(3+4*i)*height,1,xarr);           {Punktes}
      pol.punkt[i,2]:=tr[j,i,2];
      kreuz(bildx(links,rechts,tr[j,i,1]),bildy(unten,oben,tr[j,i,2]),color);
      end;  {i-Schleife}      {Markierung durch ein Kreuz in Farbe color}
    polygongraph(pol,color);  {Ausgabe des Graphen in Farbe color}
    xptextxy('akzeptabel? (j/n)',3*width,(5+4*i)*height,1,xarr);
    repeat ch:=readkey until ((ch='j') or (ch='n'));
    clearwindow(0,0,40*width,3*height);
    clearwindow(0,0,21*width,24*height);
    if ((ch='j') and (color=1)) then color:=4;   {Bildpolygon in rot}
    if ch='n' then
       begin           {f�r Eingabekorrektor šbermalung des Polygons in weiá}
       polygongraph(pol,15);
       grid(7);
       end;
    until ch='j';  {for j:=1 to 2 do}
restorecrtmode;
for i:=1 to 3 do
begin
tra[i]:=tr[1,i];
trb[i]:=tr[2,i];
end;                         {šbergabe der Punktetripel tra, trb}
end;  {punktewahl}

procedure fixpunkt(A:matrix;var b,zf:vector);
var C,CI:matrix;      {zf ist Fixpunkt der Abbildung za=Az+b}
begin                 {zf=(I-A)^(-1)b, CI=(I-A)^(-1)}
C[1,1]:=1-A[1,1];
C[1,2]:=-A[1,2];
C[2,1]:=-A[2,1];
C[2,2]:=1-A[2,2];
invers(C,CI);         {CI=(I-A)^(-1)}
affin(CI,o,b,zf);
end;

procedure showfix(fix:vecarray;k:integer;colorchart:chart);
  var h:integer; {markiert Fixpunkte von k Abbildungen durch Kreuze}
begin
for h:=1 to k do
  kreuz
  (bildx(links,rechts,fix[h,1]),bildy(unten,oben,fix[h,2]),colorchart[h]);
end;  {showfix}

procedure contraction(A:matrix;var s:real);
var i,j:integer;                   {Berechnung der Eigenwerte}
   ew1,ew2,b1,b2,b3:real;          {ew1>=ew2 von A^t.A und des}
begin                              {Kontraktionsfaktors s=sqrt(ew1)}
b1:=sqr(A[1,1])+sqr(A[2,1]);
b2:=sqr(A[1,2])+sqr(A[2,2]);
b3:=A[1,1]*A[1,2]+A[2,1]*A[2,2];
ew1:=(b1+b2+sqrt(sqr(b1-b2)+4*sqr(b3)))/2;
ew2:=(b1+b2-sqrt(sqr(b1-b2)+4*sqr(b3)))/2;
s:=sqrt(ew1);
end;  {contraction}

procedure collagecontraction(g,hg:integer;var sc:real);
  var A:matrix;    {berechnet den Kontraktionsfaktor der Collage g}
      b:vector;
      s:real;
      h:integer;
begin
sc:=0;
for h:=1 to hg do
  begin
  initiateaffine(g,h,phi,r,A,b,d);
  contraction(A,s);
  if s>sc then sc:=s;
  end;
end;  {collagecontraction}

procedure nameimage(A:matrix;b:vector;z1,z2:real;var x,y:integer;
                    name:string); {benennt Bildpunkt za von z mit 'name'}
  var z,za:vector;
begin
z[1]:=z1;
z[2]:=z2;
affin(A,b,z,za);
x:=bildx(links,rechts,za[1]);
y:=bildy(unten,oben,za[2]);
xptextxy(name,x-width,y-height,1,xarr);
end;  {nameimage}

procedure zeigeabbildung(A:matrix;var b,zf:vector;h:integer;
                         var sar:sarray;che:char);
  var i,j,xa,xb,xc,ya,yb,yc,{numerische Ausgabe der Matrix A, des}
      x,y:integer;          {Vektors b, des Fixpunktes zf, der Determinante}
      det,s:real;           {von A, der Eigenwerte ew1>=ew2 von A^t.A}
begin                       {und des Kontraktionsfaktors s=sqrt(ew1)}
det:=A[1,1]*A[2,2]-A[1,2]*A[2,1];  {anschlieáend graphische Illustration}
contraction(A,s);           {s=Kontraktionsfaktor von A}
if che='k' then sar[h]:=s;
fixpunkt(A,b,zf);           {zf ist Fixpunkt von za=Az+b}
clrscr;
writeln;              {Ausgabe der Matrix A und des Verschiebungsvektors b}
writeln(' Collage-Abbildung Nummer h = ',h);
writeln;
writeln
('     ',chr(218),A[1,1]:5:2,'   ',A[1,2]:5:2,' ',chr(191),
    '           ',chr(218),b[1]:5:2,' ',chr(191));
writeln(' A = ',chr(179),'              ',chr(179),
       ' ;    b  = ',chr(179),'      ',chr(179));
writeln
('     ',chr(192),A[2,1]:5:2,'   ',A[2,2]:5:2,' ',chr(217),
    '           ',chr(192),b[2]:5:2,' ',chr(217));
writeln;
writeln(' det(A) = ',det:4:2);
writeln(' Verk�rzungsfaktor s = ',s:4:2);
writeln(' Fixpunkt zf = [',zf[1]:5:3,',',zf[2]:5:3,']');
ch:=readkey;                 {stop vor Graphik-Ausgabe}
setgraphmode(graphmode);
setbkcolor(15);
axes(7);
setcolor(3);                 {cyan}
line(x0,y0,x1,y0);           {unteres Halbdreieck des Einheitsquadrates}
line(x0,y0,x0,y1);
line(x1,y0,x0,y1);
xptextxy('C',x0-width,y0+height,3,xarr);
xptextxy('A',x1-width,y0+height,3,xarr);
xptextxy('B',x0-width,y1-height,3,xarr);
setcolor(4);                  {rot}
nameimage(A,b,0,0,xc,yc,'c');
nameimage(A,b,1,0,xa,ya,'a');
nameimage(A,b,0,1,xb,yb,'b');
line(xa,ya,xb,yb);           {Bilddreieck}
line(xb,yb,xc,yc);
line(xc,yc,xa,ya);
x:=bildx(links,rechts,zf[1]);
y:=bildy(unten,oben,zf[2]);
kreuz(x,y,2);                {Markierung des Fixpunktes in gr�n}
ch:=readkey;                 {stop f�r Bildbetrachtung}
restorecrtmode;
end;  {zeigeabbildung}

procedure showcollpol(pol:polygon;Aa:matarray;ba:vecarray;hg4:integer);
  var h:integer;
      bildpol:polygon;
begin
setbkcolor(15);
grid(7);
polygongraph(pol,3);        {Urbildpolygon in cyan}
for h:=1 to hg4 do          {f�r jede der hg4 Collage-Affinit„ten}
  begin
  bildpol.zahl:=pol.zahl;
  for i:=1 to pol.zahl do   {Berechnung der Bildpolygonpunkte unter der}
    affin(Aa[h],ba[h],pol.punkt[i],bildpol.punkt[i]);  {Abbildung Nr. h}
  polygongraph(bildpol,4);  {Bildpolygon in rot}
  end;  {h-Schleife}
end;  {showcollpol}

procedure colluebernahme(A:matrix;b:vector;var Aa:matarray; var ba:vecarray;
			 var h:integer;hu,ho:integer);
  var chf:char;      {Aa und ba sind globale Variablen, die Matrizen und}
begin                {Vektoren einer selbstdefinierten Collage �bernehmen}
zeigeabbildung(A,b,zf,h,sar,che); {numerische und grafische Ausgabe}
writeln(' Ist das akzeptabel (j/n) ?');
repeat chf:=readkey until ((chf='j') or (chf='n'));
if chf='j' then
  begin
  repeat
    ch:='j';
    writeln;
    writeln(' (Abbruch = šbernahme in Abbildung Nummer 0)');
    write(
    ' Die Abbildung (A,b) wird abgespeichert unter der Collage-Nummer: ');
    repeat readgwritexy(wherex,wherey,1,h)
      until ((h>=hu) and (h<=ho));
    until ch='j';
  writeln;
  Aa[h]:=A;
  ba[h]:=b;
  end;  {chf='j'}
end;  {colluebernahme}

procedure numeingabe(var Aa:matarray;var ba:vecarray;var sar:sarray;
                     hu,ho:integer;var che:char);
var i,j,h:integer;              {che bestimmt die Eingabeart}
   a,b,c,phi,phirad:vector;     {cha die Korrektur}
   cha,ch:char;                 {ch den Abbruch}
begin
g:=5;
h:=1;               {Abbildungsnummer 0=hu<=h<=ho}
clrscr;
writeln;
writeln
(' Eingabe der Abbildungsdaten f�r eigendefinierte Abbildung (g=5)');
writeln;
writeln(' Eingabeart:');
writeln(' Matrixkoeffizienten ..... m');
writeln(' Polarkoordinaten ........ p');
writeln(' komplexe Schreibweise ... k');
writeln;
writeln(' (Im Falle k enth„lt die Collage nur Žhnlichkeits-Kontraktionen,');
writeln(' falls die offenen-Mengen-Bedingung erf�llt ist, kann die');
writeln(' Dimension des Fraktals berechnet werden.)');
repeat che:=readkey until che in ['m','p','k'];
repeat                          {neue Collage-Abbildung}
  repeat                        {Korrektur der Eingabe}
    repeat                      {Wahl der Abbildungsnummer}
      clrscr;
      ch:='j';
      writeln;
      writeln(' Abbruch: durch Abspeicherung unter Collage-Nummer 0');
      writeln;
      write(
      ' Die Abbildung (A,b) wird abgespeichert unter der Collage-Nummer: ');
      repeat readgwritexy(wherex,wherey,1,h)
	until ((h>=hu) and (h<=ho));
      until ch='j';
    writeln;
    writeln;
    case che of                      {Eingabeart}
      'm':begin                      {Matrix- und Vektorkoeffizienten}
        for j:=1 to 2 do
          begin
          for i:=1 to 2 do
            begin
            gotoxy(2+(j-1)*16,5+i);
            write('A[',i,',',j,'] = ');
            readrsafe(Aa[h][i,j],false);
            end; {i-Schleife}
          end; {j-Schleife}
        for i:=1 to 2 do
          begin
          gotoxy(34,5+i);
          write('b[',i,'] = ');
          readrsafe(ba[h][i],false);
          end;  {i-Schleife}
       end;  {che='m'}
      'p':begin                {Matrizenkoeffizienten in Polarkoordinaten}
        writeln(' (Winkel phi in Graden)');
        writeln;
        writeln('A[1,1]=a[1].cos phi[1],  A[1,2]=a[2].cos phi[2]');
        writeln('A[2,1]=a[1].sin phi[1],  A[2,2]=a[2].sin phi[2]');
        for j:=1 to 2 do
          begin
          gotoxy(2+(j-1)*16,9);
          write('a[',j,']   = ');
          readrsafe(a[j],false);
          gotoxy(2+(j-1)*16,10);
          write('phi[',j,'] = ');
          readrsafe(phi[j],false);
          phirad[j]:=phi[j]*pi/180;
          end;  {j-Schleife}
        for i:=1 to 2 do
          begin
          gotoxy(34,8+i);
          write('b[',i,'] = ');
          readrsafe(ba[h][j],false);
          end;  {i-Schleife}
        Aa[h][1,1]:=a[1]*cos(phirad[1]);
        Aa[h][2,1]:=a[1]*sin(phirad[1]);
        Aa[h][1,2]:=a[2]*cos(phirad[2]);
        Aa[h][2,2]:=a[2]*sin(phirad[2]);
        end;  {che='p'}
      'k':begin               {komplexe Schreibweise}
        writeln('    w(z) = c.z+b,             mit Real- und Imagin„rteil:');
        writeln(' w1+i.w2 = (c[1]+i.c[2]).(z1+i.z2)+(b[1]+i.b[2])');
        writeln;
        for i:=1 to 2 do
          begin
          gotoxy(2,8+i);
          write(' c[',i,'] = ');
          readrsafe(c[i],false);
          end;  {i-Schleife}
        for i:=1 to 2 do
          begin
          gotoxy(15,8+i);
          write(' b[',i,'] = ');
          readrsafe(ba[h][i],false);
          end;  {i-Schleife}
        writeln;
        Aa[h][1,1]:=c[1];
        Aa[h][1,2]:=-c[2];
        Aa[h][2,1]:=c[2];
        Aa[h][2,2]:=c[1];
        end;  {che='k'}
      end;  {case che}
    zeigeabbildung(Aa[h],ba[h],zf,h,sar,che);
    writeln;
    writeln(' Ist das akzeptabel (j/n)?');
    repeat cha:=readkey until cha in ['j','n'];
    until cha='j';
  writeln;
  writeln(' Soll noch eine Abbildung eingegeben werden (j/n)?');
  repeat ch:=readkey until ch in ['j','n'];
  until ch='n';
end;  {numeingabe}

procedure abbildungswahl(var A:matrix;var b,d:vector;var g,h,hg:integer;
                         sc:real);
begin         {šbernahme der Abbildung f�r zeigeabbildung}
clrscr;
writeln;
writeln(' Verk�rzungsfaktor der Collage: sc ó ',sc:4:2);
writeln(' Anzahl der Collage-Abbildungen h = ',hg);
write(' Ausgegeben wird die Abbildung mit der Nummer h = ');
repeat readgwritexy(wherex,wherey,1,h)
  until ((0<h) and (h<=hg));
writeln;
initiateaffine(g,h,0,r,A,b,d);
end;  {abbildungswahl}

procedure ausgabewahl(var A:matrix;var b,d:vector;var g,h,hg:integer;
                         sc:real);
begin         {šbernahme der Abbildung f�r zeigeabbildung}
clrscr;
writeln;
writeln
  (' Verk�rzungsfaktor der Collage mit der Nummer ',g,' : sc ó ',sc:4:2);
writeln;
writeln(' Anzahl der Collage-Abbildungen hg = ',hg);
write(' Angewandt wird die Abbildung mit der Nummer h = ');
repeat readgwritexy(wherex,wherey,1,h)
  until ((0<h) and (h<=hg));
writeln;
initiateaffine(g,h,0,r,A,b,d);
end;  {ausgabewahl}

procedure punkteeingabe(var pol:polygon);
var i:integer;      {Eingabe der Polygoneckpunkte}
begin
pol.zahl:=1;
clrscr;
writeln;
write(' Anzahl der Punkte: m = ');
repeat readgwritexy(wherex,wherey,2,pol.zahl)
until pol.zahl<11;
setgraphmode(graphmode);
setbkcolor(15);
bild(links,rechts,unten,oben,c,x0,y0,x1,y1);
axes(7);
grid(7);
setcolor(1);
with pol do
for i:=1 to zahl do
  repeat
    xptextxy(' P[',3*width,5*height,1,xarr);
    xpnumberxy(i,1,0,6*width,5*height,7,xarr);
    xptextxy(']: x = ',7*width,5*height,1,xarr);
    readrsafe(punkt[i,1],true);        {Eingabe von pol.punkt[i,1]}
    xpnumberxy(punkt[i,1],5,3,14*width,5*height,1,xarr);
    xptextxy(' P[',3*width,6*height,1,xarr);
    xpnumberxy(i,1,0,6*width,6*height,1,xarr);
    xptextxy(']: y = ',7*width,6*height,1,xarr);
    readrsafe(punkt[i,2],true);        {Eingabe von pol.punkt[i,2]}
    xpnumberxy(punkt[i,2],5,3,14*width,6*height,1,xarr);
    kreuz(bildx(links,rechts,punkt[i,1]),bildy(unten,oben,punkt[i,2]),4);
    xptextxy('akzeptabel? (j/n)',3*width,8*height,1,xarr);
    repeat ch:=readkey until ((ch='j') or (ch='n'));
    clearwindow(0,0,20*width,9*height);
    clearwindow(0,0,24*width,6*height);
    if ch='n' then    {Korrektur durch šberschreibung des Kreuzes in weiá}
       kreuz(bildx(links,rechts,punkt[i,1]),
             bildy(unten,oben,punkt[i,2]),15);
    until ch='j';
polygongraph(pol,3);
end;  {punkteeingabe}

procedure bildpunkte(A:matrix;b:vector;pol:polygon;color:word;chm:char);
  var bildpol:polygon;      {im Graphmode wird das Bild bzw. Urbild des}
     i:integer;             {Polygons pol ausgegeben, danach R�ckkehr}
     ch:char;               {zum crt-Modus}
begin
with pol do
  begin
  bildpol.zahl:=zahl;
  for i:=1 to zahl do
  if chm='b' then
    affin(A,b,punkt[i],bildpol.punkt[i])
      else affinvers(A,b,punkt[i],bildpol.punkt[i]);
  end;  {with pol}
polygongraph(bildpol,4);
ch:=readkey;
restorecrtmode;
end;  {bildpunkte}

procedure numausgabe(A:matrix;b:vector;pol,bildpol:polygon;chm:char);
begin
with pol do   {numerische Ausgabe der Eckpunktkoordinaten des Polynoms}
begin
bildpol.zahl:=zahl;
writeln;
writeln(' Urbildpunkte    Bildpunkte');
for i:=1 to zahl do
  begin
  if chm='b' then affin(A,b,punkt[i],bildpol.punkt[i])
    else affinvers(A,b,punkt[i],bildpol.punkt[i]);
  writeln(' (',punkt[i,1]:4:2,',',punkt[i,2]:4:2,') --> (',
          bildpol.punkt[i,1]:4:2,',',bildpol.punkt[i,2]:4:2,')');
  end; {i-Schleife}
writeln;
end; {with pol}
end;  {numausgabe}

procedure polygonwahl(var pol:polygon;n:integer;color:word);
  var i,xi,yi:integer;     {Konstruktion des Polygons pol im graphmode}
      ch:char;
begin
grid(7);
repeat              {Korrektur des Polygons}
  i:=0;
  repeat            {n„chste Punktewahl}
    setcolor(3);    {cyan}
    moveto(0,0);
    i:=i+1;         {Nummer des n„chsten Polygonpunktes}
    with pol do
    repeat          {Korrektur der Punktewahl}
      xptextxy(' P[',3*width,5*height,3,xarr);
      xpnumberxy(i,1,0,6*width,5*height,3,xarr);
      xptextxy(']: x = ',7*width,5*height,3,xarr);
      moveto(0,0);
      readrsafe(punkt[i,1],true);        {Eingabe von pol.punkt[i,1]}
      xpnumberxy(punkt[i,1],5,3,14*width,5*height,3,xarr);
      xptextxy(' P[',3*width,6*height,3,xarr);
      xpnumberxy(i,1,0,6*width,6*height,3,xarr);
      xptextxy(']: y = ',7*width,6*height,3,xarr);
      moveto(0,0);
      readrsafe(punkt[i,2],true);        {Eingabe von pol.punkt[i,2]}
      xpnumberxy(punkt[i,2],5,3,14*width,6*height,3,xarr);
      xi:=bildx(links,rechts,punkt[i,1]);
      yi:=bildy(unten,oben,punkt[i,2]);
      kreuz(xi,yi,4);
      setcolor(color);
      xpnumberxy(i,1,0,xi,yi+height,3,xarr);
      setcolor(3);
      xptextxy('akzeptabel? (j/n)',3*width,8*height,3,xarr);
      repeat ch:=readkey until ((ch='j') or (ch='n'));
      clearwindow(0,0,30*width,8*height);
      clearwindow(0,0,20*width,10*height);
      if ch='n' then
         begin
         kreuz(xi,yi,0);
         setcolor(0);
         xpnumberxy(i,1,0,xi,yi+height,3,xarr);
         setcolor(3);
         end;  {if}
      reset(input);
      until ch='j';                             {pol.punkt[i] akzeptiert}
    if i<n then
      begin
      xptextxy('weitere Punktwahl (j/n) ?',width,height,3,xarr);
      repeat ch:=readkey until ((ch='j') or (ch='n'));
      clearwindow(0,0,30*width,2*height);
      end;  {i<n}
    until ((ch='n') or (i=n));                 {Konstruktion von pol fertig}
  pol.zahl:=i;
  polygongraph(pol,3);
  xptextxy('akzeptabel? (j/n)',width,height,3,xarr);
  repeat ch:=readkey until ((ch='j') or (ch='n'));
  if ch='n' then
    begin
    polygongraph(pol,0);
    setcolor(3);
    end;  {ch0='n'}
  until (ch='j');
clearwindow(0,0,30*width,2*height);
end;  {polygonwahl}

procedure writepolyfile(var pol:polygon;var polfile:polyfile;
                        var invfile:inventar);
  var polstr:string;
begin
polstr:='neues Polygon';
setgraphmode(graphmode);
xptextxy('Wahl des Ausgangspolygons',4*width,height,3,xarr);
polygonwahl(pol,10,3);         {Wahl des Urbildpolygons}
restorecrtmode;
writeln;
writeln
(' Unter welchem Namen polstr soll das Polygon pol abgespeichert werden?');
readswritexy(2,wherey+1,polstr);
assign(invfile,'Polygone');
reset(invfile);
seek(invfile,filesize(invfile));
write(invfile,polstr);
close(invfile);
assign(polfile,polstr+'.pol');
rewrite(polfile);
write(polfile,pol);
close(polfile);
end;  {writepolyfile}

procedure choosetriangle(pol:polygon;var tri:polygon);
  var i,n:integer;    {im Polygon pol werden 3 Punkte f�r ein Dreieck tri}
begin                 {gew„hlt}
tri.zahl:=3;
for i:=1 to 3 do
  begin
  xptextxy('Polygonpunkt Nr.',width,(i+2)*height,1,xarr);
  readln(n);
  xpnumberxy(n,1,0,21*width,(i+2)*height,1,xarr);
  tri.punkt[i]:=pol.punkt[n];
  end;  {i-Schleife}
setlinestyle(3,1,3);        {gestrichelt,dick}
polygongraph(tri,3);        {graphische Ausgabe von tri}
setlinestyle(0,1,1);
clearwindow(0,0,30*width,2*height);
clearwindow(0,0,20*width,6*height);
end;  {choosetriangle}

procedure choosecollage(var Aa:matarray;var ba:vecarray;var h:integer;
                        var pol:polygon);
  var bildpol,tri0,tri:polygon;
      tra,trb:vectripel;
      i,n:integer;
      ch:char;
begin
setgraphmode(graphmode);
setcolor(3);
xptextxy('Wahl des Urbildpolygons',4*width,height,3,xarr);
polygonwahl(pol,10,3);         {Wahl des Urbildpolygons}
clearwindow(0,0,30*width,2*height);
xptextxy('Wahl des Urbilddreiecks:',4*width,height,3,xarr);
choosetriangle(pol,tri0); {Anzeige des Urbilddreiecks}
clearwindow(0,0,30*width,2*height);
h:=0;
repeat                         {Wahl der Bildpolygone}
  h:=h+1;                      {Nummer der Collage-Abbildung}
  repeat                       {Korrektur des Bildpolygons}
    clearwindow(0,0,30*width,2*height);
    clearwindow(0,0,5*width,40*height);
    moveto(0,0);
    xptextxy('Wahl des Bilddreiecks',width,height,3,xarr);
    polygonwahl(tri,3,9);
    polygongraph(tri,5);       {Anzeige des Bilddreiecks}
    for i:=1 to 3 do
      begin
      tra[i]:=tri0.punkt[i];
      trb[i]:=tri.punkt[i];
      end;  {i-Schleife}
    abbildung(tra,trb,Aa[h],ba[h]);
    bildpol.zahl:=pol.zahl;
    for i:=1 to pol.zahl do
      affin(Aa[h],ba[h],pol.punkt[i],bildpol.punkt[i]);
    polygongraph(bildpol,4);    {Anzeige des Bildpolygons}
    clearwindow(0,0,20*width,2*height);
    xptextxy('akzeptabel (j/n) ?',width,height,3,xarr);
    repeat ch:=readkey until ch in ['j','n'];
    if ch='n' then
      begin
      polygongraph(bildpol,0);    {Bildpolygon l”schen}
      end;  {ch='n'}
    until ch='j';
  clearwindow(0,0,30*width,2*height);
  setcolor(3);
  if h<5 then
    xptextxy('weitere Collage-Abbildung (j/n) ?',width,height,3,xarr);
  repeat ch:=readkey until ch in ['j','n'];
  clearwindow(0,0,40*width,2*height);
  until ((ch='n') or (h=5));
restorecrtmode;
end;  {choosecollage}

procedure colpolygon(pol:polygon;polystr:string;var colpolyfile:polyfile);
begin    {das f�r eine Collagekonstruktion polystr verwendete Polygon pol}
assign(colpolyfile,polystr+'.pol');  {wird in der Datei polystr+'pol'}
rewrite(colpolyfile);                {abgespeichert}
write(colpolyfile,pol);
close(colpolyfile);
end;  {colpolygon)}

procedure savecollage(Aa:matarray;ba:vecarray;hg5:integer;pol:polygon;
                      var collfile:collagefile;var invfile:inventar;
                      var colpolyfile:polyfile);
  var abb:coll;       {die in der Prozedur "choosecollage" konstruierte}
      collstr:string; {Collage wird in der Datei "collstr" gespeichert}
      h:integer;      {und in der Datei "Collagen" verzeichnet}
begin
clrscr;
reset(input);
write(' Name der Collage: ');
readln(collstr);
assign(collfile,collstr);
rewrite(collfile);
for h:=1 to hg5 do
  begin
  abb.hg:=hg5;
  abb.h:=h;
  abb.A:=Aa[h];
  abb.b:=ba[h];
  write(collfile,abb);
  end;  {h-Schleife}
close(collfile);
colpolygon(pol,collstr,colpolyfile);  {Abspeicherung des zur Collagen-}
writeln       {Konstruktion verwendeten Polynoms in Datei 'collstr.pol'}
(' Solle die Inventardatei ''Collagen'' neu eingerichtet werden (j/n)?');
repeat ch:=readkey until ch in ['j','n'];
assign(invfile,'Collagen');
if ch='j' then rewrite(invfile)
  else reset(invfile);
seek(invfile,filesize(invfile));
write(invfile,collstr);    {Aufnahme von 'collstr' in Inventardatei}
close(invfile);
end;  {savecollage}

procedure readcollage(var Aa:matarray;var ba:vecarray;var hg5:integer;
                      var pol:polygon;var colpolyfile:polyfile;
                      var collfile:collagefile;var invfile:inventar);
  var abb:coll;        {die in der Inventardatei "Collagen" verzeichnete}
      collstr:string;  {Collage "collstr" wird in den Arrays Aa und ba}
      h,k,k0:integer;  {aufgenommen; ebenso wird das zu ihrer Konstruktion}
begin                  {verwendete Polygon "pol" aus der Datei "collstr.pol"}
clrscr;                {eingelesen}
k:=-1;
k0:=0;
writeln;
assign(invfile,'Collagen');
reset(invfile);
writeln(' Die folgenden Collagen k”nnen eingelesen werden:');
while not eof(invfile) do
  begin
  k:=k+1;
  read(invfile,collstr);
  writeln('     ',collstr,' ... ',k);
  end;  {while}
k0:=k;
close(invfile);
writeln;
write(' Abgerufen wird die Collage Nummer k =');
repeat readgwritexy(wherex,wherey,2,k)
  until ((0<=k) and (k<=k0));
reset(invfile);
seek(invfile,k);
read(invfile,collstr);
close(invfile);
writeln;
assign(collfile,collstr);
reset(collfile);
while not eof(collfile) do
  begin
  read(collfile,abb);
  hg5:=abb.hg;
  h:=abb.h;
  Aa[h]:=abb.A;
  ba[h]:=abb.b;
  end;  {while}
close(collfile);
assign(colpolyfile,collstr+'.pol');
reset(colpolyfile);
read(colpolyfile,pol);
close(colpolyfile);
end;  {readcollage}

procedure cancelcoll(var invfile:inventar);
  var cancelfile:inventar;     {Interims-Inventardatei}
      collstr:string;          {Dateiname}
      var k,k0,k1:integer;
begin
clrscr;
k:=-1;                         {Collagen-Z„hler}
k0:=0;                         {vorl„ufig letzte Collagen-Nummer}
k1:=0;                         {Nummer der zu l”schenden Collage}
writeln;
assign(invfile,'Collagen');
reset(invfile);
writeln(' Die folgenden Collagen sind abgespeichert:');
while not eof(invfile) do
  begin
  k:=k+1;
  read(invfile,collstr);
  writeln('     ',collstr,' ... ',k);
  end;  {while}
k0:=k;                           {letzte Collagen-Nummer}
close(invfile);
writeln;
write(' Gel”scht wird die Collage Nummer k =');
repeat readgwritexy(wherex,wherey,2,k1)
  until ((0<=k1) and (k1<=k0));
k:=-1;
writeln;
assign(cancelfile,'cancel');      {string-Datei}
rewrite(cancelfile);              {Interims-Inventardatei}
reset(invfile);                   {bisherige Inverntardatei}
while not eof(invfile) do
  begin
  k:=k+1;
  read(invfile,collstr);
  if k<>k1 then                   {Ausschluá des zu l”schenden Eintrages}
    write(cancelfile,collstr);
  end;  {not eof(invfile)}
close(invfile);
close(cancelfile);
rewrite(invfile);
reset(cancelfile);
while not eof(cancelfile) do
  begin
  read(cancelfile,collstr);      {šbernahme der Eintr„ge der Interims-Datei}
  write(invfile,collstr);        {in die neu angelegte Inventar-Datei}
  end;  {not eof(cancelfile)}
close(cancelfile);
close(invfile);
end;  {cancelcoll}

procedure dimension(tol:real;s:sarray;hg:integer;var dim:real);
{berechnet die Hausdorff-Dimension eines Fraktals, wenn die Collage aus
hg Žhnlichkeiten mit den Verk�rzungsfaktoren s[.] besteht: ä s[i]^dim=1}
  var zaehler, nenner,bruch,t,u,x,xneu:real;
      i:integer;
begin
x:=1;
repeat         { Newton-Verfahren f�r Nullstelle von f(x)=ä s[i]^x-1 }
  zaehler:=-1;
  nenner:=0;
  for i:=1 to hg do
    begin
    t:=Ln(s[i]);
    u:=exp(x*t);          { u=s[i]^x }
    zaehler:=zaehler+u;
    nenner:=nenner+u*t;
    end;  {i-Schleife}
  bruch:=zaehler/nenner;
  xneu:=x-bruch;
  x:=xneu;
  until abs(bruch)<tol;
dim:=x;
end;  {dimension}

procedure menu(var g,hg5,am:integer;var phirad,c,r:real;var d:vector;
	       var readpol,neu:boolean;var chm,chpol:char);
var i,j:integer;
    phi:real;
    ch:char;
begin
h:=1;
phi:=0;
ch:='j';
clrscr;
writeln;
if neu then           {eine neue Collage wird gew„hlt}
  begin
  writeln(' Auswahl (g) der Collage f�r die');
  writeln(' Grenzmenge: Farn ................ 1');
  writeln('             Blatt ............... 2');
  writeln('             Drache .............. 3');
  writeln('             Gras ................ 4');
  writeln('             selbstdefiniert ..... 5');
  writeln(' Programmende .................... 0');
  writeln;
  write(' gew„hlt wird g = ');
  repeat readgwritexy(wherex,wherey,1,g)
    until ((0<=g) and (g<=5));
  writeln;
  end;  {ch='j'}
if g=0 then chm:='z'                   {Programm-Ende}
  else begin
  if g=4 then
    begin
    writeln;
    writeln(' Drehungswinkel (in Graden)');
    write('                 phi = ');
    readrwritexy(wherex,wherey,3,0,phi);
    phirad:=phi*pi/180;               {Umrechnung in Radianten}
    writeln;
    write(' Drehzentrum d: d[1] = ');
    readrwritexy(wherex,wherey,6,2,d[1]);
    writeln;
    write('                d[2] = ');
    readrwritexy(wherex,wherey,6,2,d[2]);
    writeln;
    end;  {g=4}
  clrscr;
  writeln;
  writeln(' Auswahl der Bearbeitung:');
  if g=5 then
    begin
    writeln('              Collage einlesen ......... r)');
    writeln('              Collage-Konstruktion ..... c)');
    writeln('              Collage speichern ........ s)');
    writeln('              Collage l”schen .......... l)');
    writeln('              Abbildungskonstruktion ... k)');
    writeln('              Abbildungseingabe ........ e)');
    writeln('              Abbildungs�bernahme ...... n)');
    writeln('              Polygon-Initiator ........ p)');
    end;  {g=5}
  writeln('              Abbildungsdaten .......... d)');
  writeln('              Bildpunkte ............... b)');
{  writeln('              Urbilder ................. u)');}
  writeln('              Iterationsgraphik ........ i)');
  writeln;
  write(' gew„hlt wird: ');
  if g=5 then
    begin
    repeat chm:=readkey
      until chm in ['b','c','d','e','i','k','l','n','p','r','s'];
    writeln(chm);
    if chm in ['k','e','n'] then
      begin
      emptypol(pol);
      writeln;
      writeln(' Bisherige Anzahl der Collage-Komponenten: hg = ',hg5);
      write(' Erw�nschte Anzahl der Collage-Komponenten hg = ');
      repeat readgwritexy(wherex,wherey,1,hg5)
        until ((hg5>0) and (hg5<6));
      writeln;
      end;  {chm='k','e','n'}
    if chm='p' then
      begin
      writeln;
      writeln(' Polygonkonstruktion ............. c');
      writeln(' Polygon einlesen ................ r');
      writeln(' Polygon l”schen ................. l');
      repeat chpol:=readkey until chpol in ['c','r','l'];
      end; {chm='p'}
    end  {g=5}
    else begin                      {g<>5}
      repeat chm:=readkey until chm in ['b','d','i','u'];
      writeln(chm);
      end; {g<>5}
  writeln;
  case chm of
    'i':begin
      clrscr;
      writeln;
      writeln(' Ausgangsmenge:');
      writeln(' Rand Einheitsquadrat ..... 1');
      writeln(' volles Einheitsquadrat ... 2');
      writeln(' Viertelkreis ............. 3');
      writeln(' Vollkreis ................ 4');
      writeln(' Dreieck .................. 5');
      writeln(' Zufallsmenge ............. 6');
      writeln(' Rand Mittelquadrat ....... 7');
      writeln(' volles Mittelquadrat ..... 8');
      writeln(' Einheitsintervall ........ 9');
      writeln(' Polygon ................. 10');
      if readpol then
         writeln(' ein Ausgangs-Polygon ist bereits gespeichert');
      writeln;
      write(' gew„hlt wird am = ');
      repeat readgwritexy(wherex,wherey,1,am)
        until ((0<am) and (am<=10));
      writeln;
      writeln;
    end; {'i'}
  end; {case chm}
end;  {g<>0}
end; {menu}

begin{main}
graphdriver:=9;        {bgi-Datei egavga.bgi muá im aktuellen Ordner sein}
graphmode:=2;
initgraph(graphdriver,graphmode,'');
graphvariables(maxx,maxy,width,height);
restorecrtmode;
readpol:=false;             {noch kein Polygon ist eingelesen}
neu:=true;                  {es ist eine neue Collage einzulesen}
zeroaffine(A,b);
emptypol(pol);
o[1]:=0;                    {Nullvektor}
o[2]:=0;
for h:=0 to 5 do
  zeroaffine(Aa[h],ba[h]);  {Initialisierung der Collage-Abbildungen f�r g=5}
hg[0]:=0;
hg[1]:=4;                   {hg = Anzahl der Collage-Komponenten, Farn}
hg[2]:=4;                   {Blatt}
hg[3]:=2;                   {Drache}
hg[4]:=4;                   {Gras}
hg[5]:=0;                   {selbstdefiniert}
hg5:=0;                     {Vorgabewert f�r hg[5]}
g:=1;                       {Nummer der Grenzwertmenge Farn}
am:=1;                      {Nummer der Ausgangsmenge Quadratrand}
h:=1;                       {Nummer der Collage-Abbildung}
d[1]:=0.5;                  {Knickpunktkoordinaten f�r Grashalm}
d[2]:=0.3;
c:=1;                       {Zoomfaktor f�r Bildschirm}
r:=1;                       {Zoomfaktor f�r Bild}
phi:=0;                     {Knickwinkel f�r Grashalm}
for h:=1 to 5 do
  sar[h]:=0;                {Žhnlichkeits-Faktoren}
bild(links,rechts,unten,oben,c,x0,y0,x1,y1);
kolorierung('v',colorchart); {vielf„rbig}
repeat
  menu(g,hg5,am,phi,c,r,d,readpol,neu,chm,chpol);
  hg[5]:=hg5;
  bild(links,rechts,unten,oben,c,x0,y0,x1,y1);
  if g=0 then halt;
  case chm of
    'i':if ((g<5) or (hg5>0)) then
      begin
      for h:=1 to hg[g] do
        begin
        initiateaffine(g,h,phi,r,A,b,d);
        fixpunkt(A,b,fix[h]);
        end;  {h-Schleife}
      if am=10 then
        if not readpol then readpolyfile(pol,polfile,invfile,readpol);
      setgraphmode(graphmode);
      setbkcolor(15);
      if am=10 then polygongraph(pol,1)
        else initiatescreen(screen,am);
      setcolor(7);
      xptextxy('Taste',width,maxy-height,7,xarr);
      ch:=readkey;
      if am=10 then axes(0);
      clearwindow(0,maxy-height,maxx,maxy);
      n:=0;
      repeat
        n:=n+1;
        applyifs(g,screen,colorchart);
        setcolor(7);
        clearwindow(0,maxy-height,maxx,maxy);
        xptextxy('Stufe',0,maxy-height,7,xarr);
        xpnumberxy(n,2,0,6*width,maxy-height,7,xarr);
        xptextxy('Achsen:''a''',9*width,maxy-height,7,xarr);
        xptextxy('Fixpunkte:''f''',20*width,maxy-height,7,xarr);
        xptextxy('Polygon:''p''',34*width,maxy-height,7,xarr);
        xptextxy('Grid:''g''',46*width,maxy-height,7,xarr);
        xptextxy('Menu:''m''',55*width,maxy-height,7,xarr);
        xptextxy('Programmende:''e''',64*width,maxy-height,7,xarr);
        xptextxy('n„chste Stufe:''j''',55*width,maxy-2*height,7,xarr);
        repeat
          repeat ch:=readkey until ch in ['a','f','p','g','m','e','j'];
          case ch of
            'a':begin
              axes(7);
              che:=readkey;
              axes(0);
              end;  {ch='a'}
            'f':begin
              showfix(fix,hg[g],colorchart);
              che:=readkey;
              oldcolorchart:=colorchart;
              for i:=0 to 9 do colorchart[i]:=0;
              showfix(fix,hg[g],colorchart);
              colorchart:=oldcolorchart;
              end;  {ch='f'}
            'p':begin
              polygongraph(pol,1);
              che:=readkey;
              polygongraph(pol,0);
              axes(0);
              end;  {ch='p'}
            'g':begin
              grid(7);
              che:=readkey;
              grid(0);
              end;  {ch='g'}
            end;  {case ch}
          until ch in ['j','e','m'];
        clearwindow(0,maxy-2*height,maxx,maxy);
        until ((ch='e') or (ch='m'));
      restorecrtmode;
      writeln
(' Soll an Stelle der vorliegenden eine neue Collage geladen werden (j/n)?');
      repeat ch:=readkey until ch in ['j','n'];
      neu:=ch='j';
      if neu then readpol:=false;
    end  {chm='i'}
      else begin
        writeln(' Es sind noch keine Collage-Abbildungen eingegeben!');
        end;  {chm='i', g=5, hg5=0}
    'b','u':if ((g=5) and (hg[5]=0)) then
      begin
      writeln(' Es sind noch keine Collage-Abbildungen eingegeben!');
      ch:=readkey;
      end
        else begin           {g<5 or hg>0}
        repeat             {Anzeige von Bild- bzw. Urbildpunkten}
        if readpol then repeat                {readpol,1}
          if g=5 then           {Collage wurde selbst konstruiert}
            begin
            writeln(' Soll die Collagekonstruktion gezeigt werden (j/n)?');
            repeat ch:=readkey until ch in ['j','n'];
            if ch='j' then
              begin
              setgraphmode(graphmode);
              showcollpol(pol,Aa,ba,hg[5]);
              ch:=readkey;
              restorecrtmode;
              end;  {ch='j'}
            end;  {g=5}                     {readpol}
          repeat       {readpol,2, Ausgabe unter einer Collage-Abbildung}
            writeln;
            writeln
              (' Soll das Bild des Polygons unter einer Collage-Abbildung');
            writeln(' ausgegeben werden (j/n)?');
            repeat ch:=readkey until ch in ['j','n'];
            if ch='j' then
              begin
              ausgabewahl(A,b,d,g,h,hg[g],sc);
              writeln;
              numausgabe(A,b,pol,bildpol,chm);
              ch:=readkey;
              writeln;
              writeln
      (' Graphisch wird das Urbild in blau gezeigt, das Bildpolygon in rot');
              ch:=readkey;
              setgraphmode(graphmode);
              setbkcolor(15);
              polygongraph(pol,1);
              bildpunkte(A,b,pol,4,chm);  {setzt restorecrtmode}
              end;  {ch='j'}
            until ch='n';{readpol,2,Ausgabe unter einer Collage-Abbildung}
          writeln(' Soll ein weiteres Polygon abgebildet werden (j/n)?');
          repeat ch:=readkey until ch in ['j','n'];
          if ch='j' then                 {readpol, neue Polygoneingabe}
            begin
            punkteeingabe(pol);          {setzt Graphmodus}
            polygongraph(pol,1);
            ch:=readkey;
            restorecrtmode;
            end  {ch='j'}
              else readpol:=false;
          until ch='n'  {readpol,1, keine neue Polygoneingabe}
            else begin                     {not readpol}
            readpol:=true;
            punkteeingabe(pol);            {setzt Graphmodus}
            polygongraph(pol,1);
            ch:=readkey;
            restorecrtmode;
            end;  {readpol=false}          {not readpol}
        until ch='n';   {chm='b' (Bildpunkte),'u' (Urbildpunkte)}
        writeln
  (' Soll an Stelle der vorliegenden eine neue Collage geladen werden (j/n)?');
        repeat ch:=readkey until ch in ['j','n'];
        neu:=ch='j';
        end;  {'b', g<5 or hg>0}
    'k':begin                         {Konstruktion einer affinen Abbildung,}
      if hg[5]<7 then                 {die ein Punktetripel tra in ein}
        begin
        hg[5]:=hg[5]+1;
        h:=hg[5];
        end              {hg[5]<7}
         else begin                   {Punktetripel trb �berf�hrt}
         clrscr;
         writeln;
         writeln(' Es sind bereits 7 Affinit„ten eingegeben');
         ch:=readkey;
         end;  {hg[5]=7}
      setgraphmode(graphmode);
      setbkcolor(15);
      grid(7);
      punktewahl(tra,trb);
      abbildung(tra,trb,A,b);
      colluebernahme(A,b,Aa,ba,h,0,hg[5]);
      end; {case 'k'; Abbildungs-Konstruktion}
    'd':if ((g=5) and (hg[5]=0)) then
      begin
      writeln(' Es ist noch keine Collage eingegeben!');
      ch:=readkey;
      end
        else begin                    {Ausgabe von Daten einer gew„hlten}
        collagecontraction(g,hg[g],sc);            {Collage-Abbildung}
        repeat
          abbildungswahl(A,b,d,g,h,hg[g],sc);
          zeigeabbildung(A,b,zf,h,sar,che);
          writeln;
          writeln(' Ausgabe einer weiteren Collage-Abbildung (j/n) ?');
          repeat ch:=readkey until ch in ['j','n'];
          until ch='n';
        writeln
(' Soll an Stelle der vorliegenden eine neue Collage geladen werden (j/n)?');
        repeat ch:=readkey until ch in ['j','n'];
        neu:=ch='j';
        end; {case chm='d', Daten einer Abbildung}
    'e':begin                 {chm='e', numerische Abbildungseingabe}
	numeingabe(Aa,ba,sar,0,hg[5],che);
        if che='k' then       {Collage aus komplexen Žhnlichkeiten}
          begin
          dimension(0.001,sar,hg[5],dim);
          writeln;
          writeln(' Wenn die offenen-Mengen-Bedingung erf�llt ist,');
          writeln(' hat das Fraktal die Dimension ',dim:4:2);
          ch:=readkey;
          end;  {che='k'}
        end;  {case chm='k'}
    'c':begin
	choosecollage(Aa,ba,hg[5],pol); {Konstruktion einer Collage}
        readpol:=true;
        end;  {'c'}
    'n':begin                  {šbernahme einer Abbildung aus einer}
      g:=1;
      repeat                   {der Collagen g=1,2,3,4 in Collage g=5}
        writeln;
        write
        (' šbernommen wird eine Abbildung aus Collage Nummer g = ');
        repeat readgwritexy(wherex,wherey,1,g)
	  until ((g>0) and (g<5));
        writeln;
        write(' und zwar die Abbildung mit der Nummer h = ');
        repeat readgwritexy(wherex,wherey,1,h)
          until ((h>0) and (h<=hg[g]));
        writeln;
	initiateaffine(g,h,0,r,A,b,d);
	colluebernahme(A,b,Aa,ba,h,0,hg[g]);
        writeln(' Noch eine šbernahme (j/n) ?');
        repeat ch:=readkey
          until ((ch='j') or (ch='n'));
        until ch='n';
      ch:='m';
      end; {case 'n': šbernahme}
    's':begin
      savecollage(Aa,ba,hg[5],pol,collfile,invfile,colpolyfile);
      writeln
  (' Soll an Stelle der vorliegenden eine neue Collage geladen werden (j/n)?');
      repeat ch:=readkey until ch in ['j','n'];
      neu:=ch='j';
      end;  {savecollage}
    'r':begin                       {eine konstruiere Collage einlesen}
	readcollage(Aa,ba,hg5,pol,colpolyfile,collfile,invfile);
	hg[5]:=hg5;
        readpol:=true;
        end;
    'l':cancelcoll(invfile);        {Streichung in inventar 'Collagen'}
    'p':begin
        case chpol of
          'c':begin        {Das Polygon pol wird konstruiert, in der Datei }
            writepolyfile(pol,polfile,invfile);   {polstr.pol abgespeichert}
            readpol:=true;      { und sein Name polstr in der Inventardatei}
            end;  {chpol='c'}                      {'Polygone' aufgenommen }
          'r':begin       {das in der Inventardatei 'Polygone' verzeichnete}
            readpolyfile(pol,polfile,invfile,readpol);         {Polygon polstr wird}
            readpol:=true;
            end;  {chpol='r'}               {in die Variable pol eingelesen}
          'l':begin
            end;  {chpol='l'}
          end;  {case chpol}
        if readpol then
          begin
          setgraphmode(graphmode);
          showcollpol(pol,Aa,ba,hg[5]);
          ch:=readkey;
          restorecrtmode;
          end {readpol}
          else begin
            writeln(' Es ist kein Polygon geladen!');
            ch:=readkey;
            end;  {else}
      end;  {chm='p'}
    'z':ch:='e';                    {Programm-Abbruch}
  end; {case chm}
  until ch='e';
ch:=readkey;
end. {agmath2a}

Prozeduren:
procedure readrsafe(var r:real;grafik:boolean);
procedure bild(ch:char;var links,rechts,unten,oben:real;
               var x0,y0,x1,y1:integer);
procedure axes(color:word);
procedure zeroaffine(var A:matrix; var b:vector);
procedure emptypol(var pol:polygon);  {Initialisierung eines Polynoms}
procedure affin(A:matrix;b:vector;var z,za:vector);
procedure invers(var A,AI:matrix);
procedure affinvers(A:matrix;b:vector;var z,zi:vector);
procedure show(sq:squarray;nenner:integer;color:word);
procedure collage(g,h1,h2:integer;c1,c2,phi:real;d:vector;var sq:squarray;
               var imin,imax,jmin,jmax:integer;var chi:char);
procedure polygongraph(pol:polygon;color:word);
procedure abbildung(tra,trb:vectripel;var A:matrix;var b:vector);
procedure grid(color:word);
procedure punktewahl(var tra,trb:vectripel);
procedure fixpunkt(A:matrix;var b,z:vector);
procedure contraction(A:matrix;var s:real);
procedure collagecontraction(g,hg:integer;var sc:real);
procedure nameimage(A:matrix;b:vector;z1,z2:real;var x,y:integer;
                    name:string); {benennt Bildpunkt von z}
procedure zeigeabbildung(A:matrix;var b,zf:vector);
procedure showcollpol(pol:polygon;Aa:matarray;ba:vecarray;hg4:integer);
procedure colluebernahme(A:matrix;b:vector;var Aa:matarray; var ba:vecarray;
			 var booldef:boolarray;hu,ho:integer);
procedure numeingabe(var Aa:matarray;var ba:vecarray);
procedure abbildungswahl(var A:matrix;var b,d:vector;var g,h:integer;
                         c1,c2,phi:real);
procedure punkteeingabe(var pol:polygon);
procedure bildpunkte(A:matrix;b:vector;pol:polygon;color:word;chm:char);
procedure numausgabe(A:matrix;b:vector;pol,bildpol:polygon;chm:char);
procedure polygonwahl(var pol:polygon;n:integer;color:word);
procedure choosetriangle(pol:polygon;var tri:polygon);
procedure choosecollage(var Aa:matarray;var ba:vecarray;var h:integer;
                        var pol:polygon);
procedure colpolygon(pol:polygon;polystr:string;var colpolyfile:polyfile);
procedure savecollage(Aa:matarray;ba:vecarray;hg4:integer;pol:polygon;
                      var collfile:collagefile;var invfile:inventar;
                      var colpolyfile:polyfile);
procedure readcollage(var Aa:matarray;var ba:vecarray;var hg4:integer;
                      var pol:polygon;var colpolyfile:polyfile;
                      var collfile:collagefile;var invfile:inventar);
procedure cancelcoll(var invfile:inventar);
procedure menu(var g,hg5,am,nenner:integer;var phi:real;var d:vector;
	       var readpol:boolean;var chm:char);

----------------------------------------------------------------------