Pascal graphics trees and houses, рисуем домики и деревья случайным образом на паскале

yh - уровень горизонта (задаем сами)
y0 - уровень дальности d0 (задаем сами)
y - уровень дальности d (рассчитывается)
L0 - размер изображения предмета, находящегося на дальности d0 (задаем)
L - размер изображения предмета, находящегося на дальности d (рассчитываем)
везде слово "предмет" означает один и тот же предмет, лежащий на земле перпендикулярно линии взгляда
Допустим, надо изобразить предмет, находящийся на дальности d. Расчеты производим исходя из подобия трегольников A0-O-B0 и AOB.
Но сначала заметим, что во сколько раз предмет дальше, во столько раз он кажется меньше. Назовем это отношение k.
L0/L = d/d0 = k
Отсюда сразу получаем: L = L0/k
Это же число k является и коэффициентом подобия треугольников.
(yh-y0)/(yh-y) = k
y = yh - (yh-y0)/k

domik.pas

1. uses
2.   WinCRT, domik_elements;
4. var
5.   x, y, l, i, n, k: integer;
7. begin
8.   randomize;
9.   GrOn;
10.   k:= random(8)+4;
11.   Street(k);
12.   for i:=1 to 10 do begin
13.     x:= random(700);
14.     y:= random(400)+50;
15.     l:= random(80)+30;
16.     n:= random(3);
17.     Tree(x,y,l,n,random(8)+8);
18.   end;
19.   for i:=1 to 1 do begin
20.     x:= random(700);
21.     y:= random(400)+50;
22.     l:= random(30)+20;
23.     Cat(x,y,l,random(8)+8);
24.   end;
25.   readkey;
26.   GrOff
27. end.

domik_elements.pas

1. unit domik_elements;
3. interface
5. uses graph;
7. procedure Street(k: integer);
8. procedure Cat(x,y,l,c: integer);
9. procedure Tree(x,y,l,n,c: integer);
10. procedure Domic(x,y,l,c: integer);
11. procedure GrOn;
12. procedure GrOff;
14. implementation
16. procedure GrOn;
17. var
18.   gd,gm: integer;
19. begin
20.   gd:= detect;
21.   InitGraph(gd,gm,'')
22. end;
25. procedure GrOff;
26. begin
27.   CloseGraph
28. end;
30. procedure Street(k: integer);
31. var
32.   i,x,y,l: integer;
33. begin
34.   x:= 10;
35.   y:= random(200)+100;
36.   for i:=1 to k do begin
37.     l:= random(40)+30;
38.     Domic(x,y,l,random(10)+2);
39.     x:= x+l+ l div 3;
40.   end;
41. end;
43. procedure Domic(x,y,l,c: integer);
44. begin
46. // Walls
47.   setcolor(c);
48.   line(x,y,x,y-l);
49.   line(x,y,x+l,y);
50.   line(x,y-l,x+l,y-l);
51.   line(x+l,y,x+l,y-l);
52. // Roof
53.   line(x,y-l,(2*x+l) div 2, y-l-(l div 2));
54.   line(x+l,y-l,(2*x+l) div 2, y-l-(l div 2));
55. // Window
56.   circle(x+l div 2,y-l div 2,l div 5);
57. end;
60. procedure Tree(x,y,l,n,c: integer);
61. var
62.   i, d, d1, d2: integer;
63. begin
64. // Trunk
65.   setcolor(c);
66.   line(x+l+l div 2,y,x+l+l div 2,y+l-1);
67.   line(x+l+l div 3,y,x+l+l div 3,y+l-1);
68. // Branches
69.   c:= 0;
70.   c:= random(10)+2;
71.   d:= 0;
72.   for i:=1 to (l div 9) do begin
73.     d1:= random(360)+1;
74.     d2:= random(360)+1;
75.     d:= d+3;
76.     setcolor(c);
77.     circle(((x+l+l div 2)+(x+l+l div 3)) div 2,y,d);
78. // Add branches
79.     if n=2 then begin
80.       circle(x+(l+l div 2)+l div 3,y+l div 3,d div 2);
81.       circle(x+(l+l div 2)-l div 2,y+l div 3,d div 2);
82.       line(x+l+l div 2,y+l div 2,x+(l+l div 2)+l div 3,y+l div 3);
83.       line(x+l+l div 3,y+l div 2,x+(l+l div 2)-l div 2,y+l div 3);
84.     end;
85.   end;
86. end;
89. procedure Cat(x,y,l,c: integer);
90. begin
91.   setcolor(c);
92.   line(x,y,x,y+l);
93.   line(x,y,x+l,y);
94.   line(x+l,y,x+l,y+l);
95.   line(x,y+l div 2,x+l,y+l div 2);
96.   line(x,y,x-l div 2,y-l div 2);
97.   circle(x+l+l div 10,y-l div 4,l div 4);
98. end;
100. begin
101. end.

Примеры:

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