1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
{ The Computer Language Shootout
http://shootout.alioth.debian.org
contributed by Ales Katona
modified by Vincent Snijders
additional compiler options:
i386: -Cfsse2
x86_64: none
}
program mandelbrot;
var n: longint;
TextBuf: array[0..$FFF] of byte;
OutFile: PText;
procedure run;
var
Cy, Step: double;
x, y, bits,bit: Longint;
function CalculatePoint(Cx, Cy: double): boolean; nostackframe; inline;
const
Limit = 4;
var
i: longint;
Zr, Zi, Ti, Tr: Double;
begin
Zr := 0; Zi := 0; Tr := 0; Ti := 0;
for i := 1 to 50 do begin
Zi := 2*Zr*Zi + Cy;
Zr := Tr - Ti + Cx;
Ti := Zi * Zi;
Tr := Zr * Zr;
if (Tr + Ti>=limit) then exit(true);
end;
CalculatePoint := false;
end;
begin
Step := 2/n;
for y := 0 to n-1 do
begin
Cy := y * Step - 1;
bits := 255; bit := 128;
for x := 0 to n-1 do
begin
if CalculatePoint(x * Step - 1.5, Cy) then
bits := bits xor bit;
if bit > 1 then
bit := bit shr 1
else
begin
write(OutFile^, chr(bits));
bits := 255; bit := 128;
end;
end;
if bit < 128 then write(OutFile^, chr(bits xor((bit shl 1)-1)));
end;
end;
begin
OutFile := @Output;
SetTextBuf(OutFile^, TextBuf);
Val(ParamStr(1), n);
writeln(OutFile^, 'P4');
writeln(OutFile^, n,' ',n);
run;
end.
|
