program agmath3a; {produziert und speichert Mandelbrotmenge f�r f(z)=z^2-l
        samt Details und zugeh”rige Julia-Mengen.
        In einer Julia-Menge k”nnen verschiedene Orbits eingetragen werden.
        G. Helmberg, 27.11.2006}
uses crt,graph,graph0,dialog2,xpzeich1;

type vector = array[1..2] of real;
     bit = 0..1;
     zarray = array[1..4] of vector;
     screendat = file of word;
     screenpar = file of real;
     apfelrec = record
                  name:string;      { apfel1,...}
                  farbtyp:char;     { e:einf„rbig;f:fluchtzeiten;a:anziehung}
                  li,re,un,ob:real;
                  rad:real;
                  num:integer;      { maximale Fluchtzeit }
                  vec:vector;       { f(z)=z^2-vec }
                  end;  { apfelrec }
     apfelpar = file of apfelrec;

var z,l,zero:vector;
    fix:zarray;
    ch,chm,chc:char;
    n,nenner,numits,minxpaint,maxxpaint,minypaint,maxypaint,i,j,
      graphdriver,graphmode,x0,y0,x1,y1:integer;
    n1:longint;
    driverpath:string20;
    links,rechts,unten,oben:real;
    color:word;
    h:bit;
    out,conn,call,save,col,jul:boolean;
    larray:array[1..16] of vector;
    endejulia,doit:boolean;
    dat:screendat;
    par:screenpar;
    recpar:apfelpar;
    filename:string;
    xarr:xarray;

{$R-}
procedure readrsafe(var r:real);
 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
x0:=bildx(links,rechts,0);
y0:=bildy(unten,oben,0);
x1:=bildx(links,rechts,1);
y1:=bildy(unten,oben,1);
end;  {metrik}

procedure bild(ch:char;var links,rechts,unten,oben:real;
               var x0,y0,x1,y1:integer);
begin
case ch of
  'b':begin
    links:=-2.4;
    rechts:=4.8;
    unten:=-2.7;
    oben:=2.7;
    end;
  'w':begin
    links:=-0.4;
    rechts:=0.8;
    unten:=-0.05;
    oben:=0.85;
    end;  {'w'}
  'm':begin
    links:=-0.1;
    rechts:=1.1;
    unten:=-0.05;
    oben:=0.85;
    end;  {'m'}
  'i':begin
    links:=-2.4;
    rechts:=2.4;
    unten:=-1.8;
    oben:=1.8;
    end;  {'i'}
  'z':begin
    links:=-4;
    rechts:=4;
    unten:=-3;
    oben:=3;
    end;  {'z'}
  'j':begin
    links:=-2.4;
    rechts:=2.4;
    unten:=-1.8;
    oben:=1.8;
    end;  {'j'}
  'a':begin
    links:=-1.5;
    rechts:=2.5;
    unten:=-1.5;
    oben:=1.5;
    end;  {'a'}
  'f':begin                         { Fluchtzeit Apfelm„nnchen}
    links:=-3.2;
    rechts:=3.2;
    unten:=-2.4;
    oben:=2.4;
    end;
  end;  {case ch}
metrik(x0,y0,x1,y1);
end;  {bild}

procedure okreuz(a,b:integer;color,ocolor:word);
{ Markierung des Bildschirmpunktes (a,b) in Farbe ocolor durch ein Kreuz
  in Farbe color }
  var oldcolor:integer;
begin
oldcolor:=getcolor;
setcolor(color);
line(a-3,b,a+3,b);
line(a,b-3,a,b+3);
putpixel(a,b,ocolor);
setcolor(oldcolor);
end;  { kreuz }

function nmod16(n:integer):integer;
begin
nmod16:=n mod(16);
end;

procedure xpnumberxy(z:real;a,d,x,y:integer;var xarr:xarray;color:word);
  var i,j,k,xz,yz,n,code:integer;  {Ausgabe der Zahl z im Grafikmodus f�r}
      st:string;                   {das Betriebssystem XP; Anfang im linken}
      ch,chi:char;                 {oberen Pixelpunkt (x,y)}
      oldcolor:word;
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;
      putpixel(xz,yz,xarr[n,j,k]);
      end;   {k-Schleife}
  end;  {i-Schleife}
setcolor(oldcolor);
end;  {xpnumberxy}

procedure xptextxy(st:string;x,y:integer;var xarr:xarray;color:word);
  var i,j,k,xz,yz,n:integer;  {Ausgabe des Strings st im Grafikmodus f�r das}
      ch,chi:char;            {Betriebssystem XP; Anfang im linken}
      oldcolor:word;                        {oberen Pixelpunkt (x,y)}
begin
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);
  var x2,x3:integer;
begin
setcolor(color);
line(width,y0,maxx-width,y0);
line(x0,height,x0,maxy-height);
horimarkexy(x0,y1);
vertmarkexy(x1,y0);
x2:=bildx(links,rechts,2);
vertmarkexy(x2,y0);
x3:=bildx(links,rechts,-1);
vertmarkexy(x3,y0);
xpnumberxy(1,1,0,x0-width,y1-height,xarr,color);
xpnumberxy(1,1,0,x1,y0-height,xarr,color);
xpnumberxy(2,1,0,x2,y0-height,xarr,color);
xpnumberxy(-1,1,0,x3,y0-height,xarr,color);
end;  {axes}

procedure abfrage(str:string;var doit:boolean);
  var ch:char;
      len:integer;
begin
len:=72-length(str);
clearwindow(len*width,maxy-2*height,maxx,maxy);
xptextxy(str+' (j/n) ?',len*width,maxy-2*height,xarr,getcolor);
repeat ch:=readkey until ch in ['j','n'];
doit:=ch='j';
end;  {abfrage}

procedure fmap(var z,l:vector); {bildet z=(x,y) ab in f(z)=z^2-l}
  var xein,yein:real;
begin
xein:=z[1];
yein:=z[2];
z[1]:=sqr(xein)-sqr(yein)-l[1];      { Re(f(z)) }
z[2]:=2*xein*yein-l[2];              { Im(f(z)) }
end;  {fmap}

procedure zeroescape(r:real;var n,numits:integer;l:vector;var out:boolean);
  var r2,r2xy:real;
      z:vector;
begin                {gibt Zeitpunkt n an, zu dem |fmap^n(0,l)|>r}
z:=zero;
r2:=sqr(r);
n:=-1;
out:=false;
repeat
  n:=n+1;              { Fluchtzeit }
  r2xy:=sqr(z[1])+sqr(z[2]);
  fmap(z,l);           { z->z^2-l }
  until ((r2xy>r2) or (n>numits));
out:=n<=numits;         { l geh”rt zur Menge, f�r die Fluchtzeit(0)=n }
end;  {zeroescape}

procedure coord(xpix,ypix:integer;var z:vector);
begin     { Koordinaten eines Punktes mit Pixel-Koordinaten (xpix,ypix) }
z[1]:=links+xpix*(rechts-links)/maxx;
z[2]:=unten+(maxy-ypix)*(oben-unten)/maxy;
end; {coord}

procedure pixel(z:vector;var xpix,ypix:integer);
begin                              {Pixelkoordinaten eines Punktes (x,y)}
xpix:=bildx(links,rechts,z[1]);
ypix:=bildy(unten,oben,z[2]);
end;  {pixel}



procedure pointescape(var r:real;var n,numits:integer;z,l:vector;
                      var out:boolean);
  var r2,r2xy:real;
begin                { gibt Zeitpunkt n an, zu dem |fmap^n(z,l)|>r }
r2:=sqr(r);          { wenn n=numits, wird fmap^n(z,l) als beschr„nkt }
n:=-1;               { angenommen }
out:=false;
repeat
  n:=n+1;              { Fluchtzeit }
  r2xy:=sqr(z[1])+sqr(z[2]);
  fmap(z,l);           { z->z^2-l }
  until ((r2xy>r2) or (n>numits));
out:=n<=numits;        { Fluchtzeit(z)=n }
end;  {pointescape}



procedure grid;  {�berdeckt das Einheitsquadrat mit Koordinatenlinien}
  var i:integer;
begin            {im Graphmodus}
setcolor(3);  {t�rkis}
for i:=-10 to 20 do
  begin
  line(bildx(links,rechts,i/10),y0,bildx(links,rechts,i/10),y1);
  if i mod 5 = 0 then
    xpnumberxy(i/10,3,1,bildx(links,rechts,i/10)-12,y1-2*height,xarr,3);
  end; {i-Schleife}
for i:=0 to 10 do
  begin
  line(bildx(links,rechts,-1),bildy(unten,oben,i/10),
       bildx(links,rechts,2),bildy(unten,oben,i/10));
  xpnumberxy(i/10,3,1,2*x1-x0+width,bildy(unten,oben,i/10),xarr,3);
  end;  {i-Schleife}
setcolor(1);  {blau}
end;  {grid}

procedure grid1;    {Koordinatenlinien f�r Detailaufnahme}
  var scale,yi,xi,step,xstep,ystep:integer;
      realyi,realxi,factor:real;
