program agmath1; {Konstruktion der Koch-, Peano-, Drachen-, Lebesgue- und
verwandter Kurven, die durch Generatoren definiert sind, sowie von Fraktalen,
die nur durch Anfangsteile von Generatoren definiert sind, und der
Cantor-Menge; dickere Linien}

uses crt,graph,graph0,dialog2,xpzeich1;

type vector = array[1..2] of real;
     vecarray = array[0..9] of vector;
     vecfile = file of vector;
     narray = array[1..16] of integer;

     segment = array[1..2] of vector;
     segarray = array[0..9] of segment;
     segfile = file of segment;
     sarray = array[1..8] of real;

var ch,chn,chm:char;
    graphdriver,graphmode,x0,y0,x1,y1,k,n,level,power,fz,xx,xy,g:integer;
    int,nr,nx:longint;
    s,tol,dim:real;
    driverpath:string20;
    links,rechts,unten,oben,x:real;
    more,drache,lines:boolean;
    node0,noden:vector;
    coeff,nodes:vecarray;
    ntime:narray;
    sa:sarray;
    kochein,kochaus,kochfile,cantorein,cantoraus:vecfile;
    filename,xnstr:string;
    switch,gap,ok,detail:boolean;
    lineinfo:linesettingstype;
    xarr:xarray;

    seg:segment;
    segs,coeffs:segarray;
    segein,segaus,kochsfile:segfile;

procedure readrsafe(var r:real);  { Absturzfreies Einlesen einer Realzahl }
 var code:integer;
     st:string;
     x,y:integer;
begin
x:=wherex;
y:=wherey;
repeat
  gotoxy(x,y);
  reset(input);
  read(st);
  val(st,r,code);
  until code=0;
end;  { readrsafe }

procedure metrik(var x0,y0,x1,y1:integer);
begin                       {Bildschirmkoordinaten des Ursprunges und der}
x0:=bildx(links,rechts,0);  {Einheitsstrecken auf den Koordinatenachsen}
y0:=bildy(unten,oben,0);
x1:=bildx(links,rechts,1);
y1:=bildy(unten,oben,1);
end;  {metrik}

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 lebesgueschirm; {Linienkonstellation f�r Lebesgue-Funktion}
begin
cleardevice;
axes(7);
line(x1,y0,x1,y1);
horimarkexy(x1,y1);
setcolor(1);
line(x0,y0,x1,y0);
end;

procedure bild(var links,rechts,unten,oben,s:real;k:integer;
               var x0,y0,x1,y1:integer);
begin                  { Bildschirmabmessungen f�r verschiedene Koch-Kurven }
case k of
 13:begin                         {Drachenkurve}
    links:=-1.4/s;
    rechts:=1.8/s;
    unten:=-0.8/s;
    oben:=1.6/s;
    end;  {1..7}
  1,2,3,8,9,11:begin
    links:=-1.2/s;
    rechts:=1.2/s;
    unten:=-0.6/s;
    oben:=1.2/s;
    end;  {1..11}
  4:begin
    links:=-1.6/s;
    rechts:=1.6/s;
    unten:=-0.6/s;
    oben:=1.8/s;
    end;  {4}
  5,6,7:begin
    links:=-1.2/s;
    rechts:=1.2/s;
    unten:=-0.9/s;
    oben:=0.9/s;
    end;  {5,6,7}
 10:begin
    links:=-2.4/s;
    rechts:=2.4/s;
    unten:=-0.6/s;
    oben:=3.0/s;
    end;  {4,10}
 12:begin
    links:=-1.6/s;
    rechts:=1.6/s;
    unten:=-1.2/s;
    oben:=1.2/s;
    end;  {12}
 14:begin                   {Peano-Kurve}
    links:=-1.6/s;
    rechts:=1.6/s;
    unten:=-1.2/s;
    oben:=1.2/s;
    end;  {14}
 15:begin                  {Koch-Insel}
    links:=-0.8/s;
    rechts:=1.6/s;
    unten:=-1.2/s;
    oben:=0.6/s;
    end;  {15}
  16:begin                 {short fractal}
    links:=-0.8/s;
    rechts:=1.6/s;
    unten:=-0.6/s;
    oben:=1.2/s;
    end;  {16}
  17:begin                  {Lebesgue-Funktion}
    links:=-0.7/s;
    rechts:=1.7/s;
    unten:=-0.4/s;
    oben:=1.4/s;
    end;  {17}
  end;  {case k}
metrik(x0,y0,x1,y1);
end;  {bild}

procedure nclock(n:integer;var ntime:narray;var ok:boolean);
  var i,max:integer; {signalisiert bei Elimination der letzten Generatoren-}
begin                {Strecke, welche Teilstrecken vernachl„ssigt werden}
ok:=true;
ntime[1]:=ntime[1]+1;  {Weiterz„hlung bei jeder neuen Teilstrecke}
max:=0;
for i:=1 to 15 do
  begin
  if ntime[i]=n then   {n-adische Darstellung der Teilstreckennummer}
    begin
    ntime[i+1]:=ntime[i+1]+1;
    ntime[i]:=0;
    end;  {if}
  if ntime[i]>max then max:=ntime[i];
  end;  {if}
ok:=max<n-1;           {jede Abk”mmlingsstrecke der letzten Generatoren-}
end;  {nclock}         {Strecke wird nicht gezeichnet}

procedure generator(var coeff,nodes:vecarray;var level,n,fz,xx,xy:integer;
             var int,nr,nx:longint;var kochaus:vecfile;
             more,switch,gap,detail:boolean;var ok:boolean;var ntime:narray);
{ein festes Muster wird, „hnlich verkleinert, an Stelle jedes Intervalles
im vorhergehenden Muster gesetzt; die neuen St�tzpunkte werden in kochaus
festgehalten }
  var v,w:vector;
      length,coeff2:real;
      i,k,m,color:integer;
      p1,p2,q1,q2:array[0..9] of integer;
      ch:char;
begin                                      {L„nge der Strecke P[0]P[n]}
length:=sqrt(sqr(nodes[n,1]-nodes[0,1])+sqr(nodes[n,2]-nodes[0,2]));
for i:= 1 to 2 do
  v[i]:=(nodes[n,i]-nodes[0,i])/length;    {Einheits-Vektor in Strecke}
