448 {$I+} |
447 {$I+} |
449 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true); |
448 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true); |
450 AddProgress; |
449 AddProgress; |
451 end; |
450 end; |
452 |
451 |
453 procedure AddThemeObjects(var ThemeObjects: TThemeObjects; MaxCount: LongInt); |
452 procedure AddThemeObjects(var ThemeObjects: TThemeObjects); |
454 var i, ii, t: LongInt; |
453 var i, ii, t: LongInt; |
455 b: boolean; |
454 b: boolean; |
456 begin |
455 begin |
457 if ThemeObjects.Count = 0 then exit; |
456 if ThemeObjects.Count = 0 then exit; |
458 WriteLnToConsole('Adding theme objects...'); |
457 WriteLnToConsole('Adding theme objects...'); |
459 |
458 |
460 for i:=0 to ThemeObjects.Count do |
459 for i:=0 to ThemeObjects.Count do |
461 ThemeObjects.objs[i].Maxcnt := max(1, (ThemeObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
460 ThemeObjects.objs[i].Maxcnt := max(1, (ThemeObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
462 |
461 |
463 t := getrandom(1024); |
|
464 repeat |
462 repeat |
|
463 t := getrandom(ThemeObjects.Count); |
465 b := false; |
464 b := false; |
466 for i:=0 to ThemeObjects.Count do |
465 for i:=0 to ThemeObjects.Count do |
467 begin |
466 begin |
468 ii := (i+t) mod ThemeObjects.Count; |
467 ii := (i+t) mod ThemeObjects.Count; |
469 |
468 |
471 b := b or TryPut(ThemeObjects.objs[ii]) |
470 b := b or TryPut(ThemeObjects.objs[ii]) |
472 end; |
471 end; |
473 until not b; |
472 until not b; |
474 end; |
473 end; |
475 |
474 |
476 procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects; MaxCount: Longword); |
475 procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects); |
477 var i: Longword; |
476 var i, ii, t: LongInt; |
478 ii, t: LongInt; |
|
479 b: boolean; |
477 b: boolean; |
480 begin |
478 begin |
481 if SprayObjects.Count = 0 then exit; |
479 if SprayObjects.Count = 0 then exit; |
482 WriteLnToConsole('Adding spray objects...'); |
480 WriteLnToConsole('Adding spray objects...'); |
483 i:= 1; |
481 |
484 repeat |
482 for i:=0 to SprayObjects.Count do |
485 t:= getrandom(SprayObjects.Count); |
483 SprayObjects.objs[i].Maxcnt := max(1, (SprayObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map |
486 ii:= t; |
484 |
487 repeat |
485 repeat |
488 inc(ii); |
486 t := getrandom(SprayObjects.Count); |
489 if ii = SprayObjects.Count then ii:= 0; |
487 b := false; |
490 b:= TryPut(SprayObjects.objs[ii], Surface) |
488 for i:=0 to SprayObjects.Count do |
491 until b or (ii = t); |
489 begin |
492 inc(i) |
490 ii := (i+t) mod SprayObjects.Count; |
493 until (i > MaxCount) or not b; |
491 |
|
492 if SprayObjects.objs[ii].Maxcnt <> 0 then |
|
493 b := b or TryPut(SprayObjects.objs[ii], Surface) |
|
494 end; |
|
495 until not b; |
494 end; |
496 end; |
495 |
497 |
496 procedure AddObjects(); |
498 procedure AddObjects(); |
497 var i, int: Longword; |
499 var i, int: Longword; |
498 begin |
500 begin |
504 repeat |
506 repeat |
505 AddGirder(i); |
507 AddGirder(i); |
506 i:=i+int; |
508 i:=i+int; |
507 until (i>rightX-int); |
509 until (i>rightX-int); |
508 end; |
510 end; |
509 AddThemeObjects(ThemeObjects, (8 * MaxHedgehogs) div 18); // MaxHedgehogs should roughly correspond to available surface area. Was also thinking maybe using playHeight * playWidth div constant :) |
511 AddThemeObjects(ThemeObjects); |
510 AddProgress(); |
512 AddProgress(); |
511 FreeRects(); |
513 FreeRects(); |
512 end; |
514 end; |
513 |
515 |
514 procedure AddOnLandObjects(Surface: PSDL_Surface); |
516 procedure AddOnLandObjects(Surface: PSDL_Surface); |
515 begin |
517 begin |
516 InitRects; |
518 InitRects; |
517 //AddSprayObjects(Surface, SprayObjects, 12); |
519 //AddSprayObjects(Surface, SprayObjects, 12); |
518 AddSprayObjects(Surface, SprayObjects, (2 * MaxHedgehogs) div 3); |
520 AddSprayObjects(Surface, SprayObjects); |
519 FreeRects |
521 FreeRects |
520 end; |
522 end; |
521 |
523 |
522 procedure LoadThemeConfig; |
524 procedure LoadThemeConfig; |
523 begin |
525 begin |