Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
7
Добавлен:
05.06.2015
Размер:
2.81 Кб
Скачать
program Fractal;
uses windows;
type
BMP_HEADER=record
bfType:WORD; {BM}
FileSize:DWORD;
NoneUse:DWORD;
BytesToData:DWORD;
end;
BitMapInfo=record
StructSize:DWORD;
bmpWidth:DWORD;
bmpHeight:DWORD;
Planes:WORD;
BitPerPixel:WORD;
TypeCompression:DWORD;
DataSize:DWORD;
XPelsPerMeter:DWORD;
YPelsPerMeter:DWORD;
ColorUsed:DWORD;
ColorImportant:DWORD;
end;
PixelType=record
B,G,R:BYTE;
end;
Ekran =array [0..512*512-1] of PixelType;
PixEkr=array [1..512,1..512] of PixelType;
Complex=record
Re:single;
Im:single;
end;
const
Shapka:array [1..54] of byte=($42,$4D,$36,0,$C,0,0,0,0
,0,$36,0,0,0,$28,0,0,0,0,2,0,0,0,2,0,0,1,0,$18
,0,0,0,0,0,0,0,$C,0,$12,$B,0,0,$12,$B,0,0,0,0,
0,0,0,0,0,0);
var
Zagolovok:BMP_HEADER;
Opis :BitMapInfo;
Pixels :^PixEkr;
Palette :array [1..256] of PixelType;
f1:file;
T,x,y:DWORD;
Odin,C,Z,A,B,D,E,F:Complex;
minx,miny,maxx,maxy,tx:single;
n:DWORD;
Begin
GetMem(Pixels,3*512*512);
Odin.Re:= 1.0;
Odin.Im:=-1.0;
B.Re:=1;
B.Im:=0;
minx:=-1.5;
maxx:= 0.5;
miny:=-1.0;
maxy:= 1.0;
for n:=1 to 256 do
begin
Palette[n].R:=255-abs(127-n);
Palette[n].B:=256-n;
Palette[n].G:=n-1;
end;
T:=GetTickCount;
for x:=1 to 512 do {}
begin
for y:=1 to 512 do
begin
C.Re:=minx+(maxx-minx)*x/512.0;
C.Im:=miny+(maxy-miny)*y/512.0;
Z:=C;
n:=0;
repeat
asm {C=A*B}
femms




movq mm0,Z {mm0=Z.Re,Z.Im}
pswapd mm1,Z {mm1=Z.Im,Z.Re}
pfmul mm1,mm0 {mm1=Z.Im*Z.Re,Z.Re*Z.Im}
pfmul mm0,Z {mm0=Z.Re*Z.Re,Z.Im*Z.Im}
pfpnacc mm0,mm1 {mm0=Z.Re*Z.Re-Z.Im*Z.Im,
Z.Im*Z.Re+Z.Re*Z.Im}
movq A,mm0 {збереження результату}


movq mm0,A {mm0=A.Re,A.Im}
pswapd mm1,Z {mm1=B.Im,B.Re}
pfmul mm1,mm0 {mm1=B.Im*A.Re,B.Re*A.Im}
pfmul mm0,Z {mm0=A.Re*B.Re,A.Im*B.Im}
pfpnacc mm0,mm1 {mm0=A.Re*B.Re-A.Im*B.Im,
B.Im*A.Re+B.Re*A.Im}
movq D,mm0 {збереження результату}


movq mm0,C {mm0={A.Re,A.Im}
pfsub mm0,D {mm0={A.Re-B.Re,A.Im-B.Im}
movq E,mm0 {збереження результату}


movq mm0,E {mm0={A.Re,A.Im}
pfadd mm0,B {mm0={A.Re+B.Re,A.Im+B.Im}
movq Z,mm0 {збереження результату}


pfmul mm0,mm0
pfacc mm0,mm0
movd tx,mm0




femms
end;
n:=n+1;
until( (tx>4.0) or (n=255) );{}
Pixels^[y,x]:=Palette[n];
end;
end;
T:=GetTickCount-T;
Writeln('Time calckulate is T=',T,' ms.');
assign(f1,'Fractal.bmp');
rewrite(f1,1);
blockwrite(f1,Shapka,54);
blockwrite(f1,Pixels^,3*512*512);
FreeMem(Pixels,3*512*512);
close(f1);
readln;
End.
Соседние файлы в папке цеом