Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
6
Добавлен:
05.06.2015
Размер:
4.53 Кб
Скачать
program Fractal;
uses crt,windows;

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;
DComplex=record
C1:Complex;
C2:Complex;
end;
ParaWord=record
n1,n2:WORD;
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
Pixels :^PixEkr;
Palette :array [1..256] of PixelType;

f1:file;
T,T1:int64;//QWORD;
max,min,tx,Odin,C,Z:DComplex;
minx,miny,maxx,maxy:single;
n,x,y:DWORD;
Kol:ParaWord;

Begin
clrscr;
GetMem(Pixels,3*512*512);
Odin.C1.Re:= 1.0;
Odin.C1.Im:= 1.0;
Odin.C2.Re:=-1.0;
Odin.C2.Im:=-1.0;
max.C1.Re:= 4.0;
max.C1.Im:= 4.0;
max.C2.Re:= 4.0;
max.C2.Im:= 4.0;
min.C1.Re:=-4.0;
min.C1.Im:=-4.0;
min.C2.Re:=-4.0;
min.C2.Im:=-4.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;
asm
movaps xmm7,Odin
movaps xmm6,max
movaps xmm5,min
end;

for x:=1 to 512 do
begin
for y:=0 to 255 do
begin
C.C1.Re:=minx+(maxx-minx)*x/512.0;
C.C1.Im:=miny+(maxy-miny)*(y*2.0)/512.0;
C.C2.Re:=minx+(maxx-minx)*x/512.0;
C.C2.Im:=miny+(maxy-miny)*(y*2.0+1.0)/512.0;
Z:=C;
KOL.N1:=1;
KOL.N2:=1;
ASM MOVAPS XMM0,Z END;
REPEAT
ASM
MOVAPS XMM3,XMM0 {Возводим в квадрат - А}
MOVAPS XMM1,XMM0
MOVAPS XMM2,XMM0
MULPS XMM2,XMM1
SHUFPS XMM1,XMM1,10110001B
MULPS XMM1,XMM0
MOVAPS XMM0,XMM2
SHUFPS XMM0,XMM1,10001000B
SHUFPS XMM2,XMM1,11011101B
MULPS XMM2,XMM7//ODIN
SUBPS XMM0,XMM2
SHUFPS XMM0,XMM0,11011000B
movaps A,xmm0



movaps xmm0,A {xmm0=y1,x1,y2,x2} {Возводим в 4 степень - В}
movaps xmm1,A {xmm1=y3,x3,y4,x4}
movaps xmm2,xmm0 {xmm2=y1,x1,y2,x2}
mulps xmm2,xmm1 {xmm2=y1*y3,x1*x3,y2*y4,x2*x4}
shufps xmm1,xmm1,10110001b {xmm1=x3,y3,x4,y4}
mulps xmm1,xmm0 {xmm1=y1*x3,x1*y3,y2*x4,x2*y4}
movaps xmm0,xmm2 {xmm0=y1*y3,x1*x3,y2*y4,x2*x4}
shufps xmm0,xmm1,11011101b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
shufps xmm2,xmm1,10001000b{xmm2= x1*x3, x2*x4,x1*y3,x2*y4}
mulps xmm0,Odin {xmm0=-y1*y3,-y2*y4,y1*x3,y2*x4}
addps xmm0,xmm2 {xmm0=X1,X2,Y1,Y2}
shufps xmm0,xmm0,11011000b {xmm0=Y1,X1,Y2,X2}
movaps B,xmm0




movaps xmm0,A {xmm0=y1,x1,y2,x2} {Возводим в 3 степень - D}
movaps xmm1,Z {xmm1=y3,x3,y4,x4}
movaps xmm2,xmm0 {xmm2=y1,x1,y2,x2}
mulps xmm2,xmm1 {xmm2=y1*y3,x1*x3,y2*y4,x2*x4}
shufps xmm1,xmm1,10110001b {xmm1=x3,y3,x4,y4}
mulps xmm1,xmm0 {xmm1=y1*x3,x1*y3,y2*x4,x2*y4}
movaps xmm0,xmm2 {xmm0=y1*y3,x1*x3,y2*y4,x2*x4}
shufps xmm0,xmm1,11011101b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
shufps xmm2,xmm1,10001000b{xmm2= x1*x3, x2*x4,x1*y3,x2*y4}
mulps xmm0,Odin {xmm0=-y1*y3,-y2*y4,y1*x3,y2*x4}
addps xmm0,xmm2 {xmm0=X1,X2,Y1,Y2}
shufps xmm0,xmm0,11011000b {xmm0=Y1,X1,Y2,X2}
movaps D,xmm0



movaps xmm0,D
addps xmm0,B
movaps Z,xmm0



movaps xmm0,A
addps xmm0,Z
movaps Z,xmm0


movaps xmm0,Z
addps xmm0,C
movaps Z,xmm0




MAXPS XMM0,XMM5
MINPS XMM0,XMM6
MOVAPS XMM3,XMM0
MULPS XMM3,XMM3
MOVAPS XMM1,XMM3
SHUFPS XMM1,XMM1,10110001B
ADDPS XMM3,XMM1
MOVAPS TX ,XMM3


END;
IF (TX.C1.RE<4.0) THEN
KOL.N1:=KOL.N1+1;
IF (TX.C2.RE<4.0) THEN
KOL.N2:=KOL.N2+1;
UNTIL( ((TX.C1.RE>4.0)AND(TX.C2.RE>4.0)) OR (KOL.N1=255) OR (KOL.N2=255));
PIXELS^[Y*2+1,X]:=PALETTE[KOL.N1];
PIXELS^[Y*2+2,X]:=PALETTE[KOL.N2];
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);
End.
Соседние файлы в папке цеом