w[1]:=-v[2];
w[2]:=v[1];                                {Einheits-Orthogonal-Vektor}
for i:=1 to n do
  for k:=1 to 2 do                         {Generator-Zwischenpunkte}
    begin
    coeff2:=coeff[i,2];
    if switch then coeff2:=-coeff[i,2];
    nodes[i,k]:=nodes[0,k]+length*(coeff[i,1]*v[k]+coeff2*w[k]);
    end;  {i,k-Schleife}
p1[0]:=bildx(links,rechts,nodes[0,1]);     {Schirmpunkt des Anfangspunktes}
p2[0]:=bildy(unten,oben,nodes[0,2]);
for i:=1 to n do
  begin
  if ok then
    begin
    nr:=nr+1;                   { Nummer des auszugebenden Teilintervalles}
    if level>1 then             { je ein 1/fz der Teilstrecken wird }
      begin
      m:=int div fz;            { in einer anderen Farbe gezeichnet }
      if detail then
        color:=((nr-1) mod m) div (m div fz)
        else color:=(nr-1) div m;
      case color of
        0:setcolor(1);          { blau }
        1:setcolor(4);          { rot }
        2:setcolor(2);          { gr�n }
        3:setcolor(5);          { magenta }
        4:setcolor(3);          { cyan }
        5:setcolor(8);          { dunkelgrau }
        6:setcolor(9);          { hellblau }
        7:setcolor(10);         { hellgr�n }
        8:setcolor(12);         { hellrot }
        end;  {case m}
      end;  {level>1}
    p1[i]:=bildx(links,rechts,nodes[i,1]); {Schirmpunkt des i-Knickpunktes}
    p2[i]:=bildy(unten,oben,nodes[i,2]);
    line(p1[i-1],p2[i-1],p1[i],p2[i]);     {neu eingesetzte verkleinerte}
    if nx=nr-1 then                          {Teilstrecke}
      begin
      superkreuz(p1[i-1],p2[i-1],6);           {level-Approximation von x}
      ch:=readkey;
      end; {nx=nr-1}
    end;  {ok}
  if gap then nclock(n,ntime,ok);    {Entscheidung f�r die n„chsten Strecken}
  end;  {i-Schleife}
assign(kochaus,'newnodes');          {Aufnahme der neuen Zwischenpunkte}
if more then reset(kochaus)          {im Erg„nzungsfalle}
  else rewrite(kochaus);             {bei Neuanlage}
seek(kochaus,filesize(kochaus));     {Dateistelle f�r Neueintr„ge}
for i:=1 to n do
  write(kochaus,nodes[i]);           {einlesen}
close(kochaus);
end;  {generator}

procedure naer(x:real;n,level:integer;var nx:longint;var xnstr:string);
{ produziert die n-„re Darstellung (n1,n2,n3,...) einer Zahl 0<x<1 und die
ganze Zahl nx=n^level*(0.n1,n2,...nlevel)}
  var i,ai:integer;
      xi:real;
      st:string;
begin
xi:=x;
nx:=0;
xnstr:='0.';
for i:=1 to level do
  begin
  ai:=trunc(n*xi);
  xi:=frac(n*xi);
  nx:=n*nx+ai;
  str(ai,st);
  xnstr:=xnstr+st;
  end;
end; {n„r}

procedure newlevelkoch(coeff:vecarray;node0:vector;x:real;level,n:integer;
   int,nr:longint;var kochein,kochaus:vecfile;var chn:char;
   drache,gap,detail:boolean);
  var nodes:vecarray; {kochein enth„lt die Knickpunkte des zuletzt}
      noden:vector;   {konstruieretn levels}
      more,switch,ok:boolean; {die neu konstruierten Knickpunkt werden}
      xnstr:string;   {in kochaus gespeichert und dann in kochein �bertragen}
      i:integer;
begin
cleardevice;
nr:=0;                          {Nummer der gezeichneten Teilstrecken}
ok:=true;                       {vorl„ufig soll jede Teilstrecke gezeichnet}
for i:=1 to 16 do ntime[i]:=0;  {werden}
more:=false;                    {kochaus wird neu angelegt}
if drache then switch:=level>1 else switch:=false;
if x>0 then
  case gap of
    false:naer(x,n,level,nx,xnstr);   {n-adische Darstellung von x}
    true:naer(x,n-1,level,nx,xnstr);
    end {case}
  else nx:=-1;                         {Nummer der level-Approximation von x}
assign(kochein,'oldnodes');
assign(kochaus,'newnodes');
reset(kochein);                 {file mit Knickpunkten des zuletzt}
while not eof(kochein) do       {konstruierten levels}
  begin
  nodes[0]:=node0;              {�bergebener node0 wird zu nodes[0]}
  read(kochein,noden);          {benachbarter alter Knickpunkt}
  nodes[n]:=noden;              {wird Endpunkt des neuen Generators}
  generator(coeff,nodes,level,n,fz,xx,xy,int,nr,nx,kochaus,more,switch,
            gap,detail,ok,ntime);
  if drache then switch:=not switch;  { abwechselnd Generator-Spiegelung }
  node0:=noden;                 {und Anfangspunkt des n„chsten Generators}
  more:=true;                   {kochaus wird n„chstes Mal erweitert}
  end; {while}
close(kochein);                 {alle alte level-Strecken sind abgearbeitet}
rewrite(kochein);               {auf kochein werden die neu konstruierten}
reset(kochaus);                 {in kochaus gespeicherten Knickpunkte}
repeat                          {�bertragen}
  read(kochaus,noden);
  write(kochein,noden);
  until eof(kochaus);
close(kochaus);
close(kochein);
clearwindow(0,maxy-3*height,maxx,maxy);
setcolor(7);
if x>0 then
  xptextxy('; x ÷ '+xnstr,9*width,maxy-2*height,7,xarr);
xptextxy('Stufe',width,maxy-2*height,7,xarr);
xpnumberxy(level,2,0,7*width,maxy-2*height,7,xarr);
xptextxy(' N„chste Stufe (j/n) ?',50*width,maxy-2*height,7,xarr);
setcolor(1);
repeat chn:=readkey until chn in ['j','n'];
end;  {newlevelkoch}

procedure initiatekoch(noden:vector;var kochein:vecfile);
begin                       {die Datei kochein wird zun„chst nur mit }
assign(kochein,'oldnodes'); {dem einzigen Punkt noden geladen}
rewrite(kochein);
write(kochein,noden);
close(kochein);
end;  {initiatekoch}

procedure generators(seg:segment;color,level,n:integer;var coeff:segarray;
                    var segaus:segfile;more:boolean);
{ein festes Muster von n Segmenten wird, „hnlich verkleinert, an Stelle jedes
Segmentes im vorhergehenden Muster gesetzt; die neuen Segmente werden in
segaus festgehalten }
  var v,w:vector;
      segs:segarray;
      length:real;
      i,j,k,p1x,p1y,p2x,p2y:integer;