begin
scale:=0;
factor:=1;
repeat    {das Schirmbild wird im Maástab 10^scale>=1/factor vergr”áert}
 scale:=scale+1;      {von unten bis oben sind es mehr als 10 Einheiten}
 factor:=factor/10;                         {der GrӇe factor=10^-scale}
 until (oben-unten)/factor>10;
setcolor(7);
step:=round((oben-unten)/factor) div 10; {ganzzahliges Zehntel der Bildh”he}
ystep:=round(step*factor*maxy/(oben-unten));
xstep:=round(step*factor*maxx/(rechts-links));
i:=0;
repeat
  i:=i+1; { z„hlt die ganzzahligen H”hen-Vielfachen der Einheit step*factor}
  realyi:=(round(unten/factor)+i*step)*factor;
  yi:=bildy(unten,oben,realyi);          { ausgegebene H”he im Schirmbild }
  line(2*width,yi,maxx-6*width,yi);      { Horizontallinie in H”he yi }
  xpnumberxy(realyi,10,7,70*width,yi,xarr,7);
  until yi<2*ystep;
i:=0;
repeat
  i:=i+1;       { z„hlt die ganzzahlingen Horizontalvielfachen der Einheit}
  realxi:=(round(links/factor)+i*step)*factor;              { step*factor }
  xi:=bildx(links,rechts,realxi);    { ausgegebene Abszisse im Schirmbild }
  line(xi,2*height,xi,maxy-3*height);     { Vertikallinie mit Abszisse xi }
  if i mod 3 = 2 then xpnumberxy(realxi,10,7,xi-5*width,height,xarr,7);
  until xi>maxx-2*xstep;
setcolor(1);
end;  {grid1}

procedure verhulst;
  var n,m,xx,y:integer;
      x,l:real;
begin
clearwindow(0,0,maxx,y0);
axes(7);
m:=bildy(unten,oben,1/2);
setcolor(4);
line(width,m,maxx-width,m);
xpnumberxy(1,1,0,x0-width,m-height,xarr,4);
xpnumberxy(0,1,0,x0-width,y0-height,xarr,4);
for xx:=bildx(links,rechts,-0.25) to bildx(links,rechts,2) do
  begin
  n:=0;
  x:=0;
  l:=links+xx*(rechts-links)/maxx;
  repeat
    n:=n+1;
    x:=x*x-l;
    if n>5000 then
      begin
      y:=bildy(unten,oben,-x/2);
      putpixel(xx,y,4);
      end;  {n>5000}
    until n=5120;
  end;  {xx-Schleife}
end;  {verhulst}

procedure screen(var links,rechts,unten,oben,r:real;var numits:integer);
  var lo,ru:vector;               { Wahl eines Fensters }
      xlo,ylo,xru,yru:integer;
begin
setcolor(7);
repeat
  repeat
    gotoxy(0,0);
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('Eckpunkt links oben:lo[1]=',width,maxy-2*height,xarr,7);
    readrsafe(lo[1]);        {Eingabe von lo[1]}
    xpnumberxy(lo[1],10,7,27*width,maxy-2*height,xarr,7);
    xlo:=bildx(links,rechts,lo[1]);
    setcolor(4);
    line(xlo,3*height,xlo,maxy-3*height);
    setcolor(7);
    xptextxy(',lo[2]=',37*width,maxy-2*height,xarr,7);
    readrsafe(lo[2]);        {Eingabe von lo[2]}
    xpnumberxy(lo[2],10,7,44*width,maxy-2*height,xarr,7);
    ylo:=bildy(unten,oben,lo[2]);
    setcolor(4);
    line(3*width,ylo,maxx-3*width,ylo);
    setcolor(7);
    abfrage(' akzeptabel',doit);
    if not doit then               {Fenster-Randlinien werden weiá gel”scht}
      begin
      setcolor(15);
      line(xlo,3*height,xlo,maxy-3*height);
      line(3*width,ylo,maxx-3*width,ylo);
      setcolor(7);
      end;
    until doit;
  repeat
    gotoxy(0,0);
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('Eckpunkt rechts unten:ru[1]=',width,maxy-2*height,xarr,7);
    readrsafe(ru[1]);        {Eingabe von ru[1]}
    xpnumberxy(ru[1],10,7,29*width,maxy-2*height,xarr,7);
    ru[2]:=lo[2]-(ru[1]-lo[1])*3/4;
    xptextxy(',ru[2]=',39*width,maxy-2*height,xarr,7);
    xpnumberxy(ru[2],10,7,46*width,maxy-2*height,xarr,7);
    xru:=bildx(links,rechts,ru[1]);
    yru:=bildy(unten,oben,ru[2]);
    setcolor(4);
    line(xru,3*height,xru,maxy-3*height);
    line(3*width,yru,maxx-3*width,yru);
    setcolor(7);
    abfrage(' akzeptabel',doit);
    if not doit then      {Fenster-Randlinien werden weiá gel”scht}
      begin
      setcolor(15);
      line(xru,3*height,xru,maxy-3*height);
      line(3*width,yru,maxx-3*width,yru);
      setcolor(7);
      end;
    until doit;
  clearwindow(0,maxy-2*height,maxx,maxy);
  abfrage(' Fenster akzeptabel',doit);
  until doit;
  if not doit then
    begin
    setcolor(15);
    line(xlo,3*height,xlo,maxy-3*height);
    line(3*width,ylo,maxx-3*width,ylo);
    line(xru,3*height,xru,maxy-3*height);
    line(3*width,yru,maxx-3*width,yru);
    setcolor(7);
    end;
repeat
  clearwindow(0,maxy-3*height,maxx,maxy);
  xptextxy('Fluchtradius r = ',width,maxy-2*height,xarr,7);
  readrsafe(r);        {Eingabe von r}
  xpnumberxy(r,2,0,17*width,maxy-2*height,xarr,7);
  xptextxy('; maximale Iterationszahl numits = ',19*width,maxy-2*height,
    xarr,7);
  read(numits);        {Eingabe von numits}
  xpnumberxy(numits,2,0,54*width,maxy-2*height,xarr,7);
  abfrage(' akzeptabel',doit);
  until doit;
links:=lo[1];
rechts:=ru[1];
unten:=ru[2];
oben:=lo[2];
end;  {screen}

procedure infoscreen(links,rechts,unten,oben,r:real;numits:integer;
                     color:word);
begin          { Ausgabe der Schirmbilddaten im Graphmodus}
clearwindow(0,maxy-3*height,maxx,maxy);
xptextxy('x:',width,maxy-2*height,xarr,color);
xpnumberxy(links,10,7,3*width,maxy-2*height,xarr,color);
xptextxy(',',13*width,maxy-2*height,xarr,color);
xpnumberxy(rechts,10,7,14*width,maxy-2*height,xarr,color);
xptextxy(';y:',24*width,maxy-2*height,xarr,color);
xpnumberxy(unten,10,7,27*width,maxy-2*height,xarr,color);
xptextxy(',',37*width,maxy-2*height,xarr,color);
xpnumberxy(oben,10,7,38*width,maxy-2*height,xarr,color);
xptextxy(';r=',48*width,maxy-2*height,xarr,color);
xpnumberxy(r,2,0,51*width,maxy-2*height,xarr,color);
xptextxy(';n=',53*width,maxy-2*height,xarr,color);
xpnumberxy(numits,4,0,56*width,maxy-2*height,xarr,color);
xptextxy('weiter...Taste',65*width,maxy-2*height,xarr,color);
end;  {infoscreen}

procedure savescreen(var dat:screendat;var par:screenpar;filename:string;
          links,rechts,unten,oben:real); { Abspeicherung des Bildschirmes }
  var color:word;
      i,j:integer;
begin
assign(dat,filename+'dat');
assign(par,filename+'par');
rewrite(dat);                 { Pixeldatei ”ffnen }
rewrite(par);                 { Parameterdatei ”ffnen }
for i:=0 to maxx do
  for j:=0 to maxy do
    begin
    color:=getpixel(i,j);
    write(dat,color);         { Pixel abspeichern }
    end;
close(dat);                   { Pixeldatei schlieáen }
write(par,links);             { Parameter abspeichern }
write(par,rechts);
write(par,unten);
write(par,oben);
close(par);                  { Parameterdatei schlieáen }
end;  {savescreen}

procedure apfeldetail(numits:integer;anfang,ende,boden,dach,r:real;
                      symm,col,det:boolean;var color:word);
  var i,j,n,xa,ya,xe,ye,nm:integer;
    l:vector;
    ch:char;
begin                             { Wiedergabe des Apfelm„nnchens }
xa:=bildx(links,rechts,anfang);   { im Rechteck [anfang,ende]x[unten,oben] }
if xa<=2*width then xa:=2*width;
xe:=bildx(links,rechts,ende);
if xe>=maxx-2*width then xe:=maxx-2*width;
ye:=bildy(unten,oben,boden);
if ye>=maxy-2*height then ye:=maxy-2*height;
ya:=bildy(unten,oben,dach);
if ya<=2*height then ya:=2*height;
if not (symm or det) then
  begin
  xa:=xa+2*width;
  xe:=xe-2*width;
  ye:=ye-2*height;
  ya:=ya+2*height;
  end;  {not symm}
