hedgewars/uLandObjects.pas
branchexperimental3D
changeset 4812 f924be23ffb4
parent 4806 48c1a395f0a7
child 4835 a6924450e694
equal deleted inserted replaced
4347:0ddb100fea61 4812:f924be23ffb4
    27 procedure LoadThemeConfig;
    27 procedure LoadThemeConfig;
    28 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface);
    28 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface);
    29 procedure AddOnLandObjects(Surface: PSDL_Surface);
    29 procedure AddOnLandObjects(Surface: PSDL_Surface);
    30 
    30 
    31 implementation
    31 implementation
    32 uses uLand, uStore, uConsts, uMisc, uConsole, uRandom, uVisualGears, uSound, GLunit;
    32 uses uStore, uConsts, uConsole, uRandom, uVisualGears, uSound, GLunit,
       
    33      uTypes, uVariables, uUtils, uDebug, sysutils;
    33 
    34 
    34 const MaxRects = 512;
    35 const MaxRects = 512;
    35       MAXOBJECTRECTS = 16;
    36       MAXOBJECTRECTS = 16;
    36       MAXTHEMEOBJECTS = 32;
    37       MAXTHEMEOBJECTS = 32;
    37 
    38 
   223 {$WARNINGS OFF}
   224 {$WARNINGS OFF}
   224 tmpx:= rect.x;
   225 tmpx:= rect.x;
   225 tmpx2:= bx;
   226 tmpx2:= bx;
   226 while (tmpx <= bx - rect.w div 2 - 1) and bRes do
   227 while (tmpx <= bx - rect.w div 2 - 1) and bRes do
   227       begin
   228       begin
   228       bRes:= (Land[rect.y, tmpx] = Color) and (Land[by, tmpx] = Color) and
   229       bRes:= ((rect.y and LAND_HEIGHT_MASK) = 0) and ((by and LAND_HEIGHT_MASK) = 0) and
       
   230              ((tmpx and LAND_WIDTH_MASK) = 0) and ((tmpx2 and LAND_WIDTH_MASK) = 0) and
       
   231              (Land[rect.y, tmpx] = Color) and (Land[by, tmpx] = Color) and
   229              (Land[rect.y, tmpx2] = Color) and (Land[by, tmpx2] = Color);
   232              (Land[rect.y, tmpx2] = Color) and (Land[by, tmpx2] = Color);
   230       inc(tmpx);
   233       inc(tmpx);
   231       dec(tmpx2)
   234       dec(tmpx2)
   232       end;
   235       end;
   233 tmpy:= rect.y+1;
   236 tmpy:= rect.y+1;
   234 tmpy2:= by-1;
   237 tmpy2:= by-1;
   235 while (tmpy <= by - rect.h div 2 - 1) and bRes do
   238 while (tmpy <= by - rect.h div 2 - 1) and bRes do
   236       begin
   239       begin
   237       bRes:= (Land[tmpy, rect.x] = Color) and (Land[tmpy, bx] = Color) and
   240       bRes:= ((tmpy and LAND_HEIGHT_MASK) = 0) and ((tmpy2 and LAND_HEIGHT_MASK) = 0) and
       
   241              ((rect.x and LAND_WIDTH_MASK) = 0) and ((bx and LAND_WIDTH_MASK) = 0) and
       
   242              (Land[tmpy, rect.x] = Color) and (Land[tmpy, bx] = Color) and
   238              (Land[tmpy2, rect.x] = Color) and (Land[tmpy2, bx] = Color);
   243              (Land[tmpy2, rect.x] = Color) and (Land[tmpy2, bx] = Color);
   239       inc(tmpy);
   244       inc(tmpy);
   240       dec(tmpy2)
   245       dec(tmpy2)
   241       end;
   246       end;
   242 {$WARNINGS ON}
   247 {$WARNINGS ON}
   359     end;
   364     end;
   360 TryPut:= bRes;
   365 TryPut:= bRes;
   361 end;
   366 end;
   362 
   367 
   363 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   368 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   364 var s: shortstring;
   369 var s, key: shortstring;
   365     f: textfile;
   370     f: textfile;
   366     i, ii: LongInt;
   371     i, ii, numFlakes: LongInt;
   367     c1, c2: TSDL_Color;
   372     c1, c2: TSDL_Color;
   368 
   373 
   369     procedure CheckRect(Width, Height, x, y, w, h: LongWord);
   374     procedure CheckRect(Width, Height, x, y, w, h: LongWord);
   370     begin
   375     begin
   371     if (x + w > Width) then OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   376     if (x + w > Width) then OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   381 Assign(f, s);
   386 Assign(f, s);
   382 {$I-}
   387 {$I-}
   383 filemode:= 0; // readonly
   388 filemode:= 0; // readonly
   384 Reset(f);
   389 Reset(f);
   385 
   390 
   386 // read sky and explosion border colors
   391 ThemeObjects.Count:= 0;
   387 Readln(f, c1.r, c1.g, c1. b);
   392 SprayObjects.Count:= 0;
   388 Readln(f, c2.r, c2.g, c2. b);
   393 
   389 // read water gradient colors
   394 while not eof(f) do
   390 Readln(f, WaterColorArray[0].r, WaterColorArray[0].g, WaterColorArray[0].b);
       
   391 Readln(f, WaterColorArray[2].r, WaterColorArray[2].g, WaterColorArray[2].b, cWaterOpacity);
       
   392 WaterColorArray[0].a := 255;
       
   393 WaterColorArray[2].a := 255;
       
   394 WaterColorArray[1]:= WaterColorArray[0];
       
   395 WaterColorArray[3]:= WaterColorArray[2];
       
   396 
       
   397 glClearColor(c1.r / 255, c1.g / 255, c1.b / 255, 0.99); // sky color
       
   398 cExplosionBorderColor:= c2.value or AMask;
       
   399 
       
   400 ReadLn(f, s);
       
   401 if MusicFN = '' then MusicFN:= s;
       
   402 
       
   403 ReadLn(f, cCloudsNumber);
       
   404 
       
   405 // TODO - adjust all the theme cloud numbers. This should not be a permanent fix
       
   406 //cCloudsNumber:= cCloudsNumber * (LAND_WIDTH div 2048);
       
   407 
       
   408 // scale number of clouds depending on screen space (two times land width)
       
   409 cCloudsNumber:= cCloudsNumber * cScreenSpace div LAND_WIDTH;
       
   410 
       
   411 Readln(f, ThemeObjects.Count);
       
   412 for i:= 0 to Pred(ThemeObjects.Count) do
       
   413     begin
   395     begin
   414     Readln(f, s); // filename
   396     Readln(f, s);
   415     with ThemeObjects.objs[i] do
   397     if Length(s) = 0 then continue;
   416             begin
   398     if s[1] = ';' then continue;
   417             Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, ifCritical or ifTransparent or ifIgnoreCaps);
   399 
       
   400     i:= Pos('=', s);
       
   401     key:= Trim(Copy(s, 1, Pred(i)));
       
   402     Delete(s, 1, i);
       
   403 
       
   404     if key = 'sky' then
       
   405         begin
       
   406         i:= Pos(',', s);
       
   407         c1.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   408         Delete(s, 1, i);
       
   409         i:= Pos(',', s);
       
   410         c1.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   411         Delete(s, 1, i);
       
   412         c1.b:= StrToInt(Trim(s));
       
   413         glClearColor(c1.r / 255, c1.g / 255, c1.b / 255, 0.99);
       
   414         end
       
   415     else if key = 'border' then
       
   416         begin
       
   417         i:= Pos(',', s);
       
   418         c2.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   419         Delete(s, 1, i);
       
   420         i:= Pos(',', s);
       
   421         c2.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   422         Delete(s, 1, i);
       
   423         c2.b:= StrToInt(Trim(s));
       
   424         cExplosionBorderColor:= c2.value or AMask;
       
   425         end
       
   426     else if key = 'water-top' then
       
   427         begin
       
   428         i:= Pos(',', s);
       
   429         WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   430         Delete(s, 1, i);
       
   431         i:= Pos(',', s);
       
   432         WaterColorArray[0].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   433         Delete(s, 1, i);
       
   434         WaterColorArray[0].b:= StrToInt(Trim(s));
       
   435         WaterColorArray[0].a := 255;
       
   436         WaterColorArray[1]:= WaterColorArray[0];
       
   437         end
       
   438     else if key = 'water-bottom' then
       
   439         begin
       
   440         i:= Pos(',', s);
       
   441         WaterColorArray[2].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   442         Delete(s, 1, i);
       
   443         i:= Pos(',', s);
       
   444         WaterColorArray[2].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   445         Delete(s, 1, i);
       
   446         WaterColorArray[2].b:= StrToInt(Trim(s));
       
   447         WaterColorArray[2].a := 255;
       
   448         WaterColorArray[3]:= WaterColorArray[2];
       
   449         end
       
   450     else if key = 'water-opacity' then
       
   451         begin
       
   452         cWaterOpacity:= StrToInt(Trim(s));
       
   453         cSDWaterOpacity:= cWaterOpacity
       
   454         end
       
   455     else if key = 'music' then MusicFN:= Trim(s)
       
   456     else if key = 'clouds' then
       
   457         begin
       
   458         cCloudsNumber:= StrToInt(Trim(s)) * cScreenSpace div LAND_WIDTH;
       
   459         cSDCloudsNumber:= cCloudsNumber
       
   460         end
       
   461     else if key = 'object' then
       
   462         begin
       
   463         inc(ThemeObjects.Count);
       
   464         with ThemeObjects.objs[Pred(ThemeObjects.Count)] do
       
   465             begin
       
   466             i:= Pos(',', s);
       
   467             Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + Trim(Copy(s, 1, Pred(i))), ifCritical or ifTransparent or ifIgnoreCaps);
   418             Width:= Surf^.w;
   468             Width:= Surf^.w;
   419             Height:= Surf^.h;
   469             Height:= Surf^.h;
   420             Read(f, Maxcnt);
   470             Delete(s, 1, i);
       
   471             i:= Pos(',', s);
       
   472             Maxcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   473             Delete(s, 1, i);
   421             if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
   474             if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
   422             with inland do
   475             with inland do
   423                 begin
   476                 begin
   424                 Read(f, x, y, w, h);
   477                 i:= Pos(',', s);
       
   478                 x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   479                 Delete(s, 1, i);
       
   480                 i:= Pos(',', s);
       
   481                 y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   482                 Delete(s, 1, i);
       
   483                 i:= Pos(',', s);
       
   484                 w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   485                 Delete(s, 1, i);
       
   486                 i:= Pos(',', s);
       
   487                 h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   488                 Delete(s, 1, i);
   425                 CheckRect(Width, Height, x, y, w, h)
   489                 CheckRect(Width, Height, x, y, w, h)
   426                 end;
   490                 end;
   427             Read(f, rectcnt);
   491             i:= Pos(',', s);
       
   492             rectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   493             Delete(s, 1, i);
   428             for ii:= 1 to rectcnt do
   494             for ii:= 1 to rectcnt do
   429                 with outland[ii] do
   495                 with outland[ii] do
   430                     begin
   496                     begin
   431                     Read(f, x, y, w, h);
   497                     i:= Pos(',', s);
       
   498                     x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   499                     Delete(s, 1, i);
       
   500                     i:= Pos(',', s);
       
   501                     y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   502                     Delete(s, 1, i);
       
   503                     i:= Pos(',', s);
       
   504                     w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   505                     Delete(s, 1, i);
       
   506                     if ii = rectcnt then h:= StrToInt(Trim(s))
       
   507                     else
       
   508                         begin
       
   509                         i:= Pos(',', s);
       
   510                         h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   511                         Delete(s, 1, i)
       
   512                         end;
   432                     CheckRect(Width, Height, x, y, w, h)
   513                     CheckRect(Width, Height, x, y, w, h)
   433                     end;
   514                     end;
   434             ReadLn(f)
       
   435             end;
   515             end;
       
   516         end
       
   517     else if key = 'spray' then
       
   518         begin
       
   519         inc(SprayObjects.Count);
       
   520         with SprayObjects.objs[Pred(SprayObjects.Count)] do
       
   521             begin
       
   522             i:= Pos(',', s);
       
   523             Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + Trim(Copy(s, 1, Pred(i))), ifCritical or ifTransparent or ifIgnoreCaps);
       
   524             Width:= Surf^.w;
       
   525             Height:= Surf^.h;
       
   526             Delete(s, 1, i);
       
   527             Maxcnt:= StrToInt(Trim(s));
       
   528             end;
       
   529         end
       
   530     else if key = 'flakes' then
       
   531         begin
       
   532         i:= Pos(',', s);
       
   533         vobCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   534         Delete(s, 1, i);
       
   535         if vobCount > 0 then
       
   536             begin
       
   537             i:= Pos(',', s);
       
   538             vobFramesCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   539             Delete(s, 1, i);
       
   540             i:= Pos(',', s);
       
   541             vobFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   542             Delete(s, 1, i);
       
   543             i:= Pos(',', s);
       
   544             vobVelocity:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   545             Delete(s, 1, i);
       
   546             vobFallSpeed:= StrToInt(Trim(s));
       
   547             vobCount:= vobCount * cScreenSpace div LAND_WIDTH;
       
   548             end;
       
   549         end
       
   550     else if key = 'sd-water-top' then
       
   551         begin
       
   552         i:= Pos(',', s);
       
   553         SDWaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   554         Delete(s, 1, i);
       
   555         i:= Pos(',', s);
       
   556         SDWaterColorArray[0].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   557         Delete(s, 1, i);
       
   558         SDWaterColorArray[0].b:= StrToInt(Trim(s));
       
   559         SDWaterColorArray[0].a := 255;
       
   560         SDWaterColorArray[1]:= SDWaterColorArray[0];
       
   561         end
       
   562     else if key = 'sd-water-bottom' then
       
   563         begin
       
   564         i:= Pos(',', s);
       
   565         SDWaterColorArray[2].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   566         Delete(s, 1, i);
       
   567         i:= Pos(',', s);
       
   568         SDWaterColorArray[2].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   569         Delete(s, 1, i);
       
   570         SDWaterColorArray[2].b:= StrToInt(Trim(s));
       
   571         SDWaterColorArray[2].a := 255;
       
   572         SDWaterColorArray[3]:= SDWaterColorArray[2];
       
   573         end
       
   574     else if key = 'sd-water-opacity' then cSDWaterOpacity:= StrToInt(Trim(s))
       
   575     else if key = 'sd-clouds' then cSDCloudsNumber:= StrToInt(Trim(s)) * cScreenSpace div LAND_WIDTH
       
   576     else if key = 'sd-flakes' then
       
   577         begin
       
   578         i:= Pos(',', s);
       
   579         vobSDCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   580         Delete(s, 1, i);
       
   581         if vobSDCount > 0 then
       
   582             begin
       
   583             i:= Pos(',', s);
       
   584             vobSDFramesCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   585             Delete(s, 1, i);
       
   586             i:= Pos(',', s);
       
   587             vobSDFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   588             Delete(s, 1, i);
       
   589             i:= Pos(',', s);
       
   590             vobSDVelocity:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   591             Delete(s, 1, i);
       
   592             vobSDFallSpeed:= StrToInt(Trim(s));
       
   593             vobSDCount:= vobSDCount * cScreenSpace div LAND_WIDTH;
       
   594             end;
       
   595         end
   436     end;
   596     end;
   437 
       
   438 // sprays
       
   439 Readln(f, SprayObjects.Count);
       
   440 for i:= 0 to Pred(SprayObjects.Count) do
       
   441     begin
       
   442     Readln(f, s); // filename
       
   443     with SprayObjects.objs[i] do
       
   444          begin
       
   445          Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, ifCritical or ifTransparent or ifIgnoreCaps);
       
   446          Width:= Surf^.w;
       
   447          Height:= Surf^.h;
       
   448          ReadLn(f, Maxcnt)
       
   449          end;
       
   450     end;
       
   451 
       
   452 // snowflakes
       
   453 Readln(f, vobCount);
       
   454 if vobCount > 0 then
       
   455     Readln(f, vobFramesCount, vobFrameTicks, vobVelocity, vobFallSpeed);
       
   456 
       
   457 // adjust amount of flakes scaled by screen space
       
   458 vobCount:= longint(vobCount) * cScreenSpace div LAND_WIDTH;
       
   459 
       
   460 if (cReducedQuality and rqKillFlakes) <> 0 then
       
   461     vobCount:= 0;
       
   462 
       
   463 
       
   464 for i:= 0 to Pred(vobCount) do
       
   465     AddVisualGear(cLeftScreenBorder + random(cScreenSpace), random(1024+200) - 100 + LAND_HEIGHT, vgtFlake);
       
   466 
   597 
   467 Close(f);
   598 Close(f);
   468 {$I+}
   599 {$I+}
   469 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true);
   600 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true);
   470 AddProgress;
   601 AddProgress;