begin     {L„nge des Segmentes P[1]P[2], das Generator-transformiert wird}
length:=sqrt(sqr(seg[2,1]-seg[1,1])+sqr(seg[2,2]-seg[1,2]));
for i:= 1 to 2 do
  v[i]:=(seg[2,i]-seg[1,i])/length;        {Einheits-Vektor des Segments}
w[1]:=-v[2];
w[2]:=v[1];                                {Einheits-Orthogonal-Vektor}
for i:=1 to n do                           {n Generator-Segmente}
  for j:=1 to 2 do                         {Segment-Anfang und -Ende}
    for k:=1 to 2 do                       {Punktkoordinaten}
      segs[i,j,k]:=seg[1,k]+length*(coeff[i,j,1]*v[k]+coeff[i,j,2]*w[k]);
for i:=1 to n do
  begin
    if level>1 then             { je ein 1/fz der Teilstrecken wird }
      begin                     { in einer anderen Farbe gezeichnet }
      case color of
        0:setcolor(1);          { blau }
        1:setcolor(4);          { rot }
        2:setcolor(2);          { gr�n }
        3:setcolor(5);          { magenta }
        4:setcolor(3);          { cyan }
        5:setcolor(8);          { dunkelgrau }
        6:setcolor(9);          { hellblau }
        7:setcolor(10);         { hellgr�n }
        8:setcolor(12);         { hellrot }
        end;  {case m}
      end;  {level>1}
    p1x:=bildx(links,rechts,segs[i,1,1]); {Schirmpunkt des Anfangpunktes}
    p1y:=bildy(unten,oben,segs[i,1,2]);
    p2x:=bildx(links,rechts,segs[i,2,1]); {Schirmpunkt des Endpunktes}
    p2y:=bildy(unten,oben,segs[i,2,2]);
    if level=1 then
      begin
      setlinestyle(0,0,2);
      setcolor(1);
      end;
    line(p1x,p1y,p2x,p2y);         {neu eingesetztes verkleinertes Segment}
  end;  {i-Schleife}
setlinestyle(0,0,1);
setcolor(color);
assign(segaus,'newsegs');          {Aufnahme der neuen Segmente}
if more then reset(segaus)         {im Erg„nzungsfalle}
  else rewrite(segaus);            {bei Neuanlage}
seek(segaus,filesize(segaus));     {Dateistelle f�r Neueintr„ge}
for i:=1 to n do
  write(segaus,segs[i]);           {einlesen}
close(segaus);
end;  {generator}

procedure newlevelseg(var coeff:segarray;var level,n,fz,k:integer;
                       var segein,segaus:segfile;var chn:char);
{segein enth„lt die Segmente des zuletzt konstruieretn levels:die neu
konstruierten Segmente werden in segaus gespeichert und dann in segein
�bertragen}
  var seg:segment;
      more:boolean;
      i,color:integer;
      segzahl,farbgleich:longint;
begin
cleardevice;
if k=16 then axes(7);
segzahl:=1;
for i:=1 to level do
  segzahl:=segzahl*n;
farbgleich:=segzahl div fz;
segzahl:=0;
more:=false;                    {durch generator wird segaus neu angelegt}
assign(segein,'oldsegs');       {'oldsegs' enth„lt alte Segmente}
assign(segaus,'newsegs');       {'newsegs' wird die neuen aufnehmen}
reset(segein);
while not eof(segein) do
  begin
  segzahl:=segzahl+n;
  color:=(segzahl-1) div farbgleich;
  if k=3 then color:=0;
  read(segein,seg);             {n„chstes altes Segment}
  generators(seg,color,level,n,coeff,segaus,more);
  more:=true;                   {kochaus wird n„chstes Mal erweitert}
  end; {while}
close(segein);                 {alle alte level-Segmente sind abgearbeitet}
rewrite(segein);               {auf segein werden die neu konstruierten}
reset(segaus);                 {in segaus gespeicherten Segmente}
repeat                         {�bertragen}
  read(segaus,seg);
  write(segein,seg);
  until eof(segaus);
close(segaus);
close(segein);
clearwindow(0,maxy-3*height,maxx,maxy);
setcolor(7);
xptextxy('Stufe',width,maxy-2*height,7,xarr);
xpnumberxy(level,2,0,7*width,maxy-2*height,7,xarr);
xptextxy(' N„chste Stufe (j/n) ?',50*width,maxy-2*height,7,xarr);
setcolor(1);
repeat chn:=readkey until chn in ['j','n'];
end;  {newlevelkoch}

procedure initiateseg(k:integer;var segein:segfile);
  var seg:segment;
begin                      {die Datei kochein wird mit dem Initiator geladen}
assign(segein,'oldsegs');
rewrite(segein);
case k of
  15:begin                  {Initiator f�r die Koch-Insel}
    seg[1,1]:=0;
    seg[1,2]:=0;
    seg[2,1]:=1;
    seg[2,2]:=0;
    write(segein,seg);
    seg[1,1]:=1;
    seg[1,2]:=0;
    seg[2,1]:=0.5;
    seg[2,2]:=-sqrt(3)/2;
    write(segein,seg);
    seg[1,1]:=0.5;
    seg[1,2]:=-sqrt(3)/2;
    seg[2,1]:=0;
    seg[2,2]:=0;
    write(segein,seg);
    end;  {k=15}
  16:begin                          {Initiator f�r short fractal}
    seg[1,1]:=0;
    seg[1,2]:=0;
    seg[2,1]:=1;
    seg[2,2]:=0;
    write(segein,seg);
    end;  {k=16}
  end;  {case k}
close(segein);
end;  {initiate}

procedure initiator(var segein:segfile);
  var seg:segment;
      x1,y1,x2,y2:integer;
begin
assign(segein,'oldsegs');
reset (segein);
while not eof(segein) do
  begin
  read(segein,seg);
  x1:=bildx(links,rechts,seg[1,1]);
  y1:=bildy(unten,oben, seg[1,2]);
  x2:=bildx(links,rechts,seg[2,1]);
  y2:=bildy(unten,oben,seg[2,2]);
  line(x1,y1,x2,y2);
  end;
close(segein);
end;

procedure lesen(var kochfile:vecfile;filename:string);
  var node:vector;        {Bildschirmausgabe der Datei 'filename'}
      i:integer;
      ch:char;
