hedgewars/uLandObjects.pas
changeset 371 731ad6d27bd1
parent 351 29bc9c36ad5f
child 393 db01cc79f278
equal deleted inserted replaced
370:c75410fe3133 371:731ad6d27bd1
    39                     rectcnt: Longword;
    39                     rectcnt: Longword;
    40                     Width, Height: Longword;
    40                     Width, Height: Longword;
    41                     Maxcnt: Longword;
    41                     Maxcnt: Longword;
    42                     end;
    42                     end;
    43      TThemeObjects = record
    43      TThemeObjects = record
    44                      Count: integer;
    44                      Count: LongInt;
    45                      objs: array[0..Pred(MAXTHEMEOBJECTS)] of TThemeObject;
    45                      objs: array[0..Pred(MAXTHEMEOBJECTS)] of TThemeObject;
    46                      end;
    46                      end;
    47      TSprayObject = record
    47      TSprayObject = record
    48                     Surf: PSDL_Surface;
    48                     Surf: PSDL_Surface;
    49                     Width, Height: Longword;
    49                     Width, Height: Longword;
    50                     Maxcnt: Longword;
    50                     Maxcnt: Longword;
    51                     end;
    51                     end;
    52      TSprayObjects = record
    52      TSprayObjects = record
    53                      Count: integer;
    53                      Count: LongInt;
    54                      objs: array[0..Pred(MAXTHEMEOBJECTS)] of TSprayObject
    54                      objs: array[0..Pred(MAXTHEMEOBJECTS)] of TSprayObject
    55                      end;
    55                      end;
    56 
    56 
    57 var Rects: PRectArray;
    57 var Rects: PRectArray;
    58     RectCount: Longword;
    58     RectCount: Longword;
    59 
    59 
    60 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
    60 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
    61 var p: PByteArray;
    61 var p: PByteArray;
    62     x, y: Longword;
    62     x, y: Longword;
    63     bpp: integer;
    63     bpp: LongInt;
    64     r: TSDL_Rect;
    64     r: TSDL_Rect;
    65 begin
    65 begin
    66 r.x:= cpX;
    66 r.x:= cpX;
    67 r.y:= cpY;
    67 r.y:= cpY;
    68 SDL_UpperBlit(Image, nil, Surface, @r);
    68 SDL_UpperBlit(Image, nil, Surface, @r);
   100 if SDL_MustLock(Image) then
   100 if SDL_MustLock(Image) then
   101    SDL_UnlockSurface(Image);
   101    SDL_UnlockSurface(Image);
   102 WriteLnToConsole(msgOK)
   102 WriteLnToConsole(msgOK)
   103 end;
   103 end;
   104 
   104 
   105 procedure AddRect(x1, y1, w1, h1: integer);
   105 procedure AddRect(x1, y1, w1, h1: LongInt);
   106 begin
   106 begin
   107 with Rects^[RectCount] do
   107 with Rects^[RectCount] do
   108      begin
   108      begin
   109      x:= x1;
   109      x:= x1;
   110      y:= y1;
   110      y:= y1;
   124 procedure FreeRects;
   124 procedure FreeRects;
   125 begin
   125 begin
   126 Dispose(rects)
   126 Dispose(rects)
   127 end;
   127 end;
   128 
   128 
   129 function CheckIntersect(x1, y1, w1, h1: integer): boolean;
   129 function CheckIntersect(x1, y1, w1, h1: LongInt): boolean;
   130 var i: Longword;
   130 var i: Longword;
   131     Result: boolean;
   131     Result: boolean;
   132 begin
   132 begin
   133 Result:= false;
   133 Result:= false;
   134 i:= 0;
   134 i:= 0;
   140    inc(i)
   140    inc(i)
   141    until (i = RectCount) or (Result);
   141    until (i = RectCount) or (Result);
   142 CheckIntersect:= Result
   142 CheckIntersect:= Result
   143 end;
   143 end;
   144 
   144 
   145 function AddGirder(gX: integer; Surface: PSDL_Surface): boolean;
   145 function AddGirder(gX: LongInt; Surface: PSDL_Surface): boolean;
   146 var tmpsurf: PSDL_Surface;
   146 var tmpsurf: PSDL_Surface;
   147     x1, x2, y, k, i: integer;
   147     x1, x2, y, k, i: LongInt;
   148     r, rr: TSDL_Rect;
   148     r, rr: TSDL_Rect;
   149     Result: boolean;
   149     Result: boolean;
   150 
   150 
   151     function CountNonZeroz(x, y: integer): Longword;
   151     function CountNonZeroz(x, y: LongInt): Longword;
   152     var i: integer;
   152     var i: LongInt;
   153         Result: Longword;
   153         Result: Longword;
   154     begin
   154     begin
   155     Result:= 0;
   155     Result:= 0;
   156     for i:= y to y + 15 do
   156     for i:= y to y + 15 do
   157         if Land[i, x] <> 0 then inc(Result);
   157         if Land[i, x] <> 0 then inc(Result);
   350 end;
   350 end;
   351 
   351 
   352 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   352 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   353 var s: string;
   353 var s: string;
   354     f: textfile;
   354     f: textfile;
   355     i, ii: integer;
   355     i, ii: LongInt;
   356 begin
   356 begin
   357 s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
   357 s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;
   358 WriteLnToConsole('Reading objects info...');
   358 WriteLnToConsole('Reading objects info...');
   359 Assign(f, s);
   359 Assign(f, s);
   360 {$I-}
   360 {$I-}
   393 Close(f);
   393 Close(f);
   394 {$I+}
   394 {$I+}
   395 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true)
   395 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true)
   396 end;
   396 end;
   397 
   397 
   398 procedure AddThemeObjects(Surface: PSDL_Surface; var ThemeObjects: TThemeObjects; MaxCount: integer);
   398 procedure AddThemeObjects(Surface: PSDL_Surface; var ThemeObjects: TThemeObjects; MaxCount: LongInt);
   399 var i, ii, t: integer;
   399 var i, ii, t: LongInt;
   400     b: boolean;
   400     b: boolean;
   401 begin
   401 begin
   402 if ThemeObjects.Count = 0 then exit;
   402 if ThemeObjects.Count = 0 then exit;
   403 WriteLnToConsole('Adding theme objects...');
   403 WriteLnToConsole('Adding theme objects...');
   404 i:= 1;
   404 i:= 1;
   414 until (i > MaxCount) or not b;
   414 until (i > MaxCount) or not b;
   415 end;
   415 end;
   416 
   416 
   417 procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects; MaxCount: Longword);
   417 procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects; MaxCount: Longword);
   418 var i: Longword;
   418 var i: Longword;
   419     ii, t: integer;
   419     ii, t: LongInt;
   420     b: boolean;
   420     b: boolean;
   421 begin
   421 begin
   422 if SprayObjects.Count = 0 then exit;
   422 if SprayObjects.Count = 0 then exit;
   423 WriteLnToConsole('Adding spray objects...');
   423 WriteLnToConsole('Adding spray objects...');
   424 i:= 1;
   424 i:= 1;