Fraktale

[Arno-Wien]

Fraktale Apfelmännchen- und Juliamengen-Erzeugung
Interessant ist die Assembler-Beschleunigung einer Procedure in frak_un1 (siehe unten).
Bei hoher Auflösung ( Iterationen ), wie in neu_001.bmp, ca 75% ( 4 min. statt 16 ).
neu_010.bmp zeigt denselben Ausschnitt bei niedriger Auflösung. Da ist die Zeitersparnis
natürlich geringer, spielt aber auch keine Rolle mehr.
Zur Kontrolle habe ich den alten Code in Klammern stehenlassen.
Bei den anderen Proceduren gehts sowieso schnell.

Vor Gebrauch entzippen, da sonst die Bilder nicht richtig geladen werden.

Compiler-Eistellungen:
Optimization : on
Record field alignment : on
Extended syntax : on
sonst alles off

Delphi-Quellcode:

PROCEDURE apf_beliebiger_ausschnitt;
VAR m,n,i:longint;
    p:pbytearray;
    zwei,x,y,x_k,x1_k,y_k,y2wert,xqu,yqu,summe,
    deltax,deltay:extended;

procedure laden;
asm              //ST(0)   ST(1)   ST(2)   ST(3)   ST(4)   ST(5)   ST(6)   ST(7)
 fld x_k         //x_k
 fld y_k         //y_k     x_k
 fld xqu         //xqu     y_k     x_k
 fld yqu         //yqu     xqu     y_k     x_k
 fld y           //y       yqu     xqu     y_k     x_k
 fld x           //x       y       yqu     xqu     y_k     x_k
end;

procedure rechnen;
asm              //ST(0)   ST(1)   ST(2)   ST(3)   ST(4)   ST(5)   ST(6)   ST(7)
 fmulp           //x*y     yqu     xqu     y_k     x_k
 fadd ST(0),ST(0)//2*x*y   yqu     xqu     y_k     x_k
 fsub ST(0),ST(3)//y(neu)  yqu     xqu     y_k     x_k

 fxch ST(2)      //xqu     yqu     y       y_k     x_k
 fsubrp          //xqu-yqu y       y_k     x_k
 fsub ST(0),ST(3)//x(neu)  y       y_k     x_k

 fld ST(0)       //x       x       y       y_k     x_k
 fmul ST(0),ST(1)//xqu     x       y       y_k     x_k
 fld ST(2)       //y       xqu     x       y       y_k     x_k
 fmul ST(0),ST(3)//yqu     xqu     x       y       y_k     x_k

 fld ST(1)       //xqu     yqu     xqu     x       y       y_k     x_k
 fadd ST(0),ST(1)//xqu+yqu yqu     xqu     x       y       y_k     x_k
 fstp summe      //yqu     xqu     x       y       y_k     x_k

 fxch ST(1)      //xqu     yqu     x       y       y_k     x_k
 fxch ST(3)      //y       yqu     x       xqu     y_k     x_k
 fxch ST(1)      //yqu     y       x       xqu     y_k     x_k
 fxch ST(2)      //x       y       yqu     xqu     y_k     x_k
end;

procedure poppen;
asm
 fstp x          //nur Stack freigeben 
 fstp y
 fstp yqu
 fstp xqu
 fstp y_k
 fstp x_k
end;

BEGIN
  ausschnitt_check:=true;
  deltax:=(c_reel2-c_reel1)/639;
  deltay:=(c_imag2-c_imag1)/479;
  y_k:=c_imag1-deltay;
  zwei:=2.0;
  m:=0;
  REPEAT
    p:=a_bild.ScanLine[m];
    y_k:=y_k+deltay;
    x_k:=c_reel1-deltax;
    FOR n:=0 TO 639 DO
    BEGIN
      x1_k:=x_k+deltax;
      x_k:=x1_k;
      x:=0.0;
      y:=0.0;
      xqu:=0.0;
      yqu:=0.0;
      color:=0;
      laden;
      REPEAT
      (*y:=zwei*x*y-y_k;
        x:=xqu-yqu-x_k;
        xqu:=x*x;
        yqu:=y*y;
        summe:=xqu+yqu;*)
        rechnen;
        inc(color)
      UNTIL (summe > maxsum) OR (color = colormax);
      poppen;
      IF form7.checkbox6.checked THEN
      BEGIN
        IF (color >= colormin) OR (color = colormax) THEN
        begin
          i:=3*n;
          p[i]:=farbe_blau;
          p[i+1]:=farbe_gruen;
          p[i+2]:=farbe_rot;
          form7.canvas.pixels[n,m]:=farben
        end
      END ELSE
      BEGIN
        IF (color <= colormin) OR (color = colormax) THEN
        begin
          i:=3*n;
          p[i]:=farbe_blau;
          p[i+1]:=farbe_gruen;
          p[i+2]:=farbe_rot;
          form7.canvas.pixels[n,m]:=farben
        end
      END
    END;
    m:=succ(m);
    Application.processMessages
  UNTIL (m = 480) or ende;
  daten_aktualisieren(werte_apf_alt);
  BitBlt(bild_apf.canvas.handle,0,0,640,480,
         a_bild.canvas.handle,0,0,SRCCOPY)
END;

Arno