Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 1 | unit Unit1; |
2 | |||
3 | interface |
||
4 | |||
5 | uses |
||
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
||
7 | Dialogs, ExtCtrls, StdCtrls; |
||
8 | |||
9 | type |
||
10 | TForm1 = class(TForm) |
||
11 | Button1: TButton; |
||
12 | PaintBox1: TPaintBox; |
||
13 | Button2: TButton; |
||
14 | Button3: TButton; |
||
15 | Memo1: TMemo; |
||
16 | Button4: TButton; |
||
17 | Button5: TButton; |
||
18 | Button6: TButton; |
||
19 | Button7: TButton; |
||
20 | CheckBox1: TCheckBox; |
||
21 | procedure Button1Click(Sender: TObject); |
||
22 | procedure Button2Click(Sender: TObject); |
||
23 | procedure FormCreate(Sender: TObject); |
||
24 | procedure Button3Click(Sender: TObject); |
||
25 | procedure Button4Click(Sender: TObject); |
||
26 | procedure Button5Click(Sender: TObject); |
||
27 | procedure Button6Click(Sender: TObject); |
||
28 | procedure Button7Click(Sender: TObject); |
||
29 | private |
||
30 | { Private declarations } |
||
31 | public |
||
32 | { Public declarations } |
||
33 | end; |
||
34 | |||
35 | var |
||
36 | Form1: TForm1; |
||
37 | |||
38 | implementation |
||
39 | |||
40 | {$R *.dfm} |
||
41 | |||
42 | uses |
||
43 | Math; |
||
44 | |||
45 | procedure TForm1.Button1Click(Sender: TObject); |
||
46 | const |
||
47 | mapsizex = 400; |
||
48 | mapsizey = 400; |
||
49 | |||
50 | procedure _(size: integer); |
||
51 | var |
||
52 | posx, posy: integer; |
||
53 | begin |
||
54 | posx := Random(mapsizex); |
||
55 | posy := Random(mapsizey); |
||
56 | paintbox1.Canvas.Ellipse(posx, posy, posx+size, posy+size); |
||
57 | end; |
||
58 | |||
59 | var |
||
60 | i: integer; |
||
61 | begin |
||
62 | paintbox1.Canvas.Rectangle(0,0,mapsizex,mapsizey); |
||
63 | |||
64 | for i := 0 to 1 do |
||
65 | begin |
||
66 | _(100); |
||
67 | _(100); |
||
68 | _(100); |
||
69 | _(100); |
||
70 | |||
71 | _(50); |
||
72 | _(50); |
||
73 | _(50); |
||
74 | _(50); |
||
75 | _(50); |
||
76 | _(50); |
||
77 | _(50); |
||
78 | _(50); |
||
79 | |||
80 | _(25); |
||
81 | _(25); |
||
82 | _(25); |
||
83 | _(25); |
||
84 | _(25); |
||
85 | _(25); |
||
86 | _(25); |
||
87 | _(25); |
||
88 | _(25); |
||
89 | _(25); |
||
90 | _(25); |
||
91 | _(25); |
||
92 | _(25); |
||
93 | _(25); |
||
94 | _(25); |
||
95 | _(25); |
||
96 | end; |
||
97 | end; |
||
98 | |||
99 | function RandomBetween(a, b: integer): integer; |
||
100 | begin |
||
101 | result := RandomRange(a,b+1); |
||
102 | end; |
||
103 | |||
104 | function IsInCircle(p, q: TPoint; pr: integer): boolean; |
||
105 | begin |
||
106 | result := sqrt((p.x-q.x)*(p.x-q.x) + (p.y-q.y)*(p.y-q.y)) <= pr; |
||
107 | end; |
||
108 | |||
109 | procedure TForm1.Button2Click(Sender: TObject); |
||
110 | const |
||
111 | maxB = 50; |
||
112 | r = 30; |
||
113 | maxX = 400; |
||
114 | maxY = 400; |
||
115 | |||
116 | procedure _Draw(p: TPoint); |
||
117 | begin |
||
118 | paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r); |
||
119 | end; |
||
120 | |||
121 | function findRandomOutline(p: TPoint): TPoint; |
||
122 | var |
||
123 | yg, xg: integer; |
||
124 | begin |
||
125 | xg := RandomBetween(p.X-r, p.X+r); |
||
126 | if RandomBetween(0,1) = 0 then |
||
127 | yg := Floor(p.y - sqrt(r*r - (p.x-xg)*(p.x-xg))) |
||
128 | else |
||
129 | yg := Floor(p.y + sqrt(r*r - (p.x-xg)*(p.x-xg))); |
||
130 | result.X := xg; |
||
131 | result.Y := yg; |
||
132 | end; |
||
133 | |||
134 | function CirclesOverlap(p, q: TPoint): boolean; |
||
135 | begin |
||
136 | result := (abs(p.x-q.x) < 2*r) and (abs(p.y-q.y) < 2*r); |
||
137 | end; |
||
138 | |||
139 | var |
||
140 | Circles: array[0..maxB] of TPoint; |
||
141 | i, j: integer; |
||
142 | p: TPoint; |
||
143 | feck: boolean; |
||
144 | begin |
||
145 | paintbox1.Canvas.Rectangle(0,0,maxx,maxy); |
||
146 | |||
147 | Circles[0].X := maxX div 2; |
||
148 | Circles[0].Y := maxY div 2; |
||
149 | _Draw(Circles[0]); |
||
150 | |||
151 | for i := 1 to maxB do |
||
152 | begin |
||
153 | |||
154 | repeat |
||
155 | feck := false; |
||
156 | p := findRandomOutline(Circles[i-1]); |
||
157 | for j := 0 to i-2 do |
||
158 | begin |
||
159 | if CirclesOverlap(p, Circles[j]) then |
||
160 | begin |
||
161 | feck := true; |
||
162 | break; |
||
163 | end; |
||
164 | end; |
||
165 | until not feck; |
||
166 | |||
167 | Circles[i] := p; |
||
168 | _Draw(Circles[i]); |
||
169 | end; |
||
170 | end; |
||
171 | |||
172 | procedure TForm1.FormCreate(Sender: TObject); |
||
173 | begin |
||
174 | Randomize; |
||
175 | end; |
||
176 | |||
177 | procedure TForm1.Button3Click(Sender: TObject); |
||
178 | const |
||
179 | maxB = 50; |
||
180 | r = 30; |
||
181 | maxX = 400; |
||
182 | maxY = 400; |
||
183 | klebfaktor = 0.9; |
||
184 | |||
185 | procedure _Draw(p: TPoint); |
||
186 | begin |
||
187 | paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r); |
||
188 | end; |
||
189 | |||
190 | function findRandomOutline(p: TPoint): TPoint; |
||
191 | var |
||
192 | yg, xg: integer; |
||
193 | newr: integer; |
||
194 | begin |
||
195 | newr := Round(1.5*r); |
||
196 | xg := RandomBetween(p.X-newr, p.X+newr); |
||
197 | if RandomBetween(0,1) = 0 then |
||
198 | yg := Floor(p.y - sqrt(newr*newr - (p.x-xg)*(p.x-xg))) |
||
199 | else |
||
200 | yg := Floor(p.y + sqrt(newr*newr - (p.x-xg)*(p.x-xg))); |
||
201 | result.X := xg; |
||
202 | result.Y := yg; |
||
203 | end; |
||
204 | |||
205 | function CirclesOverlap(p, q: TPoint): boolean; |
||
206 | begin |
||
207 | result := (abs(p.x-q.x) < 2*r) and (abs(p.y-q.y) < 2*r); |
||
208 | end; |
||
209 | |||
210 | var |
||
211 | Circles: array[0..maxB] of TPoint; |
||
212 | i, j: integer; |
||
213 | c: integer; |
||
214 | feck: boolean; |
||
215 | p: tpoint; |
||
216 | begin |
||
217 | memo1.lines.clear; |
||
218 | paintbox1.Canvas.Rectangle(0,0,maxx,maxy); |
||
219 | |||
220 | Circles[0].X := maxX div 2; |
||
221 | Circles[0].Y := maxY div 2; |
||
222 | _Draw(Circles[0]); |
||
223 | |||
224 | |||
225 | |||
226 | for i := 1 to maxB do |
||
227 | begin |
||
228 | c := RandomBetween(0,i-1); |
||
229 | |||
230 | repeat |
||
231 | // memo1.lines.add(IntTostr(i)+ ' -> ' + inttostr(c)); |
||
232 | |||
233 | Circles[i] := findRandomOutline(Circles[c]); |
||
234 | |||
235 | |||
236 | feck := false; |
||
237 | (* |
||
238 | for j := 1 to i-2 do |
||
239 | begin |
||
240 | if CirclesOverlap(Circles[i], Circles[j]) then |
||
241 | begin |
||
242 | inc(fc); |
||
243 | feck := true; |
||
244 | break; |
||
245 | end; |
||
246 | end; |
||
247 | |||
248 | if fc > 100 then |
||
249 | begin |
||
250 | c := RandomBetween(0,i-1); |
||
251 | fc := 0; |
||
252 | end; |
||
253 | *) |
||
254 | |||
255 | // Application.ProcessMessages; |
||
256 | // Sleep(500); |
||
257 | |||
258 | until not feck; |
||
259 | _Draw(Circles[i]); |
||
260 | |||
261 | memo1.lines.add('Draw '+IntTostr(i)+ ' based on ' + inttostr(c)); |
||
262 | |||
263 | end; |
||
264 | |||
265 | exit; |
||
266 | |||
267 | for i := 1 to maxB do |
||
268 | begin |
||
269 | |||
270 | repeat |
||
271 | feck := false; |
||
272 | p := findRandomOutline(Circles[i-1]); |
||
273 | for j := 0 to i-2 do |
||
274 | begin |
||
275 | if CirclesOverlap(p, Circles[j]) then |
||
276 | begin |
||
277 | feck := true; |
||
278 | break; |
||
279 | end; |
||
280 | end; |
||
281 | until not feck; |
||
282 | |||
283 | Circles[i] := p; |
||
284 | _Draw(Circles[i]); |
||
285 | end; |
||
286 | end; |
||
287 | |||
288 | procedure TForm1.Button4Click(Sender: TObject); |
||
289 | const |
||
290 | mapsizex = 400; |
||
291 | mapsizey = 400; |
||
292 | |||
293 | procedure _(size: integer); |
||
294 | var |
||
295 | posx, posy: integer; |
||
296 | begin |
||
297 | posx := Random(mapsizex); |
||
298 | posy := Random(mapsizey); |
||
299 | paintbox1.Canvas.Ellipse(posx, posy, posx+size, posy+size); |
||
300 | end; |
||
301 | |||
302 | var |
||
303 | i: integer; |
||
304 | begin |
||
305 | paintbox1.Canvas.Rectangle(0,0,mapsizex,mapsizey); |
||
306 | |||
307 | for i := 0 to 20 do |
||
308 | begin |
||
309 | _(RandomBetween(10,100)); |
||
310 | end; |
||
311 | end; |
||
312 | |||
313 | procedure TForm1.Button5Click(Sender: TObject); |
||
314 | const |
||
315 | r = 5; |
||
316 | maxX = 545; |
||
317 | maxY = 545; |
||
318 | var |
||
319 | drawnCircles: integer; |
||
320 | |||
321 | procedure _Draw(p: TPoint); |
||
322 | begin |
||
323 | paintbox1.Canvas.Brush.Color := clGray; |
||
324 | paintbox1.Canvas.Pen.Color := clGray; |
||
325 | paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r); |
||
326 | inc(drawnCircles); |
||
327 | |||
328 | // Sleep(10); |
||
329 | // application.processmessages; |
||
330 | end; |
||
331 | |||
332 | function RandBetween(a, b: integer): integer; |
||
333 | begin |
||
334 | result := Random(b-a+1)+a; |
||
335 | end; |
||
336 | |||
337 | procedure BeginAdventure(startx, starty, angle, dep: integer); |
||
338 | const |
||
339 | maxB = 200; |
||
340 | flexi = 25; |
||
341 | maxdep = 2; |
||
342 | anzahlZweige = 2; |
||
343 | rand = 2; |
||
344 | zielBaumZahl = 1000; |
||
345 | var |
||
346 | Circles: array[0..maxB] of TPoint; |
||
347 | Rad: array[0..maxB] of integer; |
||
348 | i: integer; |
||
349 | x: integer; |
||
350 | maxdrawn: integer; |
||
351 | begin |
||
352 | if dep > maxdep then exit; |
||
353 | if drawncircles >= zielBaumZahl then exit; |
||
354 | |||
355 | Rad[0] := angle; |
||
356 | Circles[0].X := startx; |
||
357 | Circles[0].Y := starty; |
||
358 | _Draw(Circles[0]); |
||
359 | |||
360 | repeat |
||
361 | maxdrawn := 0; |
||
362 | for i := 1 to maxB{ div (dep+1)} do |
||
363 | begin |
||
364 | Rad[i] := RandBetween(Rad[i-1]-flexi, Rad[i-1]+flexi); |
||
365 | Circles[i].X := Circles[i-1].X + round(r*cos(Rad[i]/360*2*pi)); |
||
366 | Circles[i].Y := Circles[i-1].Y + round(r*sin(Rad[i]/360*2*pi)); |
||
367 | |||
368 | if Circles[i].X > maxX-rand*r then break; |
||
369 | if Circles[i].Y > maxY-rand*r then break; |
||
370 | if Circles[i].X < rand*r then break; |
||
371 | if Circles[i].Y < rand*r then break; |
||
372 | |||
373 | maxdrawn := i; |
||
374 | end; |
||
375 | until maxdrawn = maxB div (dep+1); |
||
376 | |||
377 | for i := 1 to maxdrawn do |
||
378 | begin |
||
379 | _Draw(Circles[i]); |
||
380 | end; |
||
381 | |||
382 | if maxdrawn > dep*50 then |
||
383 | for i := 1 to anzahlZweige do |
||
384 | begin |
||
385 | x := RandBetween(maxdrawn div 2, maxdrawn); |
||
386 | if RandBetween(0,1)=0 then |
||
387 | BeginAdventure(Circles[x].X, Circles[x].Y, Rad[x]-90, dep+1) |
||
388 | else |
||
389 | BeginAdventure(Circles[x].X, Circles[x].Y, Rad[x]+90, dep+1); |
||
390 | end; |
||
391 | end; |
||
392 | |||
393 | begin |
||
394 | Randomize; |
||
395 | |||
396 | memo1.lines.clear; |
||
397 | drawnCircles := 0; |
||
398 | |||
399 | paintbox1.Canvas.Brush.Color := clGreen; |
||
400 | paintbox1.Canvas.Pen.Color := clBlack; |
||
401 | paintbox1.Canvas.Rectangle(0,0,maxx,maxy); |
||
402 | |||
403 | BeginAdventure(maxX div 2, maxY div 2, RandBetween(0, 360), 0); |
||
404 | end; |
||
405 | |||
406 | procedure TForm1.Button6Click(Sender: TObject); |
||
407 | const |
||
408 | r = 5; |
||
409 | maxX = 545; |
||
410 | maxY = 545; |
||
411 | zielBaumZahl = 1000; |
||
412 | var |
||
413 | drawnCircles: integer; |
||
414 | Circles: array[0..zielBaumZahl-1] of TPoint; |
||
415 | Rad: array[0..zielBaumZahl-1] of integer; |
||
416 | |||
417 | procedure _Draw(p: TPoint); |
||
418 | begin |
||
419 | paintbox1.Canvas.Brush.Color := clGray; |
||
420 | paintbox1.Canvas.Pen.Color := clGray; |
||
421 | paintbox1.Canvas.Ellipse(p.X-r,p.Y-r, p.X+r,p.Y+r); |
||
422 | inc(drawnCircles); |
||
423 | |||
424 | // Sleep(10); |
||
425 | // application.processmessages; |
||
426 | end; |
||
427 | |||
428 | function RandBetween(a, b: integer): integer; |
||
429 | begin |
||
430 | result := Random(b-a+1)+a; |
||
431 | end; |
||
432 | |||
433 | procedure BeginAdventure(startx, starty, angle: integer); |
||
434 | const |
||
435 | maxB = 200; |
||
436 | flexi = 15; |
||
437 | rand = 2; |
||
438 | var |
||
439 | i: integer; |
||
440 | x: integer; |
||
441 | maxdrawn: integer; |
||
442 | beg: integer; |
||
443 | begin |
||
444 | if drawncircles >= zielBaumZahl then exit; |
||
445 | |||
446 | Rad[0] := angle; |
||
447 | Circles[0].X := startx; |
||
448 | Circles[0].Y := starty; |
||
449 | _Draw(Circles[0]); |
||
450 | |||
451 | beg := 1; |
||
452 | |||
453 | while true do |
||
454 | begin |
||
455 | |||
456 | maxdrawn := 0; |
||
457 | for i := beg to beg+maxB do |
||
458 | begin |
||
459 | if i > High(Rad) then Exit; |
||
460 | |||
461 | Rad[i] := RandBetween(Rad[i-1]-flexi, Rad[i-1]+flexi); |
||
462 | Circles[i].X := Circles[i-1].X + round(r*cos(Rad[i]/360*2*pi)); |
||
463 | Circles[i].Y := Circles[i-1].Y + round(r*sin(Rad[i]/360*2*pi)); |
||
464 | |||
465 | if Circles[i].X > maxX-rand*r then break; |
||
466 | if Circles[i].Y > maxY-rand*r then break; |
||
467 | if Circles[i].X < rand*r then break; |
||
468 | if Circles[i].Y < rand*r then break; |
||
469 | |||
470 | _Draw(Circles[i]); |
||
471 | |||
472 | maxdrawn := i; |
||
473 | end; |
||
474 | |||
475 | x := RandBetween(0, maxdrawn); |
||
476 | Circles[maxdrawn+1] := Circles[x]; // virtual tree (not drawn) |
||
477 | |||
478 | if RandBetween(0,1) = 0 then |
||
479 | Rad[maxdrawn+1] := Rad[x]-90 |
||
480 | else |
||
481 | Rad[maxdrawn+1] := Rad[x]+90; |
||
482 | |||
483 | beg := maxdrawn+2; |
||
484 | |||
485 | end; |
||
486 | end; |
||
487 | |||
488 | begin |
||
489 | Randomize; |
||
490 | |||
491 | memo1.lines.clear; |
||
492 | drawnCircles := 0; |
||
493 | |||
494 | paintbox1.Canvas.Brush.Color := clGreen; |
||
495 | paintbox1.Canvas.Pen.Color := clBlack; |
||
496 | paintbox1.Canvas.Rectangle(0,0,maxx,maxy); |
||
497 | |||
498 | BeginAdventure(maxX div 2, maxY div 2, RandBetween(0, 360)); |
||
499 | end; |
||
500 | |||
501 | |||
502 | function TreePos(nTrees, treeRadius, mapX, mapY: integer; memblock: Pointer; debug: boolean): dword; cdecl; external 'd:\tdn\mapgen\mapgen32.dll'; |
||
503 | |||
504 | procedure DrawCircle(x, y, r: integer); |
||
505 | begin |
||
506 | form1.paintbox1.Canvas.Brush.Color := clMaroon; |
||
507 | form1.paintbox1.Canvas.Pen.Color := clMaroon; |
||
508 | form1.paintbox1.Canvas.Ellipse(X-r,Y-r, X+r,Y+r); |
||
509 | end; |
||
510 | |||
511 | procedure TForm1.Button7Click(Sender: TObject); |
||
512 | const |
||
513 | miniature_factor = 20; // only viewer |
||
514 | treeradius = 100; |
||
515 | ntrees = 5000; |
||
516 | mapX = 10000; |
||
517 | mapY = 10000; |
||
518 | var |
||
519 | i: integer; |
||
520 | mb: array[0..ntrees-1, 0..1] of dword; |
||
521 | begin |
||
522 | paintbox1.Repaint; |
||
523 | |||
524 | TreePos(ntrees, treeradius, mapx, mapy, @mb[0][0], checkbox1.checked); |
||
525 | |||
526 | paintbox1.Canvas.Brush.Color := clGreen; |
||
527 | paintbox1.Canvas.Pen.Color := clBlack; |
||
528 | paintbox1.Canvas.Rectangle(0,0,mapx div miniature_factor,mapy div miniature_factor); |
||
529 | |||
530 | for i := 0 to ntrees-1 do |
||
531 | begin |
||
532 | DrawCircle(mb[i][0] div miniature_factor, mb[i][1] div miniature_factor, treeradius div miniature_factor); |
||
533 | end; |
||
534 | end; |
||
535 | |||
536 | end. |