begin
i:=0;
assign(kochfile,filename);
reset(kochfile);
while not eof(kochfile) do
  begin
  i:=i+1;
  read(kochfile,node);
  writeln(' ',i:3,': (',node[1]:4:2,',',node[2]:4:2,')');
  ch:=readkey;
  end;  {while}
close(kochfile);
end;  {lesen}

procedure generatorwahl(k:integer;var coeff:vecarray;var n:integer;
                                  var coeffs:segarray);
begin
case k of
  1:begin                             {Dreiecks-Kochkurve}
    n:=4;                             {Anzahl der Intervalle}
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Koch-Kurve}
    coeff[1,1]:=1/3;
    coeff[1,2]:=0;
    coeff[2,1]:=1/2;
    coeff[2,2]:=sqrt(3)/6;
    coeff[3,1]:=2/3;
    coeff[3,2]:=0;
    coeff[4,1]:=1;
    coeff[4,2]:=0;
    end;  {1, Dreiecks-Kochkurve}
  2:begin                             {Koch-Quadrat, 1. Verallg.}
    n:=5;                             {Anzahl der Intervalle}
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/3;
    coeff[1,2]:=0;
    coeff[2,1]:=1/3;
    coeff[2,2]:=1/3;
    coeff[3,1]:=2/3;
    coeff[3,2]:=1/3;
    coeff[4,1]:=2/3;
    coeff[4,2]:=0;
    coeff[5,1]:=1;
    coeff[5,2]:=0;
    end;  {Koch-Quadrat, 1. Verallg.}
  3:begin                             {Koch-Platte, 2. Verallg.}
    n:=5;                             {Anzahl der Intervalle}
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/3;
    coeff[1,2]:=0;
    coeff[2,1]:=1/3;
    coeff[2,2]:=1/5;
    coeff[3,1]:=2/3;
    coeff[3,2]:=1/5;
    coeff[4,1]:=2/3;
    coeff[4,2]:=0;
    coeff[5,1]:=1;
    coeff[5,2]:=0;
    end;  {Koch-Platte, 2. Verallg.}
  4:begin                             {Koch-Herd, 3. Verallg.}
    n:=5;                             {Anzahl der Intervalle}
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/3;
    coeff[1,2]:=0;
    coeff[2,1]:=1/3;
    coeff[2,2]:=1/2;
    coeff[3,1]:=2/3;
    coeff[3,2]:=1/2;
    coeff[4,1]:=2/3;
    coeff[4,2]:=0;
    coeff[5,1]:=1;
    coeff[5,2]:=0;
    end;  {Koch-Herd, 3. Verallg.}
  5:begin                             {Koch-Geschirr, 4. Verallg.}
    n:=8;                             {Anzahl der Intervalle}
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/4;
    coeff[1,2]:=0;
    coeff[2,1]:=1/4;
    coeff[2,2]:=1/4;
    coeff[3,1]:=1/2;
    coeff[3,2]:=1/4;
    coeff[4,1]:=1/2;
    coeff[4,2]:=0;
    coeff[5,1]:=1/2;
    coeff[5,2]:=-1/4;
    coeff[6,1]:=3/4;
    coeff[6,2]:=-1/4;
    coeff[7,1]:=3/4;
    coeff[7,2]:=0;
    coeff[8,1]:=1;
    coeff[8,2]:=0;
    end;  {5. Kochgeschirr, 4. Verallg.}
  6:begin                             {Koch-Temperatur, 5. Verallg.}
    n:=6;                             {Anzahl der Intervalle}
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/4;
    coeff[1,2]:=0;
    coeff[2,1]:=3/8;
    coeff[2,2]:=sqrt(3)/8;
    coeff[3,1]:=1/2;
    coeff[3,2]:=0;
    coeff[4,1]:=5/8;
    coeff[4,2]:=-sqrt(3)/8;
    coeff[5,1]:=3/4;
    coeff[5,2]:=0;
    coeff[6,1]:=1;
    coeff[6,2]:=0;
    end;  {6. Kochtemperatur, 5. Verallg.}
  7:begin                            {Koch-L”ffel, 6. Verallg.}
    n:=7;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/3;
    coeff[1,2]:=0;
    coeff[2,1]:=1/3;
    coeff[2,2]:=1/3;
    coeff[3,1]:=1/3;
    coeff[3,2]:=0;
    coeff[4,1]:=2/3;
    coeff[4,2]:=0;
    coeff[5,1]:=2/3;
    coeff[5,2]:=-1/3;
    coeff[6,1]:=2/3;
    coeff[6,2]:=0;
    coeff[7,1]:=1;
    coeff[7,2]:=0;
    end;  {7. Koch-L”ffel, 6. Verallg.}
  8:begin                             {Dach, Blumendraht}
    n:=2;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/2;
    coeff[1,2]:=1/(2*sqrt(3));
    coeff[2,1]:=1;
    coeff[2,2]:=0;
    end;  {8, Dach, Blumendraht}
  9:begin                             {Fresie, erg„nzte Schlingenkurve}
    n:=4;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/2;
    coeff[1,2]:=1/(2*sqrt(3));
    coeff[2,1]:=1;
    coeff[2,2]:=0;
    coeff[3,1]:=0.8;
    coeff[3,2]:=0;
    coeff[4,1]:=1;
    coeff[4,2]:=0;
    end;  {9. Fresie, erg„nzte Schlingenkurve}
 10:begin                             {Diamant, 2. Schlingen-Kurve }
    n:=3;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/4;
    coeff[1,2]:=sqrt(3)/4;
    coeff[2,1]:=3/4;
    coeff[2,2]:=sqrt(3)/4;
    coeff[3,1]:=1;
    coeff[3,2]:=0;
    end;  {10., Diamant, 2. Schlingen-Kurve}
 11:begin                             {Halb-Quadrat}
    n:=4;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/2;
    coeff[1,2]:=0;
    coeff[2,1]:=1/2;
    coeff[2,2]:=1/2;
    coeff[3,1]:=1/2;
    coeff[3,2]:=0;
    coeff[4,1]:=1;
    coeff[4,2]:=0;
    end;  {11., Halb-Quadrat}
 12:begin                              {Krabbe}
    n:=4;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/4;
    coeff[1,2]:=sqrt(3)/4;
    coeff[2,1]:=1/2;
    coeff[2,2]:=0;
    coeff[3,1]:=3/4;
    coeff[3,2]:=-sqrt(3)/4;
    coeff[4,1]:=1;
    coeff[4,2]:=0;
    end;  {12., Krabbe}
 13:begin                             { Drache }
    n:=2;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/2;
    coeff[1,2]:=1/2;
    coeff[2,1]:=1;
    coeff[2,2]:=0;
    end;  {13., Drache}
 14:begin                             { Peano-Kurve }
    n:=9;
    coeff[0,1]:=0;                    {Relativ-Koordinaten der}
    coeff[0,2]:=0;                    {St�tzstellen f�r die Kurve}
    coeff[1,1]:=1/3;
    coeff[1,2]:=0;
    coeff[2,1]:=1/3;
    coeff[2,2]:=1/3;
    coeff[3,1]:=2/3;
    coeff[3,2]:=1/3;
    coeff[4,1]:=2/3;
    coeff[4,2]:=0;
    coeff[5,1]:=1/3;
    coeff[5,2]:=0;
    coeff[6,1]:=1/3;
    coeff[6,2]:=-1/3;
    coeff[7,1]:=2/3;
    coeff[7,2]:=-1/3;
    coeff[8,1]:=2/3;
    coeff[8,2]:=0;
    coeff[9,1]:=1;
    coeff[9,2]:=0;
    end;  {14., Peano}
 15:begin                             {Koch-Insel}
    n:=4;                             {Anzahl der Intervalle}
    coeffs[1,1,1]:=0;                  {Relativ-Koordinaten der}
    coeffs[1,1,2]:=0;                  {St�tzstellen f�r die Koch-Insel}
    coeffs[1,2,1]:=1/3;
    coeffs[1,2,2]:=0;
    coeffs[2,1,1]:=1/3;
    coeffs[2,1,2]:=0;
    coeffs[2,2,1]:=1/2;
    coeffs[2,2,2]:=sqrt(3)/6;
    coeffs[3,1,1]:=1/2;
    coeffs[3,1,2]:=sqrt(3)/6;
    coeffs[3,2,1]:=2/3;
    coeffs[3,2,2]:=0;
    coeffs[4,1,1]:=2/3;
    coeffs[4,1,2]:=0;
    coeffs[4,2,1]:=1;
    coeffs[4,2,2]:=0;
    end;  {15, Koch-Insel}
 16:begin                             {short fractal}
    n:=2;                             {Anzahl der Intervalle}
    coeffs[1,1,1]:=0;                  {Relativ-Koordinaten der}
    coeffs[1,1,2]:=0;                  {St�tzstellen f�r die Kurve}
    coeffs[1,2,1]:=1/2;
    coeffs[1,2,2]:=0;
    coeffs[2,1,1]:=1;
    coeffs[2,1,2]:=1/2;
    coeffs[2,2,1]:=1;
    coeffs[2,2,2]:=1;
    end;  {16, short fractal}
  end;  {case}
