Zbiór Mandelbrota
uses crt;
const
   GetMaxX=319; {wartość maksymalna x - od 0 do 319 = 320 punktów}
   GetMaxY=199; {wartość maksymalna y - od 0 do 199 = 200 punktów}
   GetMaxColor=255; {wartość maksymalna c - od 0 do 255 = 256 kolorów}

type complex=record x,y:real;end;
var a:real; v:complex;c:char;l:word;
procedure init13h; assembler;
asm
  mov ah, 00h; {do górnej połówki rejestru AX liczba 0}
  mov al, 13h; {do dolnej połówki rejestru AX liczba 13h (dziesiętnie 19)}
  int 10h; {wywołujemy przerwanie karty graficznej}
end;

procedure init03h; assembler;
asm
  mov ah, 00h;
  mov al, 03h;
  int 10h;
end;

procedure PutPixel (x, y : Word; Color : Byte); assembler;
asm
  mov ax, y
  mov di, ax { skopiuj y }
  shl ax, 8
  shl di, 6
  add di, ax
  add di, x
  mov ax, 0a000h
  mov es, ax
  mov al, Color
  mov byte ptr es:[di], al
end;

function GetPixel (x, y : Word) : Byte; assembler;
asm
  mov ax, y
  mov di, ax
  shl ax, 8
  shl di, 6
  add di, ax
  add di, x
  mov ax, 0a000h
  mov es, ax
  mov al, es:[di];
end;

function rysuj(const l:word;const a:real;const v:complex):word;
label 6666;
var
   i,j,k:word;
   t:real;
   z,p,d,min,max:complex;
begin
   min.x:=(-a+v.x)*(getMaxX+1)/(getMaxY+1);
   min.y:=-a+v.y;
   max.x:=(a+v.x)*(getMaxX+1)/(getMaxY+1);
   max.y:=a+v.y;
   d.x:=(max.x-min.x)/(getMaxX+1);
   d.y:=(max.y-min.y)/(getMaxY+1);
   for j:=0 to GetMaxY do begin
      for i:=0 to GetMaxX do begin
         p.x:=min.x+i*d.x;
         p.y:=min.y+j*d.y;
         z.x:=0;
         z.y:=0;
         for k:=0 to l-1 do begin
            t:=z.x;
            z.x:=sqr(z.x)-sqr(z.y)+p.x;
            z.y:=2*t*z.y+p.y;
            if (sqr(z.x)+sqr(z.y))>4 then begin
               putpixel(trunc((p.x-min.x)/(max.x-min.x)*(getMaxX)),trunc((p.y-min.y)/(max.y-min.y)*(getMaxY)),k);
               goto 6666;
            end;
         end;
         putpixel(trunc((p.x-min.x)/(max.x-min.x)*(getMaxX)),trunc((p.y-min.y)/(max.y-min.y)*(getMaxY)),0);
         6666:
      end;
   end;
   rysuj:=l;
end;

BEGIN
   Init13h;
   a:=2;
   v.x:=0;
   v.y:=0;
   l:=256;
   repeat
      l:=rysuj(l,a,v);
      c:=readkey;
      case c of
         '1':begin
            a:=a/2;
            v.x:=v.x-a;
            v.y:=v.y+a;
         end;
         '2':begin
            a:=a/2;
            v.y:=v.y+a;
         end;
         '3':begin
            a:=a/2;
            v.x:=v.x+a;
            v.y:=v.y+a;
         end;
         '4':begin
            a:=a/2;
            v.x:=v.x-a;
         end;
         '5':a:=a/2;
         '6':begin
            a:=a/2;
            v.x:=v.x+a;
         end;
         '7':begin
            a:=a/2;
            v.x:=v.x-a;
            v.y:=v.y-a;
         end;
         '8':begin
            a:=a/2;
            v.y:=v.y-a;
         end;
         '9':begin
            a:=a/2;
            v.x:=v.x+a;
            v.y:=v.y-a;
         end;
         '0': a:=2*a;
         '+':l:=l*2;
         '-':l:=l div 2;
      end;
   until 616=666;
   Init03h;
END.

Podobne strony

Podobne Strony
Add a New Comment
Table of Contents
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License