Add theme objects to land
authorunc0rr
Mon, 05 Dec 2005 21:46:15 +0000
changeset 24 79c411363184
parent 23 16322d14f068
child 25 27aa8030322b
Add theme objects to land
hedgewars/Data/Themes/avematan/theme.cfg
hedgewars/Data/Themes/bubbles/theme.cfg
hedgewars/Data/Themes/tibet/theme.cfg
hedgewars/Data/Themes/xtheme/theme.cfg
hedgewars/hw.dpr
hedgewars/uGears.pas
hedgewars/uLand.pas
hedgewars/uLandObjects.pas
hedgewars/uLandTemplates.pas
hedgewars/uMisc.pas
--- a/hedgewars/Data/Themes/avematan/theme.cfg	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/Data/Themes/avematan/theme.cfg	Mon Dec 05 21:46:15 2005 +0000
@@ -1,8 +1,6 @@
 8388608
-3
+2
 a
-2 65 45
+186 221 65 220 45 1 1 0 0 186 180
 e
-2 56 33
-ksi
-2 82 17
+150 181 56 180 33 1 2 0 65 117 90 65 0 95 118
--- a/hedgewars/Data/Themes/bubbles/theme.cfg	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/Data/Themes/bubbles/theme.cfg	Mon Dec 05 21:46:15 2005 +0000
@@ -1,4 +1,4 @@
 2829989
 1
 round
-2 91 10
\ No newline at end of file
+167 242 90 242 10 1 3 0 0 97 97 63 61 95 115 100 190 67 26
\ No newline at end of file
--- a/hedgewars/Data/Themes/tibet/theme.cfg	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/Data/Themes/tibet/theme.cfg	Mon Dec 05 21:46:15 2005 +0000
@@ -1,12 +1,12 @@
 4989440
 5
 chha
-2 65 10
+167 127 26 118 94 9 2 5 9 127 94 135 2 29 29
 ma
-2 90 20
+145 117 88 98 22 11 2 9 4 105 90 120 1 23 25
 nga
-2 115 8
+131 111 115 95 11 13 2 7 6 95 91 105 6 18 17
 sa
-2 100 20
+153 111 2 83 14 12 2 9 9 140 57 25 65 96 40
 ta1
-2 61 10
\ No newline at end of file
+125 139 58 130 16 8 1 5 7 119 100
\ No newline at end of file
--- a/hedgewars/Data/Themes/xtheme/theme.cfg	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/Data/Themes/xtheme/theme.cfg	Mon Dec 05 21:46:15 2005 +0000
@@ -1,4 +1,4 @@
 8388608
 1
 plant1
-2 37 25
\ No newline at end of file
+128 128 35 127 29 1 2 12 7 63 108 75 26 49 52
\ No newline at end of file
--- a/hedgewars/hw.dpr	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/hw.dpr	Mon Dec 05 21:46:15 2005 +0000
@@ -53,7 +53,8 @@
   uAIAmmoTests in 'uAIAmmoTests.pas',
   uCollisions in 'uCollisions.pas',
   uLand in 'uLand.pas',
-  uLandTemplates in 'uLandTemplates.pas';
+  uLandTemplates in 'uLandTemplates.pas',
+  uLandObjects in 'uLandObjects.pas';
 
 {$INCLUDE options.inc}
 
--- a/hedgewars/uGears.pas	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/uGears.pas	Mon Dec 05 21:46:15 2005 +0000
@@ -603,7 +603,7 @@
 var i, x, y, k: integer;
     b: boolean;
 begin
-exit; // hack
+exit; // temp hack until boxes are fully implemented
 if CountGears(gtCase) > 2 then exit;
 k:= 7;
 repeat
--- a/hedgewars/uLand.pas	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/uLand.pas	Mon Dec 05 21:46:15 2005 +0000
@@ -47,7 +47,7 @@
 procedure RandomizeHHPoints;
 
 implementation
-uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates;
+uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates, uLandObjects;
 
 type TPixAr = record
               Count: Longword;
@@ -59,57 +59,6 @@
               ar: array[1..Pred(cMaxSpawnPoints)] of TPoint
               end = (First: 1);
 
-procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
-var i, p: LongWord;
-    x, y: Longword;
-    bpp: integer;
-    r: TSDL_Rect;
-begin
-r.x:= cpX;
-r.y:= cpY;
-SDL_UpperBlit(Image, nil, Surface, @r);
-WriteToConsole('Generating collision info... ');
-
-if SDL_MustLock(Image) then
-   SDLTry(SDL_LockSurface(Image) >= 0, true);
-
-bpp:= Image.format.BytesPerPixel;
-WriteToConsole('('+inttostr(bpp)+') ');
-p:= LongWord(Image.pixels);
-case bpp of
-     1: OutError('We don''t work with 8 bit surfaces', true);
-     2: for y:= 0 to Pred(Image.h) do
-            begin
-            i:= Longword(@Land[cpY + y, cpX]);
-            for x:= 0 to Pred(Image.w) do
-                if PWord(p + x * 2)^ = 0 then PLongWord(i + x * 4)^:= 0
-                                         else PLongWord(i + x * 4)^:= 1;
-            inc(p, Image.pitch);
-            end;
-     3: for y:= 0 to Pred(Image.h) do
-            begin
-            i:= Longword(@Land[cpY + y, cpX]);
-            for x:= 0 to Pred(Image.w) do
-                if  (PByte(p + x * 3 + 0)^ = 0)
-                and (PByte(p + x * 3 + 1)^ = 0)
-                and (PByte(p + x * 3 + 2)^ = 0) then PLongWord(i + x * 4)^:= 0
-                                                else PLongWord(i + x * 4)^:= 1;
-            inc(p, Image.pitch);
-            end;
-     4: for y:= 0 to Pred(Image.h) do
-            begin
-            i:= Longword(@Land[cpY + y, cpX]);
-            for x:= 0 to Pred(Image.w) do
-                if PLongword(p + x * 4)^ = 0 then PLongWord(i + x * 4)^:= 0
-                                             else PLongWord(i + x * 4)^:= 1;
-            inc(p, Image.pitch);
-            end;
-     end;
-if SDL_MustLock(Image) then
-   SDL_UnlockSurface(Image);
-WriteLnToConsole(msgOK)
-end;
-
 procedure DrawBezierEdge(var pa: TPixAr);
 var x, y, i: integer;
     tx, ty, vx, vy, vlen, t: real;
@@ -371,65 +320,6 @@
     end;
 end;
 
-procedure AddGirders(Surface: PSDL_Surface);
-var tmpsurf: PSDL_Surface;
-    x1, x2, y, k, i: integer;
-    r, rr: TSDL_Rect;
-
-    function CountNonZeroz(x, y: integer): Longword;
-    var i: integer;
-    begin
-    Result:= 0;
-    for i:= y to y + 15 do
-        if Land[i, x] <> 0 then inc(Result)
-    end;
-
-begin
-y:= 256;
-repeat
-  inc(y, 24);
-  x1:= 1024;
-  x2:= 1024;
-  while (x1 > 100) and (CountNonZeroz(x1, y) = 0) do dec(x1, 2);
-  i:= x1 - 12;
-  repeat
-    k:= CountNonZeroz(x1, y);
-    dec(x1, 2)
-  until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
-  inc(x1, 2);
-  if k = 16 then
-     begin
-     while (x2 < 1900) and (CountNonZeroz(x2, y) = 0) do inc(x2, 2);
-     i:= x2 + 12;
-     repeat
-       k:= CountNonZeroz(x2, y);
-       inc(x2, 2)
-     until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
-     if (x2 < 1900) and (k = 16) and (x2 - x1 > 250) then break;
-     end;
-x1:= 0;
-until y > 900;
-if x1 > 0 then
-   begin
-   tmpsurf:= LoadImage(Pathz[ptGraphics] + 'Girder.png');
-   rr.x:= x1;
-   rr.y:= y;
-   while rr.x + 100 < x2 do
-         begin
-         SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
-         inc(rr.x, 100);
-         end;
-   r.x:= 0;
-   r.y:= 0;
-   r.w:= x2 - rr.x;
-   r.h:= 16;
-   SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
-   SDL_FreeSurface(tmpsurf);
-   for k:= y to y + 15 do
-       for i:= x1 to x2 do Land[k, i]:= $FFFFFF
-   end
-end;
-
 procedure AddHHPoints;
 var x, y, t: integer;
 
@@ -482,7 +372,7 @@
 
 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
 const MAXPASSES = 16;
-var ar: array[0..MAXPASSES, 0..5] of real;
+var ar: array[1..MAXPASSES, 0..5] of real;
     i, k: integer;
     rx, ry, oy: real;
     PassesNum: Longword;
@@ -506,15 +396,15 @@
     begin
     rx:= pa.ar[k].x;
     ry:= pa.ar[k].y;