end;  {generatorwahl}

procedure initiatecantor(var cantorein:vecfile);
  var int0:vector;         {zu Beginn enth„lt 'cantorein'}
begin                      {nur das Intervall [-1,1]}
int0[1]:=-1;
int0[2]:=1;
assign(cantorein,'oldints');
rewrite(cantorein);
write(cantorein,int0);
close(cantorein);
end;  {initiatecantor}

procedure initiatelebesgue(var cantorein:vecfile);
  var int0:vector;        {zu Beginn enth„lt 'cantorein'}
begin                     {nur das Intervall [0,1]}
int0[1]:=0;
int0[2]:=1;
assign(cantorein,'oldints');
rewrite(cantorein);
write(cantorein,int0);
close(cantorein);
end;  {initiatecantor}

procedure cantor(intv:vector;var coeff:vecarray;level:integer;
          var cantoraus:vecfile;more:boolean);
{Die n Intervalle der Cantor-Zerlegung von intv werden durch die Komponenten
von n vector-Daten (nodes[1..n]) gegeben: Anfangspunkt nodes[n,1], Endpunkt
nodes[n,2]}
  var length:real;
      i,y2:integer;
      p1,p2:array[1..8] of integer;
      nodes:vecarray;
begin
y2:=200+(180 div level);
length:=intv[2]-intv[1];                {L„nge des zu zerlegenden Intervalles}
setlinestyle(0,1,3);
for i:=1 to n do
  begin
  nodes[i,1]:=intv[1]+coeff[i,1]*length;  {coeff[i]: maást„blicher Abstand}
  nodes[i,2]:=intv[1]+coeff[i,2]*length;  {der neuen Intervallenden vom}
  p1[i]:=bildx(links,rechts,nodes[i,1]);  {Anfangspunkt von intv[i]}
  p2[i]:=bildx(links,rechts,nodes[i,2]);  {Endpunkt von intv[i]}
  line(p1[i],200,p2[i],200);
  end;  {i-Schleife}
setcolor(4);
for i:=1 to n-1 do
  begin
  setcolor(4);
  line(p2[i],y2,p1[i+1],y2);              {L”schintervalle einzeln}
  line(p2[i],100,p1[i+1],100);            {L”schintervalle auf gleicher H”he}
  setcolor(15);
  line(p2[i],200,p1[i+1],200);            {gel”schte Intervalle}
  end;  {i-Schleife}
setcolor(1);
setlinestyle(0,1,1);
assign(cantoraus,'newints');
if more then reset(cantoraus)             {im Erg„nzungsfalle}
  else rewrite(cantoraus);                {bei Neuanlage}
seek(cantoraus,filesize(cantoraus));      {Dateistelle f�r Neueintr„ge}
for i:=1 to n do
  write(cantoraus,nodes[i]);              {Archivierung der neuen Intervalle}
close(cantoraus);
end;  {cantor}

procedure newlevelcantor(coeff:vecarray;n,level:integer;
                   var cantorein,cantoraus:vecfile;var chn:char);
  var nodes:vecarray;
      intv:vector;
      more:boolean;
begin
more:=false;                       {cantoraus wird neu angelegt}
assign(cantorein,'oldints');
assign(cantoraus,'newints');
reset(cantorein);                  {file mit neuen Teilintervallen offen}
while not eof(cantorein) do
  begin
  read(cantorein,intv);            {n„chstes neues Intervall}
  cantor(intv,coeff,level,cantoraus,more);
  more:=true;                      {cantoraus wird n„chstes Mal erweitert}
  end; {while}
close(cantorein);
rewrite(cantorein);              {auf cantorein werden die neu konstruierten}
reset(cantoraus);                {Intervalle aus cantoraus �bertragen}
repeat
  read(cantoraus,intv);
  write(cantorein,intv);
  until eof(cantoraus);