if det then clearwindow(xa,ya,xe,ye) {Detail in h”herer Aufl”sung }
  else clearviewport;
for i:=xa to xe do                  { Ausgabe mit neuem r, numits }
  begin                             { des durch Anfang, Ende, Boden, Dach }
  for j:=ya to ye do                { begrenzten Details }
    begin
    coord(i,j,l);                   { Ebenen-Koordinaten des Pixels (i,j) }
    zeroescape(r,n,numits,l,out);   { n = Fluchtzeit von 0 unter f(z)=z^2-l }
    if col then                     { Fluchzeitfarben }
      begin
      if out then nm:=nmod16(n)     { Fluchtzeit-Einf„rbung von (i,j) mit }
        else nm:=0;                 { Farbe nmod16(n) }
      putpixel(i,j,nm);
      if symm then
        putpixel(i,2*y0-j,nm);      { Symmetriepunkt unter reeller Achse }
      end  { col }
      else                          { einf„rbig }
        if not out then             { 0-Orbit ist beschr„nkt }
          begin
          putpixel(i,j,1);          { Einf„rbung von (i,j) blau }
          if symm then
            putpixel(i,2*y0-j,1);   { Symmetriepunkt unter reeller Achse }
          end;  { not out }         { einf„rbig }
    end;  {j-Schleife}
  end;  {i-Schleife}
if col then color:=15                { weiá }
  else color:=7;                     { grau }
infoscreen(links,rechts,unten,oben,r,numits,color);
ch:=readkey;             { Ausgabe der Schirmbild-Daten am unteren Rand }
end;  {apfeldetail}

procedure choice(var chc:char;symm:boolean); { Grafik-Menu }
begin
clearwindow(0,maxy-3*height,maxx,maxy);
if (symm and (chc='a')) then
  xptextxy(
  'Detail d,Verhulst v,Julia j,Fenster f,Speicher s,Farbschalter c,Menu m',
    3*width,maxy-2*height,xarr,7)
  else xptextxy(
    'Detail d,Apfel a,Julia j,Fenster f,Speicher s,Farbschalter c,Menu m',
    3*width,maxy-2*height,xarr,7);
repeat chc:=readkey until chc in ['d','v','a','f','j','s','c','m','x'];
end;  {choice}

procedure detailscreen(var anfang,ende,boden,dach,r:real;var numits:integer);
  var xlo,ylo,xru,yru:integer;      { Wahl eines Detail-Fensters }
      lo,ru:vector;
begin
setcolor(7);
repeat
  repeat
    gotoxy(0,0);
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('Anfang = ',width,maxy-2*height,xarr,7);
    readrsafe(lo[1]);        {Eingabe von anfang}
    xpnumberxy(lo[1],8,5,10*width,maxy-2*height,xarr,7);
    xlo:=bildx(links,rechts,lo[1]);
    setcolor(4);
    line(xlo,3*height,xlo,maxy-3*height);   { Ausgabe linke Grenze in rot }
    setcolor(7);
    xptextxy(', Dach = ',17*width,maxy-2*height,xarr,7);
    readrsafe(lo[2]);        {Eingabe von dach}
    xpnumberxy(lo[2],8,5,26*width,maxy-2*height,xarr,7);
    ylo:=bildy(unten,oben,lo[2]);
    setcolor(4);
    line(3*width,ylo,maxx-3*width,ylo);     { Ausgabe obere Grenze in rot }
    setcolor(7);
    abfrage(' akzeptabel',doit);
    if not doit then                        { alte Grenzlinien l”schen }
      begin
      line(xlo,3*height,xlo,maxy-3*height);
      line(3*width,ylo,maxx-3*width,ylo);
      end;  { not doit}
    until doit;
  repeat
    gotoxy(0,0);
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('Ende = ',width,maxy-2*height,xarr,7);
    readrsafe(ru[1]);        {Eingabe von ende}
    xpnumberxy(ru[1],8,5,7*width,maxy-2*height,xarr,7);
    xru:=bildx(links,rechts,ru[1]);
    setcolor(4);                         { Ausgabe rechte Grenzlinie in rot }
    line(xru,3*height,xru,maxy-3*height);
    setcolor(7);
    xptextxy(', Boden = ',14*width,maxy-2*height,xarr,7);
    readrsafe(ru[2]);        {Eingabe von boden}
    xpnumberxy(ru[2],8,5,24*width,maxy-2*height,xarr,7);
    yru:=bildy(unten,oben,ru[2]);
    setcolor(4);                         { Ausgabe untere Grenzlinie in rot }
    line(3*width,yru,maxx-2*width,yru);
    setcolor(7);
    abfrage(' akzeptabel',doit);
    if not doit then
      begin
          { alte Grenzlinien l”schen }
      line(xru,3*height,xru,maxy-3*height);
      line(3*width,yru,maxx-2*width,yru);
      end;  {not doit}
    until doit;
  abfrage('Fenster akzeptabel',doit);
  until doit;
setcolor(7);                             { Begrenzungslinien l”schen }
line(xlo,3*height,xlo,maxy-3*height);
line(3*width,ylo,maxx-3*width,ylo);
line(xru,3*height,xru,maxy-3*height);
line(3*width,yru,maxx-2*width,yru);
anfang:=lo[1];
ende:=ru[1];
boden:=ru[2];
dach:=lo[2];
clearwindow(0,maxy-3*height,maxx,maxy);    { Informationsausgabe unten }
xptextxy('Fluchtradius r = ',width,maxy-2*height,xarr,7);
readrsafe(r);        {Eingabe von r}
xpnumberxy(r,2,0,17*width,maxy-2*height,xarr,7);
xptextxy('; maximale Iterationszahl numits = ',
            19*width,maxy-2*height,xarr,7);
read(numits);        {Eingabe von numits}
xpnumberxy(numits,2,0,54*width,maxy-2*height,xarr,7);
end;  {detailscreen}

procedure blinkkreuz(z:vector;color1,color2:word);
  var xpix,ypix:integer;
begin
reset(input);
pixel(z,xpix,ypix);
repeat
  kreuz(xpix,ypix,color1);
  delay(600);
  kreuz(xpix,ypix,color2);
  delay(600);
  until keypressed;
end;  {blinkkreuz}

procedure showkreuz(w:vector;color:word);
  var xpix,ypix:integer;
begin
pixel(w,xpix,ypix);
kreuz(xpix,ypix,color);
end;  { showkreuz }

procedure jwahl(var l:vector;links,rechts,oben,unten:real);
  var abs:real;                  {Wahl des Vektors l in f(z)=z^2-l}
      nr:integer;
begin                            {in Graphmode als Punkt der Zahlenebene}
grid1;
repeat
  setcolor(7);
  clearwindow(0,maxy-3*height,maxx,maxy);
  gotoxy(0,0);
  xptextxy('c[1] = ',width,maxy-3*height,xarr,7);
  readrsafe(l[1]);        {Eingabe von l[1]}
  xpnumberxy(l[1],8,6,8*width,maxy-3*height,xarr,7);
  xptextxy('; c[2] = ',16*width,maxy-3*height,xarr,7);
  readrsafe(l[2]);        {Eingabe von l[2]}
  xpnumberxy(l[2],8,6,23*width,maxy-3*height,xarr,7);
  xptextxy('akzeptabel? (j/n)',60*width,maxy-3*height,xarr,7);
  blinkkreuz(l,3,12);
  repeat ch:=readkey until ((ch='j') or (ch='n'));
  clearwindow(0,maxy-3*height,maxx,maxy);
  if ch='n' then
    showkreuz(l,15);
  until ch='j';
end;  {jwahl}

function absz(z:vector):real;           {Absolutbetrag |z| von z}
var r2:real;
begin
r2:=sqr(z[1])+sqr(z[2]);
if r2=0 then absz:=0
  else absz:=sqrt(r2);
end;  { absz }

procedure complexroot(var z,w:vector);  { berechtnet w=sqrt(z) }
  var xl,yl,radx,rady:real;             { mit positiver w[1]=Re(w) }
begin
xl:=z[1];
yl:=z[2];
radx:=xl+sqrt(sqr(xl)+sqr(yl));
rady:=-xl+sqrt(sqr(xl)+sqr(yl));
if radx>0 then w[1]:=sqrt(radx/2)     { Verhinderung von Laufzeitfehlern }
  else w[1]:=0;                       { infolge Wurzel aus negativer Zahl }
if rady>0 then w[2]:=sqrt(rady/2)
  else w[2]:=0;
if yl<0 then w[2]:=-w[2];
end;    {complexroot}

procedure fixpoints(var l:vector;var fix:zarray);
  var rad,root:vector;      {Fixpunkte und Periode 2-Punkte von f}