-    for i:= 0 to PassesNum do
+    for i:= 1 to PassesNum do
         begin
         oy:= ry;
         ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]);
         rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]);
         end;
-        pa.ar[k].x:= round(rx);
-        pa.ar[k].y:= round(ry);
-        end;
+    pa.ar[k].x:= round(rx);
+    pa.ar[k].y:= round(ry);
+    end;
 end;
 
 procedure GenBlank(var Template: TEdgeTemplate);
@@ -553,7 +443,9 @@
 with PixelFormat^ do
      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
 SDL_FillRect(LandSurface, nil, 0);
-AddGirders(LandSurface);
+
+AddObjects(LandSurface);
+
 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
 SDL_UpperBlit(tmpsurf, nil, LandSurface, nil);
 SDL_FreeSurface(tmpsurf);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uLandObjects.pas	Mon Dec 05 21:46:15 2005 +0000
@@ -0,0 +1,309 @@
+unit uLandObjects;
+interface
+uses SDLh;
+{$include options.inc}
+
+procedure AddObjects(Surface: PSDL_Surface);
+procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
+
+implementation
+uses uLand, uStore, uConsts, uMisc, uConsole, uRandom;
+const MaxRects = 1024;
+      MAXOBJECTRECTS = 32;
+type  PRectArray = ^TRectsArray;
+      TRectsArray = array[0..MaxRects] of TSDL_rect;
+
+type TThemeObject = record
+                    Surf: PSDL_Surface;
+                    inland: TSDL_Rect;
+                    outland: array[1..MAXOBJECTRECTS] of TSDL_Rect;
+                    rectcnt: Longword;
+                    Width, Height: Longword;
+                    end;
+
+var Rects: PRectArray;
+    RectCount: Longword;
+
+procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
+var i, p: LongWord;
+    x, y: Longword;
+    bpp: integer;
+    r: TSDL_Rect;
+begin
+r.x:= cpX;
+r.y:= cpY;
+SDL_UpperBlit(Image, nil, Surface, @r);
+WriteToConsole('Generating collision info... ');
+
+if SDL_MustLock(Image) then
+   SDLTry(SDL_LockSurface(Image) >= 0, true);
+
+bpp:= Image.format.BytesPerPixel;
+WriteToConsole('('+inttostr(bpp)+') ');
+p:= LongWord(Image.pixels);
+case bpp of
+     1: OutError('We don''t work with 8 bit surfaces', true);
+     2: for y:= 0 to Pred(Image.h) do
+            begin
+            i:= Longword(@Land[cpY + y, cpX]);
+            for x:= 0 to Pred(Image.w) do
+                if PWord(p + x * 2)^ <> 0 then PLongWord(i + x * 4)^:= $FFFFFF;
+            inc(p, Image.pitch);
+            end;
+     3: for y:= 0 to Pred(Image.h) do
+            begin
+            i:= Longword(@Land[cpY + y, cpX]);
+            for x:= 0 to Pred(Image.w) do
+                if  (PByte(p + x * 3 + 0)^ <> 0)
+                 or (PByte(p + x * 3 + 1)^ <> 0)
+                 or (PByte(p + x * 3 + 2)^ <> 0) then PLongWord(i + x * 4)^:= $FFFFFF;
+            inc(p, Image.pitch);
+            end;
+     4: for y:= 0 to Pred(Image.h) do
+            begin
+            i:= Longword(@Land[cpY + y, cpX]);
+            for x:= 0 to Pred(Image.w) do
+                if PLongword(p + x * 4)^ <> 0 then PLongWord(i + x * 4)^:= $FFFFFF;
+            inc(p, Image.pitch);
+            end;
+     end;
+if SDL_MustLock(Image) then
+   SDL_UnlockSurface(Image);
+WriteLnToConsole(msgOK)
+end;
+
+procedure AddRect(x1, y1, w1, h1: integer);
+begin
+with Rects[RectCount] do
+     begin
+     x:= x1;
+     y:= y1;
+     w:= w1;
+     h:= h1
+     end;
+inc(RectCount);
+TryDo(RectCount < MaxRects, 'AddRect: overflow', true)
+end;
+
+procedure InitRects;
+begin
+RectCount:= 0;
+New(Rects)
+end;
+
+procedure FreeRects;
+begin
+Dispose(rects)
+end;
+
+function CheckIntersect(x1, y1, w1, h1: integer): boolean;
+var i: Longword;
+begin
+Result:= false;
+i:= 0;
+if RectCount > 0 then
+   repeat
+   with Rects[i] do
+        Result:= (x < x1 + w1) and (x1 < x + w) and
+                 (y < y1 + h1) and (y1 < y + h);
+   inc(i)
+   until (i = RectCount) or (Result)
+end;
+
+procedure AddGirders(Surface: PSDL_Surface);
+var tmpsurf: PSDL_Surface;
+    x1, x2, y, k, i: integer;
+    r, rr: TSDL_Rect;
+
+    function CountNonZeroz(x, y: integer): Longword;
+    var i: integer;
+    begin
+    Result:= 0;
+    for i:= y to y + 15 do
+        if Land[i, x] <> 0 then inc(Result)
+    end;
+
+begin
+y:= 256;
+repeat
+  inc(y, 24);
+  x1:= 1024;
+  x2:= 1024;
+  while (x1 > 100) and (CountNonZeroz(x1, y) = 0) do dec(x1, 2);
+  i:= x1 - 12;
+  repeat
+    k:= CountNonZeroz(x1, y);
+    dec(x1, 2)
+  until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
+  inc(x1, 2);
+  if k = 16 then
+     begin
+     while (x2 < 1900) and (CountNonZeroz(x2, y) = 0) do inc(x2, 2);
+     i:= x2 + 12;
+     repeat
+       k:= CountNonZeroz(x2, y);
+       inc(x2, 2)
+     until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
+     if (x2 < 1900) and (k = 16) and (x2 - x1 > 250)
+        and not CheckIntersect(x1, y, x2 - x1, 16) then break;
+     end;
+x1:= 0;
+until y > 900;
+if x1 > 0 then
+   begin
+   tmpsurf:= LoadImage(Pathz[ptGraphics] + 'Girder.png');
+   rr.x:= x1;
+   rr.y:= y;
+   while rr.x + 100 < x2 do
+         begin
+         SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
+         inc(rr.x, 100);
+         end;
+   r.x:= 0;
+   r.y:= 0;
+   r.w:= x2 - rr.x;
+   r.h:= 16;
+   SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
+   SDL_FreeSurface(tmpsurf);
+   AddRect(x1 - 8, y - 8, x2 - x1 + 8, 32);
+   for k:= y to y + 15 do
+       for i:= x1 to x2 do Land[k, i]:= $FFFFFF
+   end
+end;
+
+function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean;
+var i: Longword;
+begin
+Result:= true;
+inc(rect.x, dX);
+inc(rect.y, dY);
+i:= 0;
+{$WARNINGS OFF}
+while (i <= rect.w) and Result do
+      begin
+      Result:= (Land[rect.y, rect.x + i] = Color) and (Land[rect.y + rect.h, rect.x + i] = Color);
+      inc(i)
+      end;
+i:= 0;
+while (i <= rect.h) and Result do
+      begin
+      Result:= (Land[rect.y + i, rect.x] = Color) or (Land[rect.y + i, rect.x + rect.w] = Color);
+      inc(i)
+      end;
+{$WARNINGS ON}
+end;
+
+function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
+var i: Longword;
+begin
+with Obj do
+     if CheckLand(inland, x, y, $FFFFFF) then
+        begin
+        Result:= true;
+        i:= 1;
+        while Result and (i <= rectcnt) do
+              begin
+              Result:= CheckLand(outland[i], x, y, 0);
+              inc(i)
+              end;
+        if Result then
+           Result:= not CheckIntersect(x, y, Width, Height)
+        end else
+        Result:= false
+end;
+
+function TryPut(var Obj: TThemeObject; Surface: PSDL_Surface): boolean;
+const MaxPointsIndex = 2047;
+var x, y: Longword;
+    ar: array[0..MaxPointsIndex] of TPoint;
+    cnt, i: Longword;
+begin
+cnt:= 0;
+with Obj do
+     begin
+     x:= 0;
+     repeat
+         y:= 0;
+         repeat
+             if CheckCanPlace(x, y, Obj) then
+                begin
+                ar[cnt].x:= x;
+                ar[cnt].y:= y;
+                inc(cnt);
+                if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
+                   begin
+                   y:= 5000;
+                   x:= 5000;
+                   end
+                end;
+             inc(y, 2);
+         until y > 1023 - Height;
+         inc(x, getrandom(8) + 2)
+     until x > 2047 - Width;
+     Result:= cnt <> 0;
+     if Result then
+        begin
+        i:= getrandom(cnt);
+        BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf, Surface);
+        AddRect(ar[i].x, ar[i].y, Width, Height);
+        end
+     end
+end;
+
+procedure AddThemeObjects(Surface: PSDL_Surface; MaxCount: Longword);
+const MAXTHEMEOBJECTS = 16;
+var f: textfile;
+    s: string;
+    ThemeObjects: array[1..MAXTHEMEOBJECTS] of TThemeObject;
+    i, ii, t, n: Longword;
+    b: boolean;
+begin
+s:= Pathz[ptThemeCurrent] + cThemeCFGFilename;
+WriteLnToConsole('Adding objects...');
+AssignFile(f, s);
+{$I-}
+Reset(f);
+Readln(f, s); // skip color
+Readln(f, n);
+for i:= 1 to n do
+    begin
+    Readln(f, s); // filename
+    with ThemeObjects[i] do
+         begin
+         Surf:= LoadImage(Pathz[ptThemeCurrent] + s + '.png');
+         Read(f, Width, Height);
+         with inland do Read(f, x, y, w, h);
+         Read(f, rectcnt);
+         for ii:= 1 to rectcnt do
+             with outland[ii] do Read(f, x, y, w, h);
+         ReadLn(f)
+         end;
+    end;
+Closefile(f);
+{$I+}
+TryDo(IOResult = 0, 'Bad data or cannot access file', true);
+
+// loaded objects, try to put on land
+if n = 0 then exit;
+i:= 1;
+repeat
+    t:= getrandom(n) + 1;
+    ii:= t;
+    repeat
+      inc(ii);
+      if ii > n then ii:= 1;
+      b:= TryPut(ThemeObjects[ii], Surface)
+    until b or (ii = t);
+inc(i)
+until (i > MaxCount) or not b
+end;
+
+procedure AddObjects(Surface: PSDL_Surface);
+begin
+InitRects;
+AddGirders(Surface);
+AddThemeObjects(Surface, 5);
+FreeRects
+end;
+
+end.
--- a/hedgewars/uLandTemplates.pas	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/uLandTemplates.pas	Mon Dec 05 21:46:15 2005 +0000
@@ -77,7 +77,7 @@
        (BasePoints: @Template0Points;
         BasePointsCount: Succ(High(Template0Points));
         BezPassCnt: 4;
-        PassMin: 5; PassDelta: 1;
+        PassMin: 4; PassDelta: 1;
         WaveAmplMin:    27; WaveAmplDelta: 22;
         WaveFreqMin: 0.010; WaveFreqDelta: 0.015;
         FillPoints: @Template0FPoints;
@@ -86,7 +86,7 @@
        (BasePoints: @Template1Points;
         BasePointsCount: Succ(High(Template1Points));
         BezPassCnt: 4;
-        PassMin: 6; PassDelta: 2;
+        PassMin: 5; PassDelta: 2;
         WaveAmplMin:    20; WaveAmplDelta: 10;
         WaveFreqMin: 0.015; WaveFreqDelta: 0.020;
         FillPoints: @Template1FPoints;
@@ -95,7 +95,7 @@
        (BasePoints: @Template2Points;
         BasePointsCount: Succ(High(Template2Points));
         BezPassCnt: 2;
-        PassMin: 4; PassDelta: 1;
+        PassMin: 3; PassDelta: 2;
         WaveAmplMin:    30; WaveAmplDelta: 15;
         WaveFreqMin: 0.010; WaveFreqDelta: 0.015;
         FillPoints: @Template2FPoints;
--- a/hedgewars/uMisc.pas	Sun Dec 04 19:06:56 2005 +0000
+++ b/hedgewars/uMisc.pas	Mon Dec 05 21:46:15 2005 +0000
@@ -104,6 +104,7 @@
 procedure AdjustColor(var Color: Longword);
 {$IFDEF DEBUGFILE}
 procedure AddFileLog(s: shortstring);
+function RectToStr(Rect: TSDL_Rect): shortstring;
 {$ENDIF}
 
 var CursorPoint: TPoint;
@@ -138,7 +139,7 @@
    begin
    WriteLn(Msg);
    SDL_Quit;
-   Readln;
+//   Readln;
    halt(1)
    end else WriteLnToConsole(Msg)
 end;
@@ -199,6 +200,11 @@
 flush(f)
 end;
 
+function RectToStr(Rect: TSDL_Rect): shortstring;
+begin
+Result:= '(x: ' + inttostr(rect.x) + '; y: ' + inttostr(rect.y) + '; w: ' + inttostr(rect.w) + '; h: ' + inttostr(rect.h) + ')'
+end;
+
 initialization
 assignfile(f, 'debug.txt');
 rewrite(f);