close(cantoraus);
close(cantorein);
clearwindow(0,maxy-3*height,maxx,maxy);
setcolor(7);
xptextxy('Stufe',width,maxy-2*height,7,xarr);
xpnumberxy(level,2,0,8*width,maxy-2*height,7,xarr);
xptextxy(' N„chste Stufe (j/n)?',50*width,maxy-2*height,7,xarr);
setcolor(1);
repeat chn:=readkey until chn in ['j','n'];
end;  {newlevelcantor}

procedure lift(q:vector;h:real);
{hebt das Intervall [q[1],q[2]] von H”he 0 auf H”he h}
  var x1,x2,y,i:integer;
begin
x1:=bildx(links,rechts,q[1]);
x2:=bildx(links,rechts,q[2]);
y:=bildy(unten,oben,h);
for i:=y0 downto y+1 do
  begin
  setcolor(15);
  line(x1,i,x2,i);
  setcolor(1);
  line (x1,i-1,x2,i-1);
  delay(1000);
  end;  {i-Schleife}
end;  {lift}

procedure lebesgue(intv:vector; var last:real;var q:vector;var coeff:vecarray;
                   level,power,nr:integer;var cantoraus:vecfile;
                   more,lines:boolean);
{In der Stufe level wird aus dem �bernommenen Intervall intv das mittlere
Drittel q entnommen und von H”he 0 auf H”he h=1/2^level+i/2^(level-1)
gehoben (i=0...2^(level-1)-1).
Die 2 Intervalle der Cantor-Zerlegung von intv werden durch die Komponenten
von 2 vector-Daten (nodes[1..2]) gegeben: Anfangspunkt nodes[k,1], Endpunkt
nodes[k,2]}
  var length,h:real;     {power=2^level=Anzahl der Intervalle 'intv'}
      i,h1,h2,p1,p2,q1,q2:integer;
      nodes:vecarray;
begin
length:=intv[2]-intv[1];               {L„nge des zu zerlegenden Intervalles}
for i:=1 to 2 do
  begin
  nodes[i,1]:=intv[1]+coeff[i,1]*length;  {coeff[i]: maást„blicher Abstand}
  nodes[i,2]:=intv[1]+coeff[i,2]*length;  {der neuen Intervallenden vom}
  end;  {i-Schleife}                      {alten Intervall-Anfangspunkt}
q[1]:=nodes[1,2];                        {Anfangspunt der Horizontal-Strecke}
q[2]:=nodes[2,1];                        {zum n„chsten Intervall 'intv'}
h:=1/power+nr*2/power;
case lines of
  false:begin                            {nur Horiontalstrecken der Funktion}
    if level=1 then ch:=readkey;
    lift(q,h);
    end;  {false}
  true:begin                             {st�ckweise lineare Approximation}
    q1:=bildx(links,rechts,last);        {Anfangs-Horizontalstrecke}
    q2:=bildx(links,rechts,intv[1]);
    h1:=bildy(unten,oben,(2*nr)/power);
    setcolor(15);
    line(q1,y0,q2,y0);
    setcolor(1);
    line(q1,h1,q2,h1);
    for i:=1 to 2 do
      begin
      p1:=bildx(links,rechts,nodes[i,1]);
      p2:=bildx(links,rechts,nodes[i,2]);
      h1:=bildy(unten,oben,(2*nr+i-1)/power);  {Niveau des Anfangspunktes}
      h2:=bildy(unten,oben,(2*nr+i)/power);    {Niveau des Endpunktes}
      line(p1,h1,p2,h2);
      end; {i-Schleife}
    q1:=bildx(links,rechts,q[1]);
    q2:=bildx(links,rechts,q[2]);
    setcolor(15);
    line(q1,y0,q2,y0);
    setcolor(1);
    line(q1,h1,q2,h1);
    last:=intv[2];
    end;  {true}
  end; {case}
assign(cantoraus,'newints');
if more then reset(cantoraus)             {im Erg„nzungsfalle}
  else rewrite(cantoraus);                {bei Neuanlage}
seek(cantoraus,filesize(cantoraus));      {Dateistelle f�r Neueintr„ge}
for i:=1 to 2 do
  write(cantoraus,nodes[i]);              {Archivierung der neuen Intervalle}
close(cantoraus);
end;  {lebesgue}

procedure newlevellebesgue(coeff:vecarray;level,power,nr:integer;
                   var cantorein,cantoraus:vecfile;var chn:char;
                   lines:boolean);
  var nodes:vecarray;         {cantorein enth„lt die Intervalle, aus denen}
      q,intv:vector;          {die offenen Trenn-Intervalle entfernt werden,}
      last:real;              {cantoraus die resultierenden neuen Teil-}
      more:boolean;           {Intervalle, die nach Behandlung aller Inter-}
begin                         {valle in cantorein dorthin �bertragen werden}
more:=false;                  {cantoraus wird neu angelegt}
assign(cantorein,'oldints');
assign(cantoraus,'newints');
reset(cantorein);             {file mit Bearbeitungs-Intervallen offen}
nr:=-1;                       {f�r Z„hlung der Intervalle in cantorein}
last:=0;                      {initiiert Anfangspunkt Horizontalverbindung}
if lines then lebesgueschirm; {l”scht alten st�ckweise linearen Graph}
while not eof(cantorein) do
  begin
  nr:=nr+1;
  read(cantorein,intv);          {n„chstes Bearbeitung-Intervall}
  lebesgue(intv,last,q,coeff,level,power,nr,cantoraus,more,lines);
  more:=true;                    {cantoraus wird n„chstes Mal erweitert}
  end; {while}
close(cantorein);
rewrite(cantorein);              {auf cantorein werden die neu konstruierten}
reset(cantoraus);                {Intervalle aus cantoraus �bertragen}
repeat
  read(cantoraus,intv);
  write(cantorein,intv);
  until eof(cantoraus);
close(cantoraus);
close(cantorein);
clearwindow(0,maxy-3*height,maxx,maxy);
setcolor(7);
xptextxy('Stufe',width,maxy-2*height,7,xarr);
xpnumberxy(level,2,0,7*width,maxy-2*height,7,xarr);
xptextxy(' N„chste Stufe (j/n) ?',50*width,maxy-2*height,7,xarr);
setcolor(1);
repeat chn:=readkey until chn in ['j','n'];
end;  {newlevellebesgue}

procedure bilddaten(var links,rechts,unten,oben:real);
  var ch:char;    {erlaubt in der Prozedur 'menu' die Eingabe der}
