Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
22
Добавлен:
05.06.2015
Размер:
5 Кб
Скачать
☆
program lab4;
//{$APPTYPE CONSOLE}
uses crt,windows;
type
  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,A,B,D,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.0;
  maxx:= 1.0;
  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:=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 xmm4, xmm0

	  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,ODIN
          SUBPS  XMM0,XMM2
          SHUFPS XMM0,XMM0,11011000B
	  movaps  xmm7,xmm0



	movaps  xmm3,xmm7    {xmm0=y1,x1,y2,x2}		{Возводим в 4 степень - В}
	movaps  xmm1,xmm7  {xmm1=y3,x3,y4,x4}
	movaps  xmm2,xmm7 {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,xmm7 {xmm1=y1*x3,x1*y3,y2*x4,x2*y4}
	movaps  xmm0,xmm2 {xmm0=y1*y3,x1*x3,y2*y4,x2*x4}
	shufps  xmm0,xmm1,10001000b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
	shufps  xmm2,xmm1,11011101b{xmm2= x1*x3, x2*x4,x1*y3,x2*y4}
	mulps   xmm2,Odin          {xmm0=-y1*y3,-y2*y4,y1*x3,y2*x4}
	subps   xmm0,xmm2 {xmm0=X1,X2,Y1,Y2}
	shufps  xmm0,xmm0,11011000b  {xmm0=Y1,X1,Y2,X2}
	movaps  xmm6,xmm0




	movaps  xmm3,xmm7    {xmm0=y1,x1,y2,x2}		{Возводим в 3 степень - D}
	movaps  xmm1,xmm4    {xmm1=y3,x3,y4,x4}
	movaps  xmm2,xmm7 {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,xmm7 {xmm1=y1*x3,x1*y3,y2*x4,x2*y4}
	movaps  xmm0,xmm2 {xmm0=y1*y3,x1*x3,y2*y4,x2*x4}
	shufps  xmm0,xmm1,10001000b {xmm0=y1*y3,y2*y4,y1*x3,y2*x4}
	shufps  xmm2,xmm1,11011101b{xmm2= x1*x3, x2*x4,x1*y3,x2*y4}
        mulps   xmm2,Odin          {xmm0=-y1*y3,-y2*y4,y1*x3,y2*x4}
	subps   xmm0,xmm2 {xmm0=X1,X2,Y1,Y2}
	shufps  xmm0,xmm0,11011000b  {xmm0=Y1,X1,Y2,X2}

         	addps  xmm0,xmm7
       //movaps Z,xmm0

       // movaps xmm0,xmm5
    	addps  xmm0,xmm6
      //movaps Z,xmm0

       //movaps xmm0,Z
       addps  xmm0,C
      //movaps Z,xmm0
		 /////////////////////////////////////////
         maxps xmm0,min
         minps xmm0,max
         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_lab4.bmp');
  rewrite(f1,1);
  blockwrite(f1,Shapka,54);
  blockwrite(f1,Pixels^,3*512*512);
  FreeMem(Pixels,3*512*512);
  close(f1);
End.
Соседние файлы в папке цеом