hedgewars/uMisc.pas
author unc0rr
Wed, 25 Jul 2012 16:24:30 +0400
changeset 7433 c7fff3e61d49
parent 7049 35d762458d66
child 7306 3cff5c769509
permissions -rw-r--r--
- Implement AI land marks which only used to tracks visited areas on the map for now. Significantly reduces wasting of cpu time by AI checking same place several times (10x or even more in rare cases) - More branching in walk algorythm which allows for better coverage of reachable places. Sometimes makes AI perform ridiculous jumping just to make a tiny step. - Small fixes/adjustments

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 *)

{$INCLUDE "options.inc"}

unit uMisc;
interface

uses SDLh, uConsts, GLunit, uTypes;

procedure initModule;
procedure freeModule;

procedure movecursor(dx, dy: LongInt);
function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
function  MakeScreenshot(filename: shortstring): boolean;
function  GetTeamStatString(p: PTeam): shortstring;
{$IFDEF SDL13}
function  SDL_RectMake(x, y, width, height: LongInt): TSDL_Rect; inline;
{$ELSE}
function  SDL_RectMake(x, y: SmallInt; width, height: Word): TSDL_Rect; inline;
{$ENDIF}

implementation
uses SysUtils, uVariables, uUtils
     {$IFDEF PNG_SCREENSHOTS}, PNGh, png {$ENDIF}
     {$IFNDEF USE_SDLTHREADS} {$IFDEF UNIX}, cthreads{$ENDIF} {$ENDIF};

type PScreenshot = ^TScreenshot;
     TScreenshot = record
         buffer: PByte;
         filename: shortstring;
         width, height: LongInt;
         size: QWord;
         end;

var conversionFormat: PSDL_PixelFormat;

procedure movecursor(dx, dy: LongInt);
var x, y: LongInt;
begin
if (dx = 0) and (dy = 0) then exit;

SDL_GetMouseState(@x, @y);
Inc(x, dx);
Inc(y, dy);
SDL_WarpMouse(x, y);
end;

{$IFDEF PNG_SCREENSHOTS}
// this funtion will be executed in separate thread
function SaveScreenshot(screenshot: pointer): PtrInt;
var i: LongInt;
    png_ptr: ^png_struct;
    info_ptr: ^png_info;
    f: file;
    image: PScreenshot;
begin
image:= PScreenshot(screenshot);

png_ptr := png_create_write_struct(png_get_libpng_ver(nil), nil, nil, nil);
if png_ptr = nil then
begin
    // AddFileLog('Error: Could not create png write struct.');
    SaveScreenshot:= 0;
    exit;
end;

info_ptr := png_create_info_struct(png_ptr);
if info_ptr = nil then
begin
    png_destroy_write_struct(@png_ptr, nil);
    // AddFileLog('Error: Could not create png info struct.');
    SaveScreenshot:= 0;
    exit;
end;