begin             {Bildschirmgrenzen}
writeln;
writeln(' links:      ',links:4:1,' ... l');
writeln(' rechts:     ',rechts:4:1,' ... r');
writeln(' unten:      ',unten:4:1,' ... u');
writeln(' oben:       ',oben:4:1,' ... o');
writeln;
repeat
  writeln(' Žnderung (l,r,u,o,n)?');
  repeat ch:=readkey until ch in ['l','r','u','o','n'];
  case ch of
    'l':begin
      write(' links = ');
      readrwritexy(10,wherey,3,1,links);
      writeln;
      end;
    'r':begin
      write(' rechts = ');
      readrwritexy(10,wherey,3,1,rechts);
      writeln;
      end;
    'u':begin
      write(' unten = ');
      readrwritexy(10,wherey,3,1,unten);
      writeln;
      end;
    'o':begin
      write(' oben = ');
      readrwritexy(10,wherey,3,1,oben);
      writeln;
      end;
    end;  {case ch}
  writeln;
  until ch='n';
end;  {bilddaten}

procedure saeingabe(var n:integer;var sa:sarray);
  var i:integer;
      ch:char;
begin
n:=1;
for i:=1 to 8 do sa[i]:=1/3;
repeat
  clrscr;
  writeln;
  write(' Anzahl der Žhnlichkeitstransformationen n = ');
  readgwritexy(wherex,wherey,1,n);
  writeln;
  writeln;
  writeln(' Eingabe der Žhnlichkeitsfaktoren s[i]:');
  for i:=1 to n do
    begin
    write(' s[',i,'] = ');
    readrwritexy(wherex,wherey,4,2,sa[i]);
    writeln;
    end;  {i-Schleife}
  writeln;
  writeln(' akzeptabel (j/n) ?)');
  repeat ch:=readkey until ch in ['j','n'];
  until ch='j';
end;  {saeingabe}

