Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
6
Добавлен:
05.06.2015
Размер:
4.75 Кб
Скачать
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 {xmm0=y1,x1,y2,x2} {Возводим в 4 степень - В}
movaps xmm1,XMM0 {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,11011000b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
shufps xmm2,xmm1,10001101b{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 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,11011000b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
shufps xmm2,xmm1,10001101b{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} {Возводим в 4 степень - В}
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,11011000b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
shufps xmm2,xmm1,10001101b{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.
Соседние файлы в папке цеом