begin
rad[1]:=1+4*l[1];           {rad = Radikand f�r Fixpunkte}
rad[2]:=4*l[2];
complexroot(rad,root);
fix[1,1]:=(1+root[1])/2;    {Fixpunkte}
fix[1,2]:=root[2]/2;
fix[2,1]:=(1-root[1])/2;
fix[2,2]:=-root[2]/2;
rad[1]:=4*l[1]-3;           {rad = Radikand f�r Periode 2 - Punkte}
rad[2]:=4*l[2];
complexroot(rad,root);
fix[3,1]:=(-1+root[1])/2;   {Periode 2 Orbitpunkte}
fix[3,2]:=root[2]/2;
fix[4,1]:=(-1-root[1])/2;
fix[4,2]:=-root[2]/2;
end;  {fixpoints}

procedure juliainfo(l:vector;r:real;n:integer;var fix:zarray);
  var z,z1,z2,z3,z4:vector;
  strl1,strl2,strz11,strz12,strz21,strz22,strz31,strz32,strz41,strz42,
  strz1p,strz2p,strz3p,strr,strn:string;
begin
fixpoints(l,fix);
z1:=fix[1];
z2:=fix[2];
z3:=fix[3];
z4:=fix[4];
showkreuz(l,7);                { Ausgabe der Funktionskonstante in grau}
showkreuz(z1,4);               { Graphikausgabe der Fixpunkte in rot}
showkreuz(z2,4);
showkreuz(fix[3],2);           { Ausgabe der 2-er Periode in 3}
showkreuz(fix[4],2);
axes(7);
ch:=readkey;
str(l[1]:7:4,strl1);
str(l[2]:7:4,strl2);
str(z1[1]:7:4,strz11);
str(z1[2]:7:4,strz12);
str(z2[1]:7:4,strz21);
str(z2[2]:7:4,strz22);
str(z3[1]:7:4,strz31);
str(z3[2]:7:4,strz32);
str(z4[1]:7:4,strz41);
str(z4[2]:7:4,strz42);
str(2*absz(z1):6:4,strz1p);
str(2*absz(z2):6:4,strz2p);
str(4*absz(z3)*absz(z4):6:4,strz3p);
str(r:3:1,strr);
str(n,strn);
z:=z1;
if 2*absz(z1)<=1 then z:=z2;   { Wahl eines abstoáenden Fixpunktes }
clearwindow(0,0,maxx,8*height);
setcolor(7);
xptextxy('c=('+strl1+','+strl2+');',10*width,height,xarr,7);
xptextxy('r='+strr+';',40*width,height,xarr,7);
xptextxy('n='+strn,50*width,height,xarr,7);
setcolor(4);
xptextxy('Fixpunkte:',10*width,2*height,xarr,4);
xptextxy('z1=('+strz11+','+strz12+'); abs f''(z1)='+strz1p,10*width,
  3*height,xarr,4);
if 2*absz(z1)<1 then xptextxy(' attraktiv',55*width,3*height,xarr,4);
xptextxy('z2=('+strz21+','+strz22+'); abs f''(z2)='+strz2p,10*width,
  4*height,xarr,4);
if 2*absz(z2)<1 then
  xptextxy('attraktiv',55*width,4*height,xarr,4);
setcolor(2);
xptextxy('Orbit mit Periode 2:',10*width,5*height,xarr,2);
xptextxy(
  'z3=('+strz31+','+strz32+'); abs fý''(z3)=abs fý''(z4) ='+strz3p,
  10*width,6*height,xarr,2);
xptextxy('z4=('+strz41+','+strz42+')',10*width,7*height,xarr,2);
if 4*absz(z3)*absz(z4)<1 then xptextxy('attraktiv',45*width,7*height,
  xarr,2);
end;  {juliainfo}

procedure grafinfo(l:vector;fix:zarray);
  var i:integer;
      ch:char;
begin
axes(7);
showkreuz(l,7);
for i:=1 to 2 do
  showkreuz(fix[i],4);                {Fixpunkte}
for i:=3 to 4 do
  showkreuz(fix[i],2);               {Orbit mit Periode 2}
xptextxy('grid (j/n)?',width,maxy-2*height,xarr,7);
repeat ch:=readkey until ch in ['j','n'];
if ch='j' then  grid;
end;  {grafinfo}

procedure paint(numits,minxpaint,maxxpaint,minypaint,maxypaint:integer;
                r:real);
  var i,j,n:integer;    {f„rbt Pixelpunkt nach Fluchtzeit}
      x,y:real;
      out:boolean;
      ch:char;
begin
setbkcolor(0);
bild('f',links,rechts,unten,oben,x0,y0,x1,y1);
for i:=minxpaint to maxxpaint do
  for j:=minypaint to maxypaint do
    begin
    coord(i,j,l);       { (i,j) sind Pixelkoordinaten des Punktes l }
    zeroescape(r,n,numits,l,out); { Berechnung der Fluchtzeit(0)=n f�r z^2-l}
    if out then putpixel(i,j,nmod16(n))  { Einf„rbung von (i,j) mit }
      else putpixel(i,j,0);              { Farbe nmod16(n) oder schwarz}
    end;  {j-Schleife}
clearwindow(0,maxy-2*height,maxx,maxy);
xptextxy('Taste',70*width,maxy-height,xarr,15);
ch:=readkey;
setbkcolor(15);
end;  {paint}

procedure paintjulia(numits,minxpaint,maxxpaint,minypaint,maxypaint:integer;
                     r:real;l:vector);
  var i,j,n:integer;    {f„rbt Pixelpunkt nach Fluchtzeit}
      z:vector;
      out:boolean;
      ch:char;
begin
setbkcolor(15);
for i:=minxpaint to maxxpaint do
  for j:=minypaint to maxypaint do
    begin
    coord(i,j,z);     { (i,j) sind Pixelkoordinaten des Punktes z }
    pointescape(r,n,numits,z,l,out);       { Fluchtzeit(x,y)=n f�r z^2-l }
    if out then putpixel(i,j,nmod16(n))    { Einf„rbung von (i,j) mit }
      else putpixel(i,j,1);               { Farbe nmod16(n) oder schwarz}
    end;  {j-Schleife}
ch:=readkey;
clearwindow(0,maxy-2*height,maxx,maxy);
xptextxy('Info (j/n) ?',70*width,maxy-height,xarr,7);
repeat ch:=readkey until ch in ['j','n'];
if ch='j' then
  begin
  clearwindow(0,maxy-2*height,maxx,maxy);
  juliainfo(l,r,numits,fix);
  grafinfo(l,fix);
  end;
clearwindow(0,maxy-2*height,maxx,maxy);
xptextxy('Taste',70*width,maxy-height,xarr,7);
ch:=readkey;
end;  {paintjulia}

procedure juliamenge(r:real;numits:integer;l:vector;fix:zarray);
  var i,j,n:integer;
      anfang,ende,x,y:real;
      z:vector;
begin
bild('j',links,rechts,unten,oben,x0,y0,x1,y1);
juliainfo(l,r,numits,fix);
for i:=bildx(links,rechts,-2) to bildx(links,rechts,2) do
  for j:=bildy(unten,oben,1.5) to bildy(unten,oben,-1.5) do
    begin
    coord(i,j,z);
    pointescape(r,n,numits,z,l,out);
    if not out then
      begin
      putpixel(i,j,1);
      end;
    end;  {j-Schleife}
grafinfo(l,fix);
end;  {juliamenge}

procedure zwahl(var z:vector;var doit:boolean);
  var abs:real;                  {Wahl des Anfangs-Vektors z in f(z)=z^2-l}
      z1,z2:string;        {in Graphmode als Punkt der Zahlenebene}
begin
setcolor(7);
abfrage('Ausgabe eines Orbits?',doit);
if doit then
  begin
  clearwindow(0,maxy-2*height,maxx,maxy);
  repeat
    xptextxy('Orbit-Anfang z:',width,maxy-2*height,xarr,7);
    xptextxy('z[1] =',16*width,maxy-2*height,xarr,7);
    readrsafe(z[1]);        {Eingabe von z[1]}
    xpnumberxy(z[1],4,2,23*width,maxy-2*height,xarr,7);
    xptextxy(', z[2] = ',27*width,maxy-2*height,xarr,7);
    readrsafe(z[2]);        {Eingabe von z[2]}
    xpnumberxy(z[2],4,2,36*width,maxy-2*height,xarr,7);
    xptextxy('akzeptabel?',60*width,maxy-2*height,xarr,7);
    blinkkreuz(z,14,9);
    repeat ch:=readkey until ((ch='j') or (ch='n'));
    clearwindow(0,maxy-2*height,maxx,maxy);
    if ch='j' then
      begin
      str(z[1]:4:2,z1);
      str(z[2]:4:2,z2);
      xptextxy('z=('+z1+';'+z2+')',width,maxy-2*height,xarr,7);
      end  {'j'}
        else showkreuz(z,1);
    until ch='j';
  end {doit}
  else clearwindow(0,maxy-2*height,maxx,maxy);
