hedgewars/uLand.pas
changeset 107 b08ce0293a51
parent 102 c45643d3fd78
child 109 ab0340f580c2
equal deleted inserted replaced
106:98cb6606bf67 107:b08ce0293a51
    64 {$ENDIF}
    64 {$ENDIF}
    65 end;
    65 end;
    66 
    66 
    67 procedure DrawBezierEdge(var pa: TPixAr; Color: Longword);
    67 procedure DrawBezierEdge(var pa: TPixAr; Color: Longword);
    68 var x, y, i: integer;
    68 var x, y, i: integer;
    69     tx, ty, vx, vy, vlen, t: real;
    69     tx, ty, vx, vy, vlen, t: Double;
    70     r1, r2, r3, r4: real;
    70     r1, r2, r3, r4: Double;
    71     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real;
    71     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: Double;
    72 begin
    72 begin
    73 vx:= 0;
    73 vx:= 0;
    74 vy:= 0;
    74 vy:= 0;
    75 with pa do
    75 with pa do
    76 for i:= 0 to Count-2 do
    76 for i:= 0 to Count-2 do
   124                 Land[y, x]:= Color;
   124                 Land[y, x]:= Color;
   125           end;
   125           end;
   126     end;
   126     end;
   127 end;
   127 end;
   128 
   128 
   129 procedure BezierizeEdge(var pa: TPixAr; Delta: real);
   129 procedure BezierizeEdge(var pa: TPixAr; Delta: Double);
   130 var x, y, i: integer;
   130 var x, y, i: integer;
   131     tx, ty, vx, vy, vlen, t: real;
   131     tx, ty, vx, vy, vlen, t: Double;
   132     r1, r2, r3, r4: real;
   132     r1, r2, r3, r4: Double;
   133     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real;
   133     x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: Double;
   134     opa: TPixAr;
   134     opa: TPixAr;
   135 begin
   135 begin
   136 opa:= pa;
   136 opa:= pa;
   137 pa.Count:= 0;
   137 pa.Count:= 0;
   138 vx:= 0;
   138 vx:= 0;
   325     end;
   325     end;
   326 end;
   326 end;
   327 
   327 
   328 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   328 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   329 const MAXPASSES = 32;
   329 const MAXPASSES = 32;
   330 var ar: array[0..MAXPASSES, 0..5] of real;
   330 var ar: array[0..MAXPASSES, 0..5] of Double;
   331     i, k: integer;
   331     i, k: integer;
   332     rx, ry, oy: real;
   332     rx, ry, oy: Double;
   333     PassesNum: Longword;
   333     PassesNum: Longword;
   334 begin
   334 begin
   335 with Template do
   335 with Template do
   336      begin
   336      begin
   337      PassesNum:= PassMin + getrandom(PassDelta);
   337      PassesNum:= PassMin + getrandom(PassDelta);
   510 p:= p.Next;
   510 p:= p.Next;
   511 TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
   511 TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
   512 end;
   512 end;
   513 
   513 
   514 procedure LoadMap;
   514 procedure LoadMap;
   515 var p, x, y, i: Longword;
   515 var x, y: Longword;
       
   516     p: PByteArray;
   516 begin
   517 begin
   517 WriteLnToConsole('Loading land from file...');
   518 WriteLnToConsole('Loading land from file...');
   518 AddProgress;
   519 AddProgress;
   519 LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false);
   520 LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false);
   520 TryDo((LandSurface.w = 2048) and (LandSurface.h = 1024), 'Map dimensions should be 2048x1024!', true);
   521 TryDo((LandSurface.w = 2048) and (LandSurface.h = 1024), 'Map dimensions should be 2048x1024!', true);
   521 
   522 
   522 if SDL_MustLock(LandSurface) then
   523 if SDL_MustLock(LandSurface) then
   523    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
   524    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
   524 
   525 
   525 p:= Longword(LandSurface.pixels);
   526 p:= LandSurface.pixels;
   526 i:= Longword(@Land);
       
   527 case LandSurface.format.BytesPerPixel of
   527 case LandSurface.format.BytesPerPixel of
   528      1: OutError('We don''t work with 8 bit surfaces', true);
   528      1: OutError('We don''t work with 8 bit surfaces', true);
   529      2: for y:= 0 to 1023 do
   529      2: for y:= 0 to 1023 do
   530             begin
   530             begin
   531             for x:= 0 to 2047 do
   531             for x:= 0 to 2047 do
   532                 if PWord(p + x * 2)^ <> 0 then PLongWord(i + x * 4)^:= COLOR_LAND;
   532                 if PWord(@p[x * 2])^ <> 0 then Land[y, x]:= COLOR_LAND;
   533             inc(i, 2048 * 4);
   533             p:= @p[LandSurface.pitch];
   534             inc(p, LandSurface.pitch);
       
   535             end;
   534             end;
   536      3: for y:= 0 to 1023 do
   535      3: for y:= 0 to 1023 do
   537             begin
   536             begin
   538             for x:= 0 to 2047 do
   537             for x:= 0 to 2047 do
   539                 if  (PByte(p + x * 3 + 0)^ <> 0)
   538                 if  (p[x * 3 + 0] <> 0)
   540                  or (PByte(p + x * 3 + 1)^ <> 0)
   539                  or (p[x * 3 + 1] <> 0)
   541                  or (PByte(p + x * 3 + 2)^ <> 0) then PLongWord(i + x * 4)^:= COLOR_LAND;
   540                  or (p[x * 3 + 2] <> 0) then Land[y, x]:= COLOR_LAND;
   542             inc(i, 2048 * 4);
   541             p:= @p[LandSurface.pitch];
   543             inc(p, LandSurface.pitch);
       
   544             end;
   542             end;
   545      4: for y:= 0 to 1023 do
   543      4: for y:= 0 to 1023 do
   546             begin
   544             begin
   547             for x:= 0 to 2047 do
   545             for x:= 0 to 2047 do
   548                 if PLongword(p + x * 4)^ <> 0 then PLongWord(i + x * 4)^:= COLOR_LAND;
   546                 if PLongword(@p[x * 4])^ <> 0 then Land[y, x]:= COLOR_LAND;
   549             inc(i, 2048 * 4);
   547             p:= @p[LandSurface.pitch];
   550             inc(p, LandSurface.pitch);
       
   551             end;
   548             end;
   552      end;
   549      end;
   553 if SDL_MustLock(LandSurface) then
   550 if SDL_MustLock(LandSurface) then
   554    SDL_UnlockSurface(LandSurface);
   551    SDL_UnlockSurface(LandSurface);
   555 end;
   552 end;