hedgewars/uLand.pas
changeset 67 3101306251e5
parent 64 9df467527ae5
child 70 82d93eeecebe
equal deleted inserted replaced
66:9643d75baf1e 67:3101306251e5
   425     pa.ar[k].x:= round(rx);
   425     pa.ar[k].x:= round(rx);
   426     pa.ar[k].y:= round(ry);
   426     pa.ar[k].y:= round(ry);
   427     end;
   427     end;
   428 end;
   428 end;
   429 
   429 
       
   430 procedure NormalizePoints(var pa: TPixAr);
       
   431 const brd = 32;
       
   432 var isUP: boolean;  // HACK: transform for Y should be exact as one for X  
       
   433     Left, Right, Top, Bottom,
       
   434     OWidth, Width, OHeight, Height,
       
   435     OLeft: integer;
       
   436     i: integer;
       
   437 begin
       
   438 TryDo((pa.ar[0].y < 0) or (pa.ar[0].y > 1023), 'Bad land generated', true);
       
   439 isUP:= pa.ar[0].y > 0;
       
   440 Left:= 1023;
       
   441 Right:= Left;
       
   442 Top:= pa.ar[0].y;
       
   443 Bottom:= Top;
       
   444 
       
   445 for i:= 1 to Pred(pa.Count) do
       
   446     with pa.ar[i] do
       
   447          begin
       
   448          if (y and $FFFFFC00) = 0 then
       
   449             if x < Left then Left:= x else
       
   450             if x > Right then Right:= x;
       
   451          if y < Top then Top:= y else
       
   452          if y > Bottom then Bottom:= y
       
   453          end;
       
   454 
       
   455 if (Left < brd) or (Right > 2047 - brd) then
       
   456    begin
       
   457    OLeft:= Left;
       
   458    OWidth:= Right - OLeft;
       
   459    if Left < brd then Left:= brd;
       
   460    if Right > 2047 - brd then Right:= 2047 - brd;
       
   461    Width:= Right - Left;
       
   462    for i:= 0 to Pred(pa.Count) do
       
   463        with pa.ar[i] do
       
   464             x:= round((x - OLeft) * Width div OWidth + Left)
       
   465    end;
       
   466 
       
   467 if isUp then // FIXME: remove hack
       
   468    if Top < brd then
       
   469       begin
       
   470       OHeight:= 1023 - Top;
       
   471       Height:= 1023 - brd;
       
   472       for i:= 0 to Pred(pa.Count) do
       
   473           with pa.ar[i] do
       
   474                y:= round((y - 1023) * Height div OHeight + 1023)
       
   475    end;
       
   476 end;
       
   477 
   430 procedure GenBlank(var Template: TEdgeTemplate);
   478 procedure GenBlank(var Template: TEdgeTemplate);
   431 var pa: TPixAr;
   479 var pa: TPixAr;
   432     i: Longword;
   480     i: Longword;
   433 begin
   481 begin
   434 with Template do
   482 with Template do
   457 
   505 
   458      for i:= 1 to BezPassCnt do
   506      for i:= 1 to BezPassCnt do
   459          BezierizeEdge(pa, 0.33333334);
   507          BezierizeEdge(pa, 0.33333334);
   460 
   508 
   461      PointWave(Template, pa);
   509      PointWave(Template, pa);
       
   510      NormalizePoints(pa);
   462      DrawBezierEdge(pa);
   511      DrawBezierEdge(pa);
   463 
   512 
   464      for i:= 0 to pred(FillPointsCount) do
   513      for i:= 0 to pred(FillPointsCount) do
   465          with FillPoints^[i] do
   514          with FillPoints^[i] do
   466               FillLand(x, y)
   515               FillLand(x, y)
   477 GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
   526 GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
   478 
   527 
   479 AddProgress;
   528 AddProgress;
   480 with PixelFormat^ do
   529 with PixelFormat^ do
   481      tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   530      tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
       
   531 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   482 ColorizeLand(tmpsurf);
   532 ColorizeLand(tmpsurf);
   483 AddProgress;
   533 AddProgress;
   484 AddBorder(tmpsurf);
   534 AddBorder(tmpsurf);
   485 with PixelFormat^ do
   535 with PixelFormat^ do
   486      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   536      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
       
   537 TryDo(LandSurface <> nil, 'Error creating land surface', true);
   487 SDL_FillRect(LandSurface, nil, 0);
   538 SDL_FillRect(LandSurface, nil, 0);
   488 AddProgress;
   539 AddProgress;
   489 
   540 
   490 AddObjects(LandSurface);
   541 AddObjects(LandSurface);
   491 
   542