end;  {zwahl}

procedure attcycle(l,z:vector;var n1:longint);
{Bildschirmausgabe eines attraktiven Zykels f�r f(z)=z^2-l mit Anfangswert z}
  var zold,zdif,z0:vector;
      x,y,i,na:integer;
      n:longint;
      ch:char;
      rand,innenfarbe:boolean;
      nstring:string;
      color,ocolor:word;
begin
z0:=z;
n:=0;
n1:=10000;
na:=10000;    {Vorgabe unverdeckte Anfangsschritte}
color:=11;
ocolor:=11;
clearwindow(0,maxy-3*height,maxx,maxy);
setcolor(7);
xptextxy('Anzahl der unverdeckten Anfangs-Schritte:',
          width,maxy-2*height,xarr,7);
     {xpnumberxy(na,5,0,42*width,maxy-2*height,xarr,7);}
readln(na);
clearwindow(42*width,maxy-2*height,maxx,maxy);
xpnumberxy(na,5,0,42*width,maxy-2*height,xarr,7);
ch:=readkey;
clearwindow(0,maxy-2*height,maxx,maxy);
   { xptextxy('mit oder ohne Innenfarbe (m/o) ?',width,maxy-2*height,xarr,7);
    repeat ch:=readkey until ch in ['m','o'];
    innenfarbe:=ch='m';
    clearwindow(0,maxy-2*height,maxx,maxy);}
ch:='e';
   {xptextxy('Einzelschritt oder Orbit (e/o) ?',width,maxy-2*height,xarr,7);
    repeat ch:=readkey until ch in ['e','o'];
    clearwindow(0,maxy-2*height,maxx,maxy);}
xptextxy('Kreuzfarbe:',width,maxy-2*height,xarr,7);
    {xpnumberxy(color,2,0,13*width,maxy-2*height,xarr,7);}
readln(color);
clearwindow(13*width,maxy-2*height,maxx,maxy);
xpnumberxy(color,2,0,13*width,maxy-2*height,xarr,7);
    {xptextxy(', Innenfarbe:',15*width,maxy-2*height,xarr,7);
    xpnumberxy(ocolor,2,0,30*width,maxy-2*height,xarr,7);
    readln(ocolor);
    clearwindow(30*width,maxy-2*height,maxx,maxy);
    xpnumberxy(ocolor,2,0,30*width,maxy-2*height,xarr,7);}
z:=z0;
repeat
  n:=n+1;
  fmap(z,l);
  x:=bildx(links,rechts,z[1]);
  y:=bildy(unten,oben,z[2]);
  if ((n<na) or (ch='e')) then
    if innenfarbe then okreuz(x,y,color,ocolor)
      else kreuz(x,y,color);
  if (n>n1) then okreuz(x,y,color,ocolor);
  if ch='e' then
    begin
    clearwindow(0,maxy-2*height,maxx,maxy);
    xptextxy('Einzelschritt oder Orbit (e/o) ?',width,maxy-2*height,xarr,7);
    repeat ch:=readkey until ch in ['e','o'];
    end;  {ch='e'}
  rand:=((x<0) or (x>maxx) or (y<0) or (y>maxy));
  until ((n=n1+1000) or rand);           {n=11000, z=f^n(z0)}
repeat
  n:=n+1;
  fmap(z,l);
  x:=bildx(links,rechts,z[1]);
  y:=bildy(unten,oben,z[2]);
  if (n>n1) then putpixel(x,y,ocolor);
  rand:=((x<0) or (x>maxx) or (y<0) or (y>maxy));
  until ((n=n1+2000) or rand);             {n=12000, z=f^n(z0)}
if rand then
  begin
  clearwindow(0,maxy-3*height,maxx,maxy);
  str(n,nstring);
  xptextxy('n='+nstring+'; Rand�berschreitung',width,maxy-2*height,xarr,7);
  ch:=readkey;
  end {rand}
  else begin
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('Ausgabe der approximativen Perioden-Punkte (j/n) ?',
              30*width,maxy-2*height,xarr,7);
    repeat ch:=readkey until ch in ['j','n'];
    clearwindow(0,maxy-3*height,maxx,maxy);
    if ch='j' then
      begin
      n:=0;
      zold:=z;
      repeat
        n:=n+1;
        fmap(z,l);
        zdif[1]:=z[1]-zold[1];
        zdif[2]:=z[2]-zold[2];
        until ((absz(zdif)<1E-5) or (n>=1000));
      str(n,nstring);
      if n<=98 then
        begin
        xptextxy('Periodenl„nge: '+nstring+'; <Taste>',
                  width,maxy-3*height,xarr,7);
        repeat
          z:=zold;
          for i:=1 to n do
            begin
            fmap(z,l);
            clearwindow(0,maxy-2*height,maxx,maxy);
            xptextxy('i = ',width,maxy-2*height,xarr,7);
            xpnumberxy(i,3,0,4*width,maxy-2*height,xarr,7);
            xptextxy('z = (',8*width,maxy-2*height,xarr,7);
            xpnumberxy(z[1],8,5,13*width,maxy-2*height,xarr,7);
            xptextxy(',',21*width,maxy-2*height,xarr,7);
            xpnumberxy(z[2],8,5,22*width,maxy-2*height,xarr,7);
            xptextxy(')',30*width,maxy-2*height,xarr,7);
            blinkkreuz(z,3,12);
            ch:=readkey;
            end;  {i-Schleife}
            xptextxy('Nochmals Ausgabe der Perioden-Punkte (j/n) ?',
              35*width,maxy-2*height,xarr,7);
          repeat ch:=readkey until ch in ['j','n'];
          until ch='n';
        end {n<=98}
        else begin
          xptextxy('unzureichende Konvergenz - Taste',width,maxy-3*height,
                        xarr,7);
          ch:=readkey;
          end;  {n>100}
      clearwindow(0,maxy-3*height,maxx,maxy);
      end;  {ch='j'}
    end;  {not rand}
end;  {attcycle}

procedure julia(r,links,rechts,unten,oben:real;numits:integer;l:vector);
  var fix:zarray;
      z:vector;
      n1:longint;
      doit:boolean;
begin
grid1;
jwahl(l,links,rechts,unten,oben);
repeat
  cleardevice;
  juliamenge(r,numits,l,fix);
  setcolor(7);
  zwahl(z,doit);
  if doit then attcycle(l,z,n1);
  abfrage(' Neuer Orbit',doit);
  until not doit;
end;  {Julia}

procedure saveapfel(var dat:screendat;var recpar:apfelpar;
                    links,rechts,unten,oben,r:real;numits:integer;l:vector;
                    col,more:boolean);
  var color:word;             { Abspeicherung eines Apfel-Bildschirmes }
      i,j,nr,n:integer;
      arec:apfelrec;
      st:string;
begin
clearwindow(0,maxy-3*height,maxx,maxy);
nr:=0;
assign(recpar,'apar');                 { Parameterdatei ”ffnen }
if more then               { Weiterf�hrung der bestehenden Parameterdatei }
  begin
  reset(recpar);
  nr:=filesize(recpar);
  str(nr,st);              { Vorschlag: Abspeicherung am Datei-Ende }
  xptextxy('Speicherung unter Dateinummer '+st+' (j/n)?',width,maxy-2*height,
    xarr,7);
  repeat ch:=readkey until ch in ['j','n'];
  if ch='n' then
    begin             { Vorbereitung: Abspeicherung unter gew„hlter Nummer }
      repeat
        clearwindow(0,maxy-3*height,maxx,maxy);
        xptextxy('Eingabe der Dateinummer:',width,maxy-2*height,xarr,7);
        repeat read(n) until n<=nr;
        str(n,st);
        xptextxy('akzeptabel (j/n)?',26*width,maxy-2*height,xarr,7);
        repeat ch:=readkey until ch in ['j','n'];
        until ch='j';
      nr:=n;
      end;  {ch='n'}
  seek(recpar,nr);                 { Zeiger auf Eingabestelle }
  end  {more}
  else rewrite(recpar);            { Neubildung der Parameterdatei }
infoscreen(links,rechts,unten,oben,r,numits,7);
with arec do        { Ausgabe der Schirmbild-Daten am unteren Rand }
  begin                    { Konstruktion des Parameter-Records }
  name:='apf'+st;
  if col then farbtyp:='f'
    else farbtyp:='e';     { e:einf„rbig;f:fluchtzeiten;a:anziehung }
  li:=links;
  re:=rechts;
  un:=unten;
  ob:=oben;
  rad:=r;
  num:=numits;           { maximale Fluchtzeit }
  vec:=zero;
  end;  { with arec }
write(recpar,arec);                      { Eingabe des Parameter-Records }
close(recpar);
assign(dat,'apf'+st+'dat');
rewrite(dat);                       { ™ffnung der Schirmbild-Pixel-Datei }
for i:=0 to maxx do
  for j:=0 to maxy do
    begin
    color:=getpixel(i,j);
    write(dat,color);               { Eingabe der Pixel-Farbe }
    end;
