hedgewars/uLand.pas
changeset 155 401f4ea24715
parent 109 ab0340f580c2
child 160 207f520b9e83
equal deleted inserted replaced
154:5667e6f38704 155:401f4ea24715
    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, uGears;
    36 uses SDLh, uGears, uLandTemplates;
    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      TPreview = packed array[0..127, 0..31] of byte;
    39 
    40 
    40 var  Land: TLandArray;
    41 var  Land: TLandArray;
    41      LandSurface: PSDL_Surface;
    42      LandSurface: PSDL_Surface;
       
    43      Preview: TPreview;
    42 
    44 
    43 procedure GenMap;
    45 procedure GenMap;
       
    46 procedure GenPreview;
       
    47 
    44 
    48 
    45 implementation
    49 implementation
    46 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates, uLandObjects;
    50 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandObjects;
    47 
    51 
    48 type TPixAr = record
    52 type TPixAr = record
    49               Count: Longword;
    53               Count: Longword;
    50               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    54               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    51               end;
    55               end;
   418 end;
   422 end;
   419 
   423 
   420 procedure GenBlank(var Template: TEdgeTemplate);
   424 procedure GenBlank(var Template: TEdgeTemplate);
   421 var pa: TPixAr;
   425 var pa: TPixAr;
   422     i: Longword;
   426     i: Longword;
   423 begin
   427     y, x: Longword;
       
   428 begin
       
   429 for y:= 0 to 1023 do
       
   430     for x:= 0 to 2047 do
       
   431         Land[y, x]:= COLOR_LAND;
       
   432 
   424 with Template do
   433 with Template do
   425      begin
   434      begin
   426      if canMirror then
   435      if canMirror then
   427         if getrandom(16) < 8 then
   436         if getrandom(16) < 8 then
   428            begin
   437            begin
   460      end;
   469      end;
   461 end;
   470 end;
   462 
   471 
   463 procedure GenLandSurface;
   472 procedure GenLandSurface;
   464 var tmpsurf: PSDL_Surface;
   473 var tmpsurf: PSDL_Surface;
   465     y, x: Longword;
       
   466 begin
   474 begin
   467 WriteLnToConsole('Generating land...');
   475 WriteLnToConsole('Generating land...');
   468 for y:= 0 to 1023 do
   476 
   469     for x:= 0 to 2047 do
       
   470         Land[y, x]:= COLOR_LAND;
       
   471 GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
   477 GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
   472 
   478 
   473 AddProgress;
   479 AddProgress;
   474 with PixelFormat^ do
   480 with PixelFormat^ do
   475      tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   481      tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   560                                else MakeFortsMap;
   566                                else MakeFortsMap;
   561 AddProgress;
   567 AddProgress;
   562 {$IFDEF DEBUGFILE}LogLandDigest{$ENDIF}
   568 {$IFDEF DEBUGFILE}LogLandDigest{$ENDIF}
   563 end;
   569 end;
   564 
   570 
       
   571 procedure GenPreview;
       
   572 var x, y, xx, yy, t, bit: integer;
       
   573 begin
       
   574 GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
       
   575 
       
   576 for y:= 0 to 127 do
       
   577     for x:= 0 to 31 do
       
   578         begin
       
   579         Preview[y, x]:= 0;
       
   580         for bit:= 0 to 7 do
       
   581             begin
       
   582             t:= 0;
       
   583             for yy:= y * 8 to y * 8 + 7 do
       
   584                 for xx:= x * 64 + bit * 8 to x * 64 + bit * 8 + 7 do
       
   585                     if Land[yy, xx] <> 0 then inc(t);
       
   586             if t > 31 then Preview[y, x]:= Preview[y, x] or ($80 shr bit) 
       
   587             end
       
   588         end
       
   589 end;
       
   590 
   565 initialization
   591 initialization
   566 
   592 
   567 end.
   593 end.