procedure dimension(tol:real;s:sarray;n: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 n 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 menuabfrage(var n,fz:integer;var x:real);
  var ch:char;                   {Teil des Menus}
begin
writeln;
write(' Anzahl der verschiedenen Farben fz = ');
repeat readgwritexy(wherex,wherey,1,fz) until ((1<=fz) and (fz<=9));
writeln;
writeln;
writeln
  (' Soll ein Teilungspunkt der Kurve eingezeichnet werden (j/n)?');
repeat ch:=readkey until ((ch='j') or (ch='n'));
if ch='j' then
  begin
  clrscr;
  write(' F�r welchen Parameterwert x im Intervall [0,1]?  x = ');
  repeat readrwritexy(wherex,wherey,5,3,x) until ((0<x) and (x<1));
  writeln;
  naer(x,n,10,nx,xnstr);
  writeln(' n-adisch: x = ',xnstr,'...');
  ch:=readkey;
  end  {ch='j'}
    else x:=0;
end;  {menuabfrage}

procedure menu(var k,n,fz:integer;var x:real;var coeff:vecarray;
               var chm:char;var filename:string;
               var drache,gap,detail,lines:boolean);
  var i,g:integer;
      ch:char;
begin
drache:=false;               {Konstruktionsadaptierung f�r Drachenkurve}
gap:=false;                  {Konstruktionsadaptierung f�r Vernachl„ssigung}
clrscr;                      {der letzten Generator-Teilstrecke}
writeln;
writeln(' Cantor-Menge ........................ c');
writeln(' Aufruf eines Generators ............. a');
writeln(' Konstruktion eines Generators ....... g');
writeln(' Lebesgue-Funktion ................... l');
writeln(' Bilddaten „ndern .................... b');
writeln(' Dimension ........................... d');
          { writeln(' Knickpunkt-Dateien lesen ............ d');}
writeln(' Programm-Ende ....................... e');
writeln;
repeat chm:=readkey until chm in ['a','b','c','d','e','g','l'];
clrscr;
writeln;
case chm of
  'g':begin             {Konstruktion eines Generators}
    x:=0;
    g:=n;
    repeat
      writeln(' Der Anfangspunkt ist der Ursprung (0,0).');
      writeln(' Endpunkt (1,0) (j/n) ?');
      repeat ch:=readkey until ch in ['j','n'];
      gap:=ch='n';      {Generator h”rt eine Teilstrecke vor (1,0) auf}
      write(' Anzahl der Teilstrecken: n = ');
      repeat readgwritexy(wherex,wherey,1,g) until g<=9;
      writeln;
      writeln;
      writeln(' Relativ-Koordinaten der Knickpunkte:');
      n:=g;
      if gap then n:=g+1;
      for i:=1 to g do
        begin
        write(' coeff[',i,',1] = ');
        readrwritexy(wherex,wherey,4,2,coeff[i,1]);
        writeln;
        write(' coeff[',i,',2] = ');
        readrwritexy(wherex,wherey,4,2,coeff[i,2]);
        writeln;
        end;   {i-Schleife}
      writeln;
      writeln(' akzeptabel (j/n)?');
      repeat ch:=readkey until ch in ['j','n'];
      until ch='j';
    coeff[n,1]:=1;            {Endpunkt}
    coeff[n,2]:=0;
    menuabfrage(g,fz,x);
    end;  {chm='g'}
(*  'd':begin                   {Kontroll-Lesen einer Datei}
    reset(input);
    write(' Name der Datei: ');
    read(filename);
    end;  {chm='l'}*)
  'a':begin                   {Aufruf eines Kochkurven-Generators}
    writeln(' Koch-Kurve .................. 1');
    writeln(' Koch-Quadrat  ............... 2');
    writeln(' Koch-Platte ................. 3');
    writeln(' Koch-Herd ................... 4');
    writeln(' Koch-Geschirr ............... 5');
    writeln(' Koch-Temperatur ............. 6');
    writeln(' Koch-L”ffel ................. 7');
    writeln(' Blumendraht ................. 8');
    writeln(' Fresie ...................... 9');
    writeln(' Diamant .................... 10');
    writeln(' Halb-Quadrat ............... 11');
    writeln(' Krabbe ..................... 12');
    writeln(' Heighway-Harter-Drache ..... 13');
    writeln(' Peano-Kurve ................ 14');
    writeln(' Koch-Insel ..................15');
    writeln(' kurze fraktale Kurve ....... 16');
    writeln;
    write(' Nummer des Generators: k = ');
    repeat readgwritexy(wherex,wherey,1,k) until ((k>0) and (k<17));
    drache:=k=13;
    generatorwahl(k,coeff,n,coeffs);
    write('; ',n,' Teilintervalle');
    writeln;
    if k=14 then
      begin
      writeln;
      writeln(' Soll die Musterung detailliert sein (j/n)?');
      repeat ch:=readkey until ((ch='j') or (ch='n'));
      detail:=ch='j';
      end; {k=14}
    menuabfrage(n,fz,x);
    end;  {chm='a'}
  'c':begin                   {Konstruktion einer Cantor-Menge}
    n:=2;                     {Intervalle der Standard-Cantormenge}
    coeff[1,1]:=0;            {Anfangspunkt erstes Intervall}
    coeff[1,2]:=1/3;          {Endpunkt erstes Intervall}
    coeff[2,1]:=2/3;          {Anfangspunkt zweites Intervall}
    coeff[2,2]:=1;            {Endpunkt zweites Intervall}
    repeat
      write(' Anzahl der Teilintervalle: n = ');
      readgwritexy(wherex,wherey,1,n);
      writeln;
      writeln(' Relativ-Koordinaten der Intervall-Endpunkte:');
      for i:=1 to n do
        begin
        write(' intv[',i,',1] = ');   {Anfangspunkt des i-ten Intervalles}
        readrwritexy(wherex,wherey,4,2,coeff[i,1]);
        writeln;
        write(' intv[',i,',2] = ');   {Endpunkt des i-ten Intervalles}
        readrwritexy(wherex,wherey,4,2,coeff[i,2]);
        writeln;
        end;
      writeln(' akzeptabel (j/n)?');
      repeat ch:=readkey until ch in ['j','n'];
      until ch='j';
    end;  {chm='c'}
  'd':begin
    writeln
    (' Die Berechnung der Dimension ist nur dann mathematisch begr�ndet,');
    writeln
    (' wenn das Fraktal A die Vereinigung von endlich vielen Bildern von A');
    writeln
   (' unter Žhnlichkeitstransformationen mit Žhnlichkeitsfaktoren s[i]<1');
    writeln
    (' und die offenen-Mengen-Bedingung erf�llt ist.');
    end;  {chm='d'}
  'l':begin
    writeln
    (' Intervall-Lifting (i) oder st�ckweise lineare Approximation (s) ?');
    repeat ch:=readkey until ch in ['i','s'];
    lines:=ch='s';
    end;  {chm='l'}
  end;  {case chm}
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);
getlinesettings(lineinfo);
restorecrtmode;
node0[1]:=-1;                  {Generator-Anfangspunkt}
node0[2]:=0;
noden[1]:=1;                   {Generator-Endpunkt}
noden[2]:=0;
s:=1;                          {Zoomfaktor}
k:=1;                          {Menu-Nummer der Koch-Kurve}
n:=4;                          {Anzahl der Generator-Teilstrecken}
fz:=2;                         {Anzahl der Farben}
x:=0;                          {Teilungspunkt der Kurve}
tol:=0.001;                    {Toleranz f�r Dimensionsberechnung}
detail:=false;
generatorwahl(1,coeff,n,coeffs);      {Koch-Kurve}
bild(links,rechts,unten,oben,s,1,x0,y0,x1,y1);
repeat
  nr:=0;                       {Nummerierungsanfang der Teilstrecken}
  menu(k,n,fz,x,coeff,chm,filename,drache,gap,detail,lines);
  case chm of
    'a','g':begin              {Generator-Aufruf bzw. -Konstruktion }
      g:=n;                    {Anzahl der gezeichneten Teilstrecken}
      if gap then g:=n-1;
      level:=0;
      int:=1;                  {Anzahl der Intervalle im aktuellen Muster }
      if chm='a' then bild(links,rechts,unten,oben,s,k,x0,y0,x1,y1);
      setgraphmode(graphmode);
      setbkcolor(15);          {Hintergrundfarbe weiá}
      setcolor(1);             {Zeichenfarbe dunkelblau}
      if ((k=15) or (k=16)) then
        begin
        initiateseg(k,segein);  {der Initiator wird geladen}
        initiator(segein)
        end
          else initiatekoch(noden,kochein);  {noden=[1,0] ist zu Beginn}
      repeat                  { der einzige in kochein enthaltene Punkt}
        level:=level+1;
        int:=int*g;         { = g^level, Anzahl der Teilstrecken f�r level }
        if ((k=15) or (k=16)) then
          newlevelseg(coeffs,level,n,fz,k,segein,segaus,chn)
            else newlevelkoch(coeff,node0,x,level,n,int,nr,
                              kochein,kochaus,chn,drache,gap,detail);
        until chn='n';      {keine Konstruktion eines weiteren levels}
      end; {'a','g'}
(*    'd':begin
      lesen(kochfile,filename);
      end; {'l'}*)
    'c':begin                     { Cantor-Menge }
      setgraphmode(graphmode);
      setbkcolor(15);
      setcolor(1);
      bild(links,rechts,unten,oben,s,k,x0,y0,x1,y1);
      initiatecantor(cantorein);
      level:=0;
      repeat
        level:=level+1;
        newlevelcantor(coeff,n,level,cantorein,cantoraus,chn);
        until chn='n';
      end;  {'c'}
    'l':begin                          {Lebesgue-Funktion}
      setgraphmode(graphmode);
      setbkcolor(15);
      setcolor(1);
      bild(links,rechts,unten,oben,s,17,x0,y0,x1,y1);
      lebesgueschirm;
      initiatelebesgue(cantorein);     {Linienkonstellation}
      coeff[1,1]:=0;
      coeff[1,2]:=1/3;
      coeff[2,1]:=2/3;
      coeff[2,2]:=1;
      level:=0;
      power:=1;                {Anzahl der level-Teilstrecken in cantorein}
      repeat
        level:=level+1;
        power:=2*power;
        newlevellebesgue(coeff,level,power,nr,cantorein,cantoraus,chn,lines);
        until chn='n';
      end;  {'l'}
    'b':begin                  {Žnderung der Bildschirm-Grenzen}
      bilddaten(links,rechts,unten,oben);
      metrik(x0,y0,x1,y1);
      end;  {'b'}
    'd':begin
      saeingabe(n,sa);
      dimension(tol,sa,n,dim);
      writeln;
      writeln(' Dimension des Fraktales: dim = ',dim:4:2);
      writeln;
      ch:=readkey;
      end;  {'d'}
    end;   {case chm}
  restorecrtmode;
  until chm='e';
end. {agmath1}