close(dat);
end;   { saveapfel }

procedure apfelmaennchen(r:real;numits:integer;col:boolean;chm:char);
  var i,j,n:integer;
      anfang,ende,boden,dach:real;
      l:vector;      { Parameter-Vektor f�r f(z)=z^2-l }
      symm,det:boolean;  { Signal f�r vertikal-symmetrische Grafik }
begin                    { einf„rbige Wiedergabe des Apfelm„nnchens }
bild('a',links,rechts,unten,oben,x0,y0,x1,y1);
anfang:=-1.5;            { Wiedergabebeginn links }
ende:=2.4;               { Wiedergabeende rechts }
dach:=1.5;               { h”chste Grafik-H”he }
boden:=0;
symm:=true;
det:=false;
chc:='a';                 { Wiedergabe des Apfelm„nnchens }
repeat
  if col then             { Ausgabe von Fluchtzeitfarben }
    begin
    setbkcolor(0);        { schwarz }
    setcolor(7);          { grau }
    end  { col=true }
    else begin
      setbkcolor(15);     { weiá }
      setcolor(1);        { blau }
      end;  { col=false }
  if not det then clearviewport; {keine Detailerg„nzung, volle Neuausgabe}
  apfeldetail(numits,anfang,ende,boden,dach,r,symm,col,det,color);
  if not (chm in ['m','j','i']) then
    repeat
      choice(chc,symm);
      case chc of
        'v':verhulst;
        'd':begin                             { Neuausgabe eines Details}
          det:=true;
          if symm then grid else grid1;       { Gitternetzlinien }
          detailscreen(anfang,ende,boden,dach,r,numits);
          end;  {'d'}
        'f':begin                             { Wiedergabe eines Fensters }
          if symm then grid else grid1;       { Gitternetzlinien }
          screen(links,rechts,unten,oben,r,numits);
          anfang:=links;
          ende:=rechts;
          boden:=unten;
          dach:=oben;
          symm:=false;
          end; {'f'}
        'j':julia(r,links,rechts,unten,oben,numits,l);
        'a':begin              { Wiedergabe des Apfelm„nnchens }
          bild('a',links,rechts,unten,oben,x0,y0,x1,y1);
          anfang:=-1;          { Wiedergabebeginn links }
          ende:=2;             { Wiedergabeende rechts }
          dach:=1.5;           { h”chste Grafik-H”he }
          boden:=0;
          symm:=true           { Verwendung der Vertikal-Symmetrie }
          end;  {'a'}
        'c':col:=not col;      { Schalter: Fluchtzeitfarbe oder einf„rbig }
        's':saveapfel(dat,recpar,links,rechts,unten,oben,r,numits,l,col,true);
        'x':axes(7);
        end;  {case chc}
      until chc in ['d','f','a','m','c']  { 'd','f','a': neues apfeldetail }
    else chc:='m';  {chm in ['j','i']}
    until chc='m';
bild('a',links,rechts,unten,oben,x0,y0,x1,y1);
setbkcolor(15);
end;  {apfelm„nnchen}

procedure place(n:integer);
  var arec:apfelrec;
      links,rechts,unten,oben,r:real;
      numits,xa,xe,ya,ye:integer;
      color:word;
      ch:char;
      dat:screendat;
      recpar:apfelpar;
begin
assign(recpar,'apar');              { Datei mit Bildparametern }
reset(recpar);
seek(recpar,0);                     { Zeiger auf Schirmbildnummer-Record }
read(recpar,arec);                  { einlesen der Bildparameter }
assign(dat,arec.name+'dat');        { Schirmpixeldatei wird ge”ffnet }
reset(dat);
links:=arec.li;                     { Schirmbildparameter einlesen }
rechts:=arec.re;
unten:=arec.un;
oben:=arec.ob;
r:=arec.rad;
numits:=arec.num;
setgraphmode(graphmode);
setbkcolor(15);
for i:=0 to maxx do
  for j:=0 to maxy do
    begin
    read(dat,color);
    putpixel(i,j,color);            { Aufbau des Schirmbildes }
    end;
close(dat);                         { Schirmpixeldatei wird geschlossen }
seek(recpar,n);                     { Zeiger auf Schirmbildnummer-Record }
read(recpar,arec);                  { einlesen der Bildparameter }
close(recpar);
setcolor(4);
xa:=bildx(links,rechts,arec.li);
xe:=bildx(links,rechts,arec.re);
ya:=bildy(unten,oben,arec.ob);
ye:=bildy(unten,oben,arec.un);
line(width,ya,maxx-width,ya);
line(width,ye,maxx-width,ye);
line(xa,height,xa,maxy-height);
line(xe,height,xe,maxy-height);
ch:=readkey;
end;  {place}

procedure callscreen(var dat:screendat;var par:screenpar;filename:string;
         var links,rechts,unten,oben:real);
  var i,j:integer;            { gespeicherten Bildschirm aufrufen }
      color:word;
begin
assign(dat,filename+'dat');
assign(par,filename+'par');

reset(dat);                   { Pixeldatei ”ffnen }
reset(par);                   { Parameterdatei ”ffnen }
for i:=0 to maxx do
  for j:=0 to maxy do
    begin
    read(dat,color);
    putpixel(i,j,color);     { Pixel einf„rben }
    end;
close(dat);                  { Pixeldatei schlieáen }
read(par,links);             { Schirmgrenzen abrufen }
read(par,rechts);
read(par,unten);
read(par,oben);
close(par);                  { Parameterdatei schlieáen }
end;  {callscreen}

procedure callapfel(var dat:screendat;var recpar:apfelpar;
         var links,rechts,unten,oben,r:real;var numits:integer;
         var col:boolean);   { Abruf eines gespeicherten Schirmbildes }
  var i,j,n,fileend,liox,lioy,reux,reuy:integer;
      anfang,ende,boden,dach:real;
      lio,reu:vector;
      color:word;
      arec:apfelrec;
      ch:char;
      stn:string;
      symm,det,ausschnitt:boolean;
begin
symm:=false;                          { keine Vertikal-Symmetrie }
col:=false;                           { Ausgabe einf„rbig }
ch:='w';
assign(recpar,'apar');                { Datei mit Bildparametern }
reset(recpar);
n:=0;                                 { erstes Schirmbild }
repeat
  clrscr;
  writeln;
  writeln(' Die Datei apar enth„lt derzeit ',filesize(recpar),
   ' Eintr„ge (von 0 bis',filesize(recpar)-1,').');
  writeln;
  if ch='n' then                      { Wahl einer Schirmbildnummer }
    begin                             { bei Prozdur-Beginn ch='w' }
    write(' Eingabe der Dateinummer: n = ');
    repeat readgwritexy(wherex,wherey,2,n)
      until n<filesize(recpar);
    writeln;
    end;  {ch='n'}
  writeln;
  seek(recpar,n);                     { Zeiger auf Schirmbildnummer-Record }
  read(recpar,arec);                  { einlesen der Bildparameter }
  writeln(' Ausgabe von Apfeldetail nr. ',n);       { Prozedur-Beginn: n=0 }
  writeln;                                          { = Apfelm„nnchen }
  writeln(' Datei ',arec.name+'dat');
  writeln(' Farbtyp = ',arec.farbtyp);
  writeln(' links  = ',arec.li:10:7);
  writeln(' rechts = ',arec.re:10:7);
  writeln(' unten  = ',arec.un:10:7);
  writeln(' oben   = ',arec.ob:10:7);
  writeln(' Fluchtradius = ',arec.rad:4:2);
  writeln(' numit = ',arec.num);
  writeln;                           { Menuausgabe f�r weiteres Vorgehen }
  writeln(' weiter .......... w');
  writeln(' zur�ck .......... z');
  writeln(' neu ............. n');
  writeln(' Platz ........... p');
  writeln(' Schirmausgabe ... s');
  writeln(' ende ............ e');
  repeat ch:=readkey until ch in ['w','z','n','p','s','e'];
  if ((ch='w') and (not eof(recpar))) then n:=n+1;
  if ((ch='z') and (n>0)) then n:=n-1;
  until ch in ['e','p','s'];
