Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
22
Добавлен:
05.06.2015
Размер:
5 Кб
Скачать
☆
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.
Соседние файлы в папке цеом