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
wersja strony: 1, ostatnia edycja: 20 Jul 2009 19:47