close(recpar);                      { Bildparameterdatei wird geschlossen }
if ch='p' then  place(n);
if((ch='s') or (ch='p')) then
  begin
  setgraphmode(graphmode);
  repeat
    col:=arec.farbtyp='f';
    if col then setbkcolor(0) else setbkcolor(15);
    setcolor(1);
    assign(dat,arec.name+'dat');   { Schirmpixeldatei wird ge”ffnet }
    reset(dat);
    links:=arec.li;                { Schirmbildparameter einlesen }
    rechts:=arec.re;
    unten:=arec.un;
    oben:=arec.ob;
    r:=arec.rad;
    numits:=arec.num;
    if arec.farbtyp='f' then col:=true;
    for i:=0 to maxx do
      for j:=0 to maxy do
        begin
        read(dat,color);
        putpixel(i,j,color);      { Aufbau des Schirmbildes }
        end;
    close(dat);                   { Schirmpixeldatei wird geschlossen }
    ch:=readkey;
    str(n,stn);
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('Bild Nummer '+stn+
      '; Detail d,Julia j,weiter w,zur�ck z,neu n,Menu m',
       3*width,maxy-2*height,xarr,7);
    repeat chc:=readkey until chc in ['d','j','w','z','n','m'];
    case chc of
      'w','z','n':begin   { Wahl des n„chsten oder vorherigen Schirmbildes }
        reset(recpar);    { oder eines neuen;   ™ffnung der Parameterdatei }
        seek(recpar,n+1);
        if ((chc='w') and (not eof(recpar))) then n:=n+1; { n„chstes Bild }
        if ((chc='z') and (n>0)) then n:=n-1;             { voriges Bild }
        if (chc='n') then
          begin
          clearwindow(0,maxy-2*height,maxx,maxy);
          xptextxy('Bild Nummer n = ',3*width,maxy-2*height,xarr,7);
          readln(n);
          xpnumberxy(n,2,0,20*width,maxy-2*height,xarr,7);
          end;  { chc='n'}
        seek(recpar,n);
        read(recpar,arec);          { Bildparameter einlesen }
        close(recpar);
        with arec do      { ist das neu gew„hlte Bild im alten enthalten ? }
          ausschnitt:=((li>=links) and (re<=rechts) and
                       (un>=unten) and (ob<=oben));
        if not ausschnitt then   { wenn nicht, wird sein Ausschnitt im
                                   Gesamtapfelbild angezeigt }
          callscreen(dat,par,'apfel',links,rechts,unten,oben);
        liox:=bildx(links,rechts,arec.li);
        lioy:=bildy(unten,oben,arec.ob);
        reux:=bildx(links,rechts,arec.re);
        reuy:=bildy(unten,oben,arec.un);
        setcolor(4);
        rectangle(liox,lioy,reux,reuy);    { Ausschnitt-Rechteck in rot }
        clearwindow(0,maxy-2*height,maxx,maxy);
        str(n,stn);
        xptextxy('Ausschnitt f�r das folgende Bild Nr. '+stn,
                  width,maxy-2*height,xarr,7);
        setcolor(1);
        ch:=readkey;
        end;  {'w','z'}
      'd':begin                             { Neuausgabe eines Details}
        det:=true;
        if symm then grid else grid1;       { Gitternetzlinien }
        detailscreen(anfang,ende,boden,dach,r,numits);  { Wahl des Fensters }
        apfeldetail(numits,anfang,ende,boden,dach,r,symm,col,det,color);
        end;  {'d'}
      'j':julia(r,links,rechts,unten,oben,numits,l);
      end;  {case}
    until chc='m';                          { R�ckkehr zum Menu }
  end;  {ch='s'}
restorecrtmode;
end;  {callapfel}

procedure inversmap(h:bit;var l,z:vector);
  var z0:vector;       { Invers-Collagen f�r z=f(w)=w^2-l }
      xl,yl,radx,rady:real;
begin                  { ausgegeben wird z=w(z0) f�r z0=f(w) }
z0:=z;                 { w(z):=+-sqrt(z+l) }
xl:=z0[1]+l[1];
yl:=z0[2]+l[2];
radx:=xl+sqrt(sqr(xl)+sqr(yl));
rady:=-xl+sqrt(sqr(xl)+sqr(yl));
if radx>0 then z[1]:=sqrt(radx/2)     { Verhinderung von Laufzeitfehlern }
  else z[1]:=0;                       { infolge Wurzel aus negativer Zahl }
if rady>0 then z[2]:=sqrt(rady/2)
  else z[2]:=0;
if h=1 then           { zweite Wurzel }
  begin
  z[1]:=-z[1];
  z[2]:=-z[2];
  end;  {i=1}
end;    {inversmap}

procedure lwahl(var c:vector);
  var abs,alpha:real;             {Wahl des Vektors l in f(z)=z^2-l}
      l,k:integer;            {in Graphmode als Punkt der Zahlenebene}
      strl,strk:string;
      ch,ch0:char;
begin
callscreen(dat,par,'apfel',links,rechts,unten,oben);
clearwindow(0,0,15*width,2*height);
metrik(x0,y0,x1,y1);
repeat
  clearwindow(0,maxy-2*height,maxx,maxy);
  xptextxy('grid, kuss, weiter (g/k/w)?',width,maxy-2*height,xarr,7);
  repeat ch:=readkey until ch in ['g','k','w'];
  if ch='g' then  grid;
  if ch='k' then
    repeat
    clearwindow(0,maxy-2*height,maxx,maxy);
    xptextxy('phi=2pil/k: l = ',width,maxy-2*height,xarr,7);
    readln(l);
    str(l,strl);
    xptextxy(strl+', k = ',17*width,maxy-2*height,xarr,7);
    readln(k);
    str(k,strk);
    xptextxy(strk,26*width,maxy-2*height,xarr,7);
    alpha:=2*pi*l/k;
    c[1]:=(cos(2*alpha)-2*cos(alpha))/4;
    c[2]:=(sin(2*alpha)-2*sin(alpha))/4;
    clearwindow(0,maxy-2*height,maxx,maxy);
    xptextxy('c[1] =',width,maxy-2*height,xarr,7);
    xpnumberxy(c[1],8,6,8*width,maxy-2*height,xarr,7);
    xptextxy('; c[2] = ',17*width,maxy-2*height,xarr,7);
    xpnumberxy(c[2],8,6,26*width,maxy-2*height,xarr,7);
    xptextxy('akzeptabel? (j/n)',60*width,maxy-2*height,xarr,7);
    blinkkreuz(c,7,14);
    repeat ch0:=readkey until ((ch0='j') or (ch0='n'));
    if ch0='n' then
      begin
      showkreuz(c,15);
      clearwindow(0,maxy-2*height,maxx,maxy);
      end;  {ch='n'}
    until ch0='j';
  if ch='w' then
    repeat
    clearwindow(0,maxy-2*height,maxx,maxy);
    xptextxy('c[1] =',width,maxy-2*height,xarr,7);
    readrsafe(c[1]);        {Eingabe von l[1]}
    xpnumberxy(c[1],8,6,8*width,maxy-2*height,xarr,7);
    xptextxy('; c[2] = ',17*width,maxy-2*height,xarr,7);
    readrsafe(c[2]);        {Eingabe von l[2]}
    xpnumberxy(c[2],8,6,26*width,maxy-2*height,xarr,7);
    xptextxy('akzeptabel? (j/n)',60*width,maxy-2*height,xarr,7);
    blinkkreuz(c,7,14);
    repeat ch0:=readkey until ((ch0='j') or (ch0='n'));
    clearwindow(0,0,24*width,9*height);
    if ch0='n' then
      begin
      showkreuz(c,15);
      clearwindow(0,maxy-2*height,maxx,maxy);
      end;  {ch0='n'}
    until ch0='j';
  until ch in ['k','w'];
end; {lwahl}

procedure orbit(r:real;numits:integer);
  var l:vector;
      n1:longint;
      l1,l2:string;
      doit:boolean;
      ch:char;
begin
bild('a',links,rechts,unten,oben,x0,y0,x1,y1);
setgraphmode(graphmode);
setbkcolor(15);
repeat
  clearviewport;
  callscreen(dat,par,'apfel',links,rechts,unten,oben);
  clearwindow(0,0,15*width,2*height);
       {apfeldetail(numits,links,rechts,0,oben,r,true,false,false,color);}
  grid;
  repeat
    gotoxy(0,0);
    clearwindow(0,maxy-3*height,maxx,maxy);
    xptextxy('w=zý-c;',width,maxy-2*height,xarr,7);
    xptextxy('c[1] = ',10*width,maxy-2*height,xarr,7);
    readrsafe(l[1]);        {Eingabe von l[1]}
    xpnumberxy(l[1],4,2,16*width,maxy-2*height,xarr,7);
    xptextxy('; cl[2] = ',20*width,maxy-2*height,xarr,7);
    readrsafe(l[2]);        {Eingabe von l[2]}
    xpnumberxy(l[2],4,2,29*width,maxy-2*height,xarr,7);
    xptextxy('akzeptabel (j/n) ?',60*width,maxy-2*height,xarr,7);
    blinkkreuz(l,3,12);
    repeat ch:=readkey until ch in ['j','n'];
    clearwindow(0,maxy-3*height,maxx,maxy);
    if ch='j' then
      begin
      str(l[1]:8:6,l1);
      str(l[2]:8:6,l2);
      xptextxy('c=('+l1+';'+l2+')',width,maxy-2*height,xarr,7);
      end;
    until ch='j';
  attcycle(l,zero,n1);
  abfrage('neuer Orbit',doit);
  until not doit;
end;  {orbit}

procedure galerie(call,save:boolean); {im Grafik-Modus}
  var i,n,x,y:integer;
      n1:longint;
      l,z:vector;
      fix:zarray;
      endejulia:boolean;
      ch:char;
