hedgewars/uLand.pas
changeset 70 82d93eeecebe
parent 67 3101306251e5
child 74 42257fee61ae
equal deleted inserted replaced
69:d8a526934b9f 70:82d93eeecebe
     1 (*
     1 (*
     2  * Hedgewars, a worms-like game
     2  * Hedgewars, a worms-like game
     3  * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>
     3  * Copyright (c) 2005, 2006 Andrey Korotaev <unC0Rr@gmail.com>
     4  *
     4  *
     5  * Distributed under the terms of the BSD-modified licence:
     5  * Distributed under the terms of the BSD-modified licence:
     6  *
     6  *
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
     8  * of this software and associated documentation files (the "Software"), to deal
     8  * of this software and associated documentation files (the "Software"), to deal
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    32  *)
    32  *)
    33 
    33 
    34 unit uLand;
    34 unit uLand;
    35 interface
    35 interface
    36 uses SDLh;
    36 uses SDLh, uGears;
    37 {$include options.inc}
    37 {$include options.inc}
    38 type TLandArray = packed array[0..1023, 0..2047] of LongWord;
    38 type TLandArray = packed array[0..1023, 0..2047] of LongWord;
    39 
    39 
    40 var  Land: TLandArray;
    40 var  Land: TLandArray;
    41      LandSurface: PSDL_Surface;
    41      LandSurface: PSDL_Surface;
    42 
    42 
    43 procedure AddHHPoint(_x, _y: integer);
       
    44 procedure GetHHPoint(out _x, _y: integer);
       
    45 procedure RandomizeHHPoints;
       
    46 procedure GenMap;
    43 procedure GenMap;
    47 
    44 
    48 implementation
    45 implementation
    49 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates, uLandObjects, uSHA;
    46 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates, uLandObjects, uSHA;
    50 
    47 
    51 type TPixAr = record
    48 type TPixAr = record
    52               Count: Longword;
    49               Count: Longword;
    53               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    50               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    54               end;
       
    55 
       
    56 var HHPoints: record
       
    57               First, Last: word;
       
    58               ar: array[1..Pred(cMaxSpawnPoints)] of TPoint
       
    59               end;
    51               end;
    60 
    52 
    61 procedure LogLandDigest;
    53 procedure LogLandDigest;
    62 var ctx: TSHA1Context;
    54 var ctx: TSHA1Context;
    63     dig: TSHA1Digest;
    55     dig: TSHA1Digest;
   331       yd:= yu - 1;
   323       yd:= yu - 1;
   332     until yd < 0;
   324     until yd < 0;
   333     end;
   325     end;
   334 end;
   326 end;
   335 
   327 
   336 procedure AddHHPoints;
       
   337 var x, y, t: integer;
       
   338 
       
   339     function CountNonZeroz(x, y: integer): integer;
       
   340     var i: integer;
       
   341     begin
       
   342     Result:= 0;
       
   343     if (y and $FFFFFC00) <> 0 then exit;
       
   344     for i:= max(x - 5, 0) to min(x + 5, 2043) do
       
   345         if Land[y, i] <> 0 then inc(Result)
       
   346     end;
       
   347 
       
   348 begin
       
   349 x:= 40;
       
   350 while x < 2010 do
       
   351     begin
       
   352     y:= -24;
       
   353     while y < 1023 do
       
   354           begin
       
   355           repeat
       
   356           inc(y, 2);
       
   357           until (y > 1023) or (CountNonZeroz(x, y) = 0);
       
   358           t:= 0;
       
   359           repeat
       
   360           inc(y, 2);
       
   361           inc(t, 2)
       
   362           until (y > 1023) or (CountNonZeroz(x, y) <> 0);
       
   363           if (t > 22) and (y < 1023) then AddHHPoint(x, y - 12);
       
   364           inc(y, 80)
       
   365           end;
       
   366     inc(x, 100)
       
   367     end;
       
   368 
       
   369 if HHPoints.Last < cMaxHHs then
       
   370    begin
       
   371    AddHHPoint(300, 800);
       
   372    AddHHPoint(400, 800);
       
   373    AddHHPoint(500, 800);
       
   374    AddHHPoint(600, 800);
       
   375    AddHHPoint(700, 800);
       
   376    AddHHPoint(800, 800);
       
   377    AddHHPoint(900, 800);
       
   378    AddHHPoint(1000, 800);
       
   379    AddHHPoint(1100, 800);
       
   380    AddHHPoint(1200, 800);
       
   381    AddHHPoint(1300, 800);
       
   382    AddHHPoint(1400, 800);
       
   383    end;
       
   384 end;
       
   385 
       
   386 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   328 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   387 const MAXPASSES = 32;
   329 const MAXPASSES = 32;
   388 var ar: array[0..MAXPASSES, 0..5] of real;
   330 var ar: array[0..MAXPASSES, 0..5] of real;
   389     i, k: integer;
   331     i, k: integer;
   390     rx, ry, oy: real;
   332     rx, ry, oy: real;
   536      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   478      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   537 TryDo(LandSurface <> nil, 'Error creating land surface', true);
   479 TryDo(LandSurface <> nil, 'Error creating land surface', true);
   538 SDL_FillRect(LandSurface, nil, 0);
   480 SDL_FillRect(LandSurface, nil, 0);
   539 AddProgress;
   481 AddProgress;
   540 
   482 
   541 AddObjects(LandSurface);
       
   542 
       
   543 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
   483 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
   544 SDL_UpperBlit(tmpsurf, nil, LandSurface, nil);
   484 AddObjects(tmpsurf, LandSurface);
   545 SDL_FreeSurface(tmpsurf);
   485 SDL_FreeSurface(tmpsurf);
   546 AddProgress;
   486 
   547 AddHHPoints;
   487 AddProgress
   548 RandomizeHHPoints;
       
   549 end;
   488 end;
   550 
   489 
   551 procedure MakeFortsMap;
   490 procedure MakeFortsMap;
   552 var p: PTeam;
   491 var p: PTeam;
   553     tmpsurf: PSDL_Surface;
   492     tmpsurf: PSDL_Surface;
   559      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   498      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   560 SDL_FillRect(LandSurface, nil, 0);
   499 SDL_FillRect(LandSurface, nil, 0);
   561 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'L.png', false);
   500 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'L.png', false);
   562 BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
   501 BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
   563 SDL_FreeSurface(tmpsurf);
   502 SDL_FreeSurface(tmpsurf);
   564 LoadFortPoints(p.FortName, false, TeamSize(p));
       
   565 p:= p.Next;
   503 p:= p.Next;
   566 TryDo(p <> nil, 'Only one team on map!', true);
   504 TryDo(p <> nil, 'Only one team on map!', true);
   567 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'R.png', false);
   505 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'R.png', false);
   568 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
   506 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
   569 SDL_FreeSurface(tmpsurf);
   507 SDL_FreeSurface(tmpsurf);
   570 LoadFortPoints(p.FortName, true, TeamSize(p));
       
   571 p:= p.Next;
   508 p:= p.Next;
   572 TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
   509 TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
   573 end;
   510 end;
   574 
   511 
   575 procedure LoadMap;
   512 procedure LoadMap;
   611             inc(p, LandSurface.pitch);
   548             inc(p, LandSurface.pitch);
   612             end;
   549             end;
   613      end;
   550      end;
   614 if SDL_MustLock(LandSurface) then
   551 if SDL_MustLock(LandSurface) then
   615    SDL_UnlockSurface(LandSurface);
   552    SDL_UnlockSurface(LandSurface);
   616 
       
   617 AddHHPoints;
       
   618 RandomizeHHPoints;
       
   619 end;
   553 end;
   620 
   554 
   621 procedure GenMap;
   555 procedure GenMap;
   622 begin
   556 begin
   623 if (GameFlags and gfForts) = 0 then
   557 if (GameFlags and gfForts) = 0 then
   626                                else MakeFortsMap;
   560                                else MakeFortsMap;
   627 AddProgress;
   561 AddProgress;
   628 {$IFDEF DEBUGFILE}LogLandDigest{$ENDIF}
   562 {$IFDEF DEBUGFILE}LogLandDigest{$ENDIF}
   629 end;
   563 end;
   630 
   564 
   631 procedure AddHHPoint(_x, _y: integer);
       
   632 begin
       
   633 with HHPoints do
       
   634      begin
       
   635      inc(Last);
       
   636      TryDo(Last < cMaxSpawnPoints, 'HHs coords queue overflow', true);
       
   637      with ar[Last] do
       
   638           begin
       
   639           x:= _x;
       
   640           y:= _y
       
   641           end
       
   642      end
       
   643 end;
       
   644 
       
   645 procedure GetHHPoint(out _x, _y: integer);
       
   646 begin
       
   647 with HHPoints do
       
   648      begin
       
   649      TryDo(First <= Last, 'HHs coords queue underflow ' + inttostr(First), true);
       
   650      with ar[First] do
       
   651           begin
       
   652           _x:= x;
       
   653           _y:= y
       
   654           end;
       
   655      inc(First)
       
   656      end
       
   657 end;
       
   658 
       
   659 procedure RandomizeHHPoints;
       
   660 var i, t: integer;
       
   661     p: TPoint;
       
   662 begin
       
   663 with HHPoints do
       
   664      begin
       
   665      for i:= First to Last do
       
   666          begin
       
   667          t:= GetRandom(Last - First + 1) + First;
       
   668          if i <> t then
       
   669             begin
       
   670             p:= ar[i];
       
   671             ar[i]:= ar[t];
       
   672             ar[t]:= p
       
   673             end
       
   674          end
       
   675      end
       
   676 end;
       
   677 
       
   678 initialization
   565 initialization
   679 
   566 
   680 HHPoints.First:= 1
       
   681 
       
   682 end.
   567 end.