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