begin
if call then
  begin
  callscreen(dat,par,'apfel',links,rechts,unten,oben);
  clearwindow(0,0,15*width,2*height);
  metrik(x0,y0,x1,y1);
  end
  else begin
    bild('a',links,rechts,unten,oben,x0,y0,x1,y1);
    apfelmaennchen(r,numits,col,chm);
    if save then
      begin
      savescreen(dat,par,'apfel',links,rechts,unten,oben);
      xptextxy('Bild abgespeichert unter "apfel"',width,height,xarr,7);
      end;  {save}
  end;  {not call}
for i:=1 to 16 do
  begin
  x:=bildx(links,rechts,larray[i,1]);
  y:=bildy(unten,oben,larray[i,2]);
  kreuz(x,y,3);
  if y<y0 then
    xpnumberxy(i,2,0,x-width,y-height-4,xarr,7)
    else xpnumberxy(i,2,0,x-width,y+height+4,xarr,7);
  end;  {i-Schleife}
setcolor(1);
repeat
  clearwindow(0,maxy-2*height,maxx,maxy);
  xptextxy('Wahl von c nr.:',width,maxy-2*height,xarr,7);
  repeat read(n) until ((0<n) and (n<17));
  xpnumberxy(n,2,0,18*width,maxy-2*height,xarr,7);
  xptextxy('akzeptabel? (j/n)',70*width,maxy-2*height,xarr,7);
  blinkkreuz(larray[n],14,4);
  repeat ch:=readkey until ((ch='j') or (ch='n'));
  until ch='j';
l:=larray[n];
bild('j',links,rechts,unten,oben,x0,y0,x1,y1);
repeat
  cleardevice;
  juliamenge(r,numits,l,fix);
  zwahl(z,doit);
  if doit then
    begin
    attcycle(l,z,n1);
    abfrage(' Neuer Orbit',doit);
    end;  {doit}
  until not doit;
end;  {galerie}

procedure menu(var r:real;var chm:char;
               var numits,minxpaint,maxxpaint,minypaint,maxypaint:integer;
               var call,save,col:boolean);
  var b,h:real;
      ch:string;
begin
b:=4;
h:=4;
ch:='n';
clrscr;
writeln;
writeln(' Auswahlmenu:');
writeln(' Fluchtzeitenkarte ......... f');
writeln(' Apfelm„nnchen ............. a');
writeln(' Juliafluchtzeit(c) ........ j');
writeln(' Juliamenge(c) ............. m');
writeln(' Galerie ................... g');
writeln(' Schirmbildabruf ........... s');
writeln(' zero-Orbit ................ o');
writeln(' Programm-Ende: ............ e');
writeln;
repeat chm:=readkey until chm in ['a','e','f','g','j','m','o','s'];
col:=chm in ['f','j'];
case chm of
  'a','f','j','m':begin
    write(' Wahl der Fluchtgrenze: r = ');
    readrwritexy(wherex,wherey,3,1,r);
    writeln;
    write(' Wahl der maximalen Iterations-Anzahl: numits = ');
    readgwritexy(wherex,wherey,2,numits);
    writeln;
    if chm='a' then
      begin
      write(' Fluchtzeitfarben ? (j/n) ');
      repeat readswritexy(wherex,wherey,ch)
        until ((ch='j') or (ch='n'));
      end;  {if}
    col:=ch='j';
    end;  {'a','f','j'}
  'g':begin
    filename:='apfel';
    repeat
      writeln(' Abruf der gespeicherten Graphik (j/n) ?');
      repeat ch:=readkey until ((ch='j') or (ch='n'));
      call:=ch='j';
      if call then writeln(' Ja !') else writeln(' Nein !');
      writeln(' Korrektur (j/n) ?');
      repeat ch:=readkey until ((ch='j') or (ch='n'));
      until ch='n';
    if not call then
      repeat
        write(' Wahl der Fluchtgrenze: r = ');
        readrwritexy(wherex,wherey,3,1,r);
        writeln;
        write(' Wahl der maximalen Iterations-Anzahl: numits = ');
        readgwritexy(wherex,wherey,2,numits);
        writeln;
        writeln(' Abspeicherung der Graphik (j/n) ?');
        repeat ch:=readkey until ((ch='j') or (ch='n'));
        save:=ch='j';
        if save then writeln(' Ja !') else writeln(' Nein !');
        writeln(' Korrektur (j/n) ?');
        repeat ch:=readkey until ((ch='j') or (ch='n'));
        until ch='n';
    end;  {'g'}
    's':callapfel(dat,recpar,links,rechts,unten,oben,r,numits,col);
  end;  {case}
bild('b',links,rechts,unten,oben,x0,y0,x1,y1);
minxpaint:=bildx(links,rechts,-b/3);
maxxpaint:=bildx(links,rechts,2*b/3);
minypaint:=bildy(unten,oben,h/2);
maxypaint:=bildy(unten,oben,-h/2);
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);
bild('b',links,rechts,unten,oben,x0,y0,x1,y1);
restorecrtmode;
r:=2;                   {Fluchtzeitradius}
numits:=100;
zero[1]:=0;
zero[2]:=0;
z:=zero;                {interessante Werte f�r l}
larray[1,1]:=-0.31;
larray[1,2]:=0.04;
larray[2,1]:=0.11;
larray[2,2]:=0.6557;
larray[3,1]:=0.12;
larray[3,2]:=0.74;
larray[4,1]:=-0.3;
larray[4,2]:=0.55;
larray[5,1]:=0.194;
larray[5,2]:=0.6557;
larray[6,1]:=0.74543;
larray[6,2]:=0.11301;
larray[7,1]:=1.25;
larray[7,2]:=0;
larray[8,1]:=0.481762;
larray[8,2]:=-0.531657;
larray[9,1]:=0.39054;
larray[9,2]:=-0.58679;
larray[10,1]:=0.15652;
larray[10,2]:=-1.03225;
larray[11,1]:=-0.11031;
larray[11,2]:=-0.67037;
larray[12,1]:=-0.27334;
larray[12,2]:=0.00742;
larray[13,1]:=0;
larray[13,2]:=0.5;
larray[14,1]:=1;
larray[14,2]:=0.1;
larray[15,1]:=1.15;
larray[15,2]:=0.25;
larray[16,1]:=1.3;
larray[16,2]:=0.05;
restorecrtmode;
repeat
  menu(r,chm,numits,minxpaint,maxxpaint,minypaint,maxypaint,
       call,save,col);
  if chm<>'e' then
    begin
    setgraphmode(graphmode);
    setbkcolor(15);                             {weiá}
    setcolor(1);                                {blau}
    end;  {ch<>'e'}
  case chm of
    'j':begin                                   { Juliafluchtzeit }
      lwahl(l);
      bild('j',links,rechts,unten,oben,x0,y0,x1,y1);
      minxpaint:=0;
      maxxpaint:=maxx;
      minypaint:=0;
      maxypaint:=maxy;
      repeat
        cleardevice;
        paintjulia(numits,minxpaint,maxxpaint,minypaint,maxypaint,r,l);
        repeat
          endejulia:=true;
          zwahl(z,doit);
          if doit then
            begin
            doit:=false;
            attcycle(l,z,n1);
            clearwindow(0,maxy-2*height,maxx,maxy);
            xptextxy(' Neuer Orbit, Juliamenge, weiter (o/j/w)?',
                       40*width,maxy-2*height,xarr,7);
            repeat ch:=readkey until ch in ['o','j','w'];
            clearwindow(0,maxy-2*height,maxx,maxy);
            case ch of
              'o':doit:=true;
              'j':endejulia:=false;
              end;  {case}
            end;   {doit}
          until not doit;
        until endejulia;
      end;  {'j'}
    'm':begin                                   { Juliamenge }
      lwahl(l);
      bild('j',links,rechts,unten,oben,x0,y0,x1,y1);
      repeat
        cleardevice;
        juliamenge(r,numits,l,fix);
        repeat
          zwahl(z,doit);
          if doit then
            begin
            attcycle(l,z,n1);
            clearwindow(0,maxy-2*height,maxx,maxy);
            xptextxy(' Neuer Orbit, Juliamenge, weiter (o/j/w)?',
                       40*width,maxy-2*height,xarr,7);
            repeat ch:=readkey until ch in ['o','j','w'];
            clearwindow(0,maxy-2*height,maxx,maxy);
            end   {doit}
            else ch:='w';
          until ch  in ['j','w'];
        doit:=ch='j';
        until not doit;
      end;  {'m'}
    'f':paint(numits,width,maxx-width,height,maxy-2*height,r);
    'a':begin                                        { apfelm„nnchen }
      bild('a',links,rechts,unten,oben,x0,y0,x1,y1);
      apfelmaennchen(r,numits,col,chm);
      end;  {'a'}
    'g':galerie(call,save);
    'o':orbit(r,numits);
    end;  {case}
  restorecrtmode;
  until chm='e';
ch:=readkey;
end. {agmath3a}