{$IOCHECKS OFF}
Assign(f, image^.filename);
Rewrite(f, 1);
if IOResult = 0 then
    begin
    png_init_pascal_io(png_ptr,@f);
    png_set_IHDR(png_ptr, info_ptr, image^.width, image^.height,
                 8, // bit depth
                 PNG_COLOR_TYPE_RGBA, PNG_INTERLACE_NONE,
                 PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
    png_write_info(png_ptr, info_ptr);
    // glReadPixels and libpng number rows in different order
    for i:= image^.height-1 downto 0 do
        png_write_row(png_ptr, image^.buffer + i*4*image^.width);
    png_write_end(png_ptr, info_ptr);
    Close(f);
    end;
{$IOCHECKS ON}

// free everything
png_destroy_write_struct(@png_ptr, @info_ptr);
FreeMem(image^.buffer, image^.size);
Dispose(image);
SaveScreenshot:= 0;
end;

{$ELSE} // no PNG_SCREENSHOTS

// this funtion will be executed in separate thread
function SaveScreenshot(screenshot: pointer): PtrInt;
var f: file;
    // Windows Bitmap Header
    head: array[0..53] of Byte = (
    $42, $4D,       // identifier ("BM")
    0, 0, 0, 0,     // file size
    0, 0, 0, 0,     // reserved
    54, 0, 0, 0,    // starting offset
    40, 0, 0, 0,    // header size
    0, 0, 0, 0,     // width
    0, 0, 0, 0,     // height
    1, 0,           // color planes
    32, 0,          // bit depth
    0, 0, 0, 0,     // compression method (uncompressed)
    0, 0, 0, 0,     // image size
    96, 0, 0, 0,    // horizontal resolution
    96, 0, 0, 0,    // vertical resolution
    0, 0, 0, 0,     // number of colors (all)
    0, 0, 0, 0      // number of important colors
    );
    image: PScreenshot;
    size: QWord;
begin
image:= PScreenshot(screenshot);

size:= image^.Width*image^.Height*4;

head[$02]:= (size + 54) and $ff;
head[$03]:= ((size + 54) shr 8) and $ff;
head[$04]:= ((size + 54) shr 16) and $ff;
head[$05]:= ((size + 54) shr 24) and $ff;
head[$12]:= image^.Width and $ff;
head[$13]:= (image^.Width shr 8) and $ff;
head[$14]:= (image^.Width shr 16) and $ff;
head[$15]:= (image^.Width shr 24) and $ff;
head[$16]:= image^.Height and $ff;
head[$17]:= (image^.Height shr 8) and $ff;
head[$18]:= (image^.Height shr 16) and $ff;
head[$19]:= (image^.Height shr 24) and $ff;
head[$22]:= size and $ff;
head[$23]:= (size shr 8) and $ff;
head[$24]:= (size shr 16) and $ff;
head[$25]:= (size shr 24) and $ff;

{$IOCHECKS OFF}
Assign(f, image^.filename);
Rewrite(f, 1);
if IOResult = 0 then
    begin
    BlockWrite(f, head, sizeof(head));
    BlockWrite(f, image^.buffer^, size);
    Close(f);
    end
else
    begin
    //AddFileLog('Error: Could not write to ' + filename);
    end;
{$IOCHECKS ON}

// free everything
FreeMem(image^.buffer, image^.size);
Dispose(image);
SaveScreenshot:= 0;
end;

{$ENDIF} // no PNG_SCREENSHOTS

// captures and saves the screen. returns true on success.
function MakeScreenshot(filename: shortstring): Boolean;
var p: Pointer;
    size: QWord;
    image: PScreenshot;
    format: GLenum;
    ext: string[4];
begin
// flash
ScreenFade:= sfFromWhite;
ScreenFadeValue:= sfMax;
ScreenFadeSpeed:= 5;

{$IFDEF PNG_SCREENSHOTS}
format:= GL_RGBA;
ext:= '.png';
{$ELSE}
format:= GL_BGRA;
ext:= '.bmp';
{$ENDIF}

size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 4;
p:= GetMem(size); // will be freed in SaveScreenshot()

// memory could not be allocated
if p = nil then
begin
    AddFileLog('Error: Could not allocate memory for screenshot.');
    MakeScreenshot:= false;
    exit;
end;

// read pixel from the front buffer
glReadPixels(0, 0, cScreenWidth, cScreenHeight, format, GL_UNSIGNED_BYTE, p);

// allocate and fill structure that will be passed to new thread
New(image); // will be disposed in SaveScreenshot()
image^.filename:= UserPathPrefix + '/Screenshots/' + filename + ext;
image^.width:= cScreenWidth;
image^.height:= cScreenHeight;
image^.size:= size;
image^.buffer:= p;

{$IFDEF USE_SDLTHREADS}
SDL_CreateThread(@SaveScreenshot{$IFDEF SDL13}, nil{$ENDIF}, image);
{$ELSE}
BeginThread(@SaveScreenshot, image);
{$ENDIF}
MakeScreenshot:= true; // possibly it is not true but we will not wait for thread to terminate
end;

// http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
var convertedSurf: PSDL_Surface;
begin
    doSurfaceConversion:= tmpsurf;
    if ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) or
       (tmpsurf^.format^.bitsperpixel = 24) then
    begin
        convertedSurf:= SDL_ConvertSurface(tmpsurf, conversionFormat, SDL_SWSURFACE);
        SDL_FreeSurface(tmpsurf);
        doSurfaceConversion:= convertedSurf;
    end;
end;

{$IFDEF SDL13}
function SDL_RectMake(x, y, width, height: LongInt): TSDL_Rect; inline;
{$ELSE}
function SDL_RectMake(x, y: SmallInt; width, height: Word): TSDL_Rect; inline;
{$ENDIF}
begin
    SDL_RectMake.x:= x;
    SDL_RectMake.y:= y;
    SDL_RectMake.w:= width;
    SDL_RectMake.h:= height;
end;

function GetTeamStatString(p: PTeam): shortstring;
var s: ansistring;
begin
    s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':';
    GetTeamStatString:= s;
end;

procedure initModule;
const SDL_PIXELFORMAT_ABGR8888 = (1 shl 31) or (6 shl 24) or (7 shl 20) or (6 shl 16) or (32 shl 8) or 4;
begin
    conversionFormat:= SDL_AllocFormat(SDL_PIXELFORMAT_ABGR8888);
end;

procedure freeModule;
begin
    recordFileName:= '';
    SDL_FreeFormat(conversionFormat);
end;

end.