Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
22
Добавлен:
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,Rez1,Rez2,Rez4,Rez3: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,D:Complex;
  minx,miny,maxx,maxy,tx:single;
  n:DWORD;
Begin
  GetMem(Pixels,3*512*512);
  Odin.Re:= 1.0;
  Odin.Im:=-1.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
      begin
{A.Re:=C.Re-((sqr(Z.Re)-sqr(Z.Im))*Z.Re-2*Z.Re*sqr(Z.Im)-1);
A.Im:=C.Im-(Z.Im*(sqr(Z.Re)-sqr(Z.Im))+2*sqr(Z.Re)*Z.Im);
Z.Re:=A.Re;
Z.Im:=A.Im;
tx:=sqr(Z.Re)+sqr(Z.Im);}
asm

	fld   Z.Re	{Z.Re;-;-;-;-;-;-;-}
	fmul  Z.Re	{Z.Re*Z.Re;-;-;-;-;-;-;-}
	fld   Z.Im	{Z.Im;Z.Re*Z.Re;-;-;-;-;-;-}
	fmul  Z.Im	{Z.Im*Z.Im;Z.Re*Z.Re;-;-;-;-;-;-}
	fsub			{Z.Re*Z.Re-Z.Im*Z.Im;-;-;-;-;-;-;-}
	fld   Z.Im	{Z.Im;Z.Re2-Z.Im2+C.Re;-;-;-;-;-;-}
	fmul  Z.Re	{Z.Im*Z.Re;Z.Re2-Z.Im2+C.Re;-;-;-;-;-;-}
	fadd  st,st	{2*Z.Im*Z.Re;Z.Re2-Z.Im2+C.Re;-;-;-;-;-}
	fstp  A.Im	{Z.Re2-Z.Im2+C.Re;-;-;-;-;-;-;-}
	fstp  A.Re	{Z.Re;-;-;-;-;-;-;-}


	fld   A.Re	{A.Re;-;-;-;-;-;-;-}
	fmul  Z.Re	{A.Re*B.Re;-;-;-;-;-;-;-}
	fld   A.Im	{A.Im;A.Re*B.Re;-;-;-;-;-;-}
	fmul  Z.Im	{A.Im*B.Im;A.Re*B.Re;-;-;-;-;-;-}
	fsub		{A.Re*B.Re-A.Im*B.Im;-;-;-;-;-;-;-}
	fstp  D.Re	{-;-;-;-;-;-;-;-}
	fld   A.Im	{A.Im;-;-;-;-;-;-;-}
	fmul  Z.Re	{A.Im*B.Re;-;-;-;-;-;-;-}
	fld   A.Re	{A.Re;A.Im*B.Re;-;-;-;-;-;-}
	fmul  Z.Im	{A.Re*B.Im;A.Im*B.Re;-;-;-;-;-;-}
   	fadd		{A.Im*B.Re+A.Re*B.Im;-;-;-;-;-;-;-}
    	fstp  D.Im	{-;-;-;-;-;-;-;-}


	fld C.Re
	fld D.Re
	fsub
	fld1
	fadd

	fld C.Im
	fld D.Im
	fsub

	fstp Z.Im
	fst Z.Re
	fmul  st,st	{Z.Re2;-;-;-;-;-;-;-}
	fld   Z.Im	{Z.Im;Z.Re2;-;-;-;-;-;-}
	fmul  st,st	{Z.Im2;Z.Re2;-;-;-;-;-;-}
	fadd  		{Z.Im2+Z.Re2;-;-;-;-;-;-;-}
	fstp  tx		{-;-;-;-;-;-;-;-}

   end;
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,'lilu2.bmp');
  rewrite(f1,1);
  blockwrite(f1,Shapka,54);
  blockwrite(f1,Pixels^,3*512*512);
  FreeMem(Pixels,3*512*512);
  close(f1);
  readln;
End.
Соседние файлы в папке цеом