Pascal: Кривые Гильберта на паскале

Исходный код:

1. uses
2.   WinCrt,Graph;
3.  
4. var
5.   i1,i2,j1,j2: integer;
6.   x1,x2,y1,y2: double;
7.  
8. function WinX(x: double): integer;
9. begin
10.   WinX:= Round((x-x1)/(x2-x1)*(i2-i1)) + i1
11. end;
12.  
13. function WinY(y: double): integer;
14. begin
15.   WinY:= j2-Round((y-y1)/(y2-y1)*(j2-j1))
16. end;
17.  
18. procedure WinLine(x1,y1,x2,y2: double);
19. begin
20.   Line(WinX(x1),WinY(y1),WinX(x2),WinY(y2))
21. end;
22.  
23. procedure WinSet(u1,v1,u2,v2: double; a1,b1,a2,b2: integer);
24. begin
25.   if a1<0 then i1:= GetMaxX+a1 else i1:= a1;
26.   if b1<0 then j1:= GetMaxY+b1 else j1:= b1;
27.   if a2<0 then i2:= GetMaxX+a2 else i2:= a2;
28.   if b2<0 then j2:= GetMaxY+b2 else j2:= b2;
29.   x1:= u1;
30.   y1:= v1;
31.   if u2<=u1 then x2:= x1+(v2-v1)/(j2-j1)*(i2-i1) else x2:= u2;
32.   if v2<=v1 then y2:= y1+(u2-u1)/(i2-i1)*(j2-j1) else y2:= v2
33. end;
34.  
35. procedure Hilbert(p: integer; x1,y1,x2,y2: double);
36. var
37.   dx,dy,k1,k2: double;
38. begin
39.   dx:= x2-x1;
40.   dy:= y2-y1;
41.   if p=1 then begin
42.     MoveTo(WinX(x1),WinY(y1));
43.     LineTo(WinX(x1-dy),WinY(y1+dx));
44.     LineTo(WinX(x2-dy),WinY(y2+dx));
45.     LineTo(WinX(x2),WinY(y2))
46.   end
47.   else begin
48.     k1:= (1 shl (p-1)-1)/(1 shl p-1);
49.     k2:= (1 shl (p-1))/(1 shl p-1);
50.     Hilbert(p-1, x1-k1*dy, y1+k1*dx, x1, y1);
51.     WinLine(x1-k1*dy, y1+k1*dx, x1-k2*dy, y1+k2*dx);
52.     Hilbert(p-1, x1-k2*dy, y1+k2*dx, x1+k1*dx-k2*dy, y1+k2*dx+k1*dy);
53.     WinLine(x1+k1*dx-k2*dy, y1+k2*dx+k1*dy, x1+k2*(dx-dy), y1+k2*(dx+dy));
54.     Hilbert(p-1, x1+k2*(dx-dy), y1+k2*(dx+dy), x2-k2*dy, y2+k2*dx);
55.     WinLine(x2-k2*dy, y2+k2*dx, x2-k1*dy, y2+k1*dx);
56.     Hilbert(p-1, x2, y2, x2-k1*dy, y2+k1*dx);
57.   end
58. end;
59.  
60. var
61.   gd,gm: integer;
62.  
63. begin
64.   gd:= Detect;
65.   InitGraph(gd,gm,'');
66.   WinSet(-0.5,-0.1,-100,1.1,10,10,-10,-10);
67.   SetColor(LightBlue);
68.   SetLineStyle(0,0,3);
69.   Hilbert(3,0,0,1,0);
70.   SetColor(LightGreen);
71.   SetLineStyle(0,0,3);
72.   Hilbert(4,0,0,1,0);
73.   SetColor(Yellow);
74.   SetLineStyle(0,0,3);
75.   Hilbert(5,0,0,1,0);
76.   SetColor(LightRed);
77.   SetLineStyle(0,0,1);
78.   Hilbert(6,0,0,1,0);
79.   ReadKey
80. end.

Скачать download исходные файлы