hedgewars/uMisc.pas
author unc0rr
Mon, 29 Sep 2008 22:14:23 +0000
changeset 1301 c6fe8a4bfd34
parent 1298 18fdc25fe65d
child 1346 b4d51b95aa16
permissions -rw-r--r--
Fix a bug screwing team selection up in network game (REMOVETEAM message doesn't have teamID, and after removing the team QMap still contains old info, when add and remove team with the same name, total hedgehogs number will be decreased by first team hh number)

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2008 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
 *)

unit uMisc;
interface
uses uConsts, SDLh, uFloat, GL;
{$INCLUDE options.inc}
var
	isCursorVisible : boolean = false;
	isTerminated    : boolean = false;
	isInLag         : boolean = false;
	isPaused        : boolean = false;
	isSoundEnabled  : boolean = true;
	isMusicEnabled  : boolean = false;
	isSEBackup      : boolean = true;
	isInMultiShoot  : boolean = false;
	isSpeed         : boolean = false;

	GameState     : TGameState = Low(TGameState);
	GameType      : TGameType = gmtLocal;
	GameFlags     : Longword = 0;
	TurnTimeLeft  : Longword = 0;
	cHedgehogTurnTime: Longword = 45000;
	cMaxAIThinkTime  : Longword = 9000;

	cCloudsNumber    : LongInt = 9;
	cScreenWidth     : LongInt = 1024;
	cScreenHeight    : LongInt = 768;
	cInitWidth       : LongInt = 1024;
	cInitHeight      : LongInt = 768;
	cBits            : LongInt = 16;
	cBitsStr         : string[2] = '16';
	cTagsMask        : byte = 7;

	cWaterLine       : LongInt = 1024;
	cVisibleWater    : LongInt = 128;
	cGearScrEdgesDist: LongInt = 240;
	cCursorEdgesDist : LongInt = 40;
	cTeamHealthWidth : LongInt = 128;
	cAltDamage       : boolean = true;

	GameTicks     : LongWord = 0;

	cSkyColor     : Longword = 0;
	cWhiteColor   : Longword = $FFFFFFFF;
	cColorNearBlack       : Longword = $FF000010;
	cExplosionBorderColor : LongWord = $808080;

	cShowFPS      : boolean = true;
	cCaseFactor   : Longword = 5;  {0..9}
	cLandAdditions: Longword = 4;
	cFullScreen   : boolean = true;
	cLocaleFName  : shortstring = 'en.txt';
	cSeed         : shortstring = '';
	cInitVolume   : LongInt = 128;
	cVolumeDelta  : LongInt = 0;
	cTimerInterval   : Longword = 5;
	cHasFocus     : boolean = true;
	cInactDelay   : Longword = 1250;

	bBetweenTurns: boolean = false;
	cHealthDecrease: LongWord = 0;
	bWaterRising   : Boolean = false;

{$WARNINGS OFF}
	cAirPlaneSpeed: hwFloat = (isNegative: false; QWordValue:   3006477107); // 1.4
	cBombsSpeed   : hwFloat = (isNegative: false; QWordValue:    429496729);
{$WARNINGS ON}

var
	cSendEmptyPacketTime : LongWord = 2000;
	cSendCursorPosTime   : LongWord = 50;
	ShowCrosshair  : boolean;
	cDrownSpeed,
	cMaxWindSpeed,
	cWindSpeed,
	cGravity: hwFloat;

	flagMakeCapture: boolean = false;

	InitStepsFlags: Longword = 0;

	RealTicks: Longword = 0;

	AttackBar: LongInt = 0; // 0 - none, 1 - just bar at the right-down corner, 2 - like in WWP

function hwSign(r: hwFloat): LongInt;
function Min(a, b: LongInt): LongInt;
function Max(a, b: LongInt): LongInt;
procedure OutError(Msg: String; isFatalError: boolean);
procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean);
procedure SDLTry(Assert: boolean; isFatal: boolean);
function IntToStr(n: LongInt): shortstring;
function FloatToStr(n: hwFloat): shortstring;
function DxDy2Angle(const _dY, _dX: hwFloat): GLfloat;
function DxDy2Angle32(const _dY, _dX: hwFloat): LongInt;
function DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt;
procedure AdjustColor(var Color: Longword);
{$IFDEF DEBUGFILE}
procedure AddFileLog(s: shortstring);
function RectToStr(Rect: TSDL_Rect): shortstring;
{$ENDIF}
procedure SetKB(n: Longword);
procedure SendKB;
procedure SetLittle(var r: hwFloat);
procedure SendStat(sit: TStatInfoType; s: shortstring);
function  Str2PChar(const s: shortstring): PChar;
function NewTexture(width, height: Longword; buf: Pointer): PTexture;
function  Surface2Tex(surf: PSDL_Surface): PTexture;
procedure FreeTexture(tex: PTexture);
function  toPowerOf2(i: Longword): Longword;
function DecodeBase64(s: shortstring): shortstring;
procedure MakeScreenshot(s: shortstring);

var CursorPoint: TPoint;
    TargetPoint: TPoint = (X: NoPointX; Y: 0);

implementation
uses uConsole, uStore, uIO, Math, uRandom, GLU;
var KBnum: Longword = 0;
{$IFDEF DEBUGFILE}
var f: textfile;
{$ENDIF}

function hwSign(r: hwFloat): LongInt;
begin
if r.isNegative then hwSign:= -1 else hwSign:= 1
end;

function Min(a, b: LongInt): LongInt;
begin
if a < b then Min:= a else Min:= b
end;

function Max(a, b: LongInt): LongInt;
begin
if a > b then Max:= a else Max:= b
end;

procedure OutError(Msg: String; isFatalError: boolean);
begin
{$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF}
WriteLnToConsole(Msg);
if isFatalError then
   begin
   SendIPC('E' + GetLastConsoleLine);
   SDL_Quit;
   halt(1)
   end
end;

procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean);
begin
if not Assert then OutError(Msg, isFatal)
end;

procedure SDLTry(Assert: boolean; isFatal: boolean);
begin
if not Assert then OutError(SDL_GetError, isFatal)
end;

procedure AdjustColor(var Color: Longword);
begin
Color:= SDL_MapRGB(PixelFormat, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF)
end;

function IntToStr(n: LongInt): shortstring;
begin
str(n, IntToStr)
end;

function FloatToStr(n: hwFloat): shortstring;
begin
FloatToStr:= cstr(n)
end;

function DxDy2Angle(const _dY, _dX: hwFloat): GLfloat;
var dY, dX: Extended;
begin
dY:= _dY.QWordValue / $100000000;
if _dY.isNegative then dY:= - dY;
dX:= _dX.QWordValue / $100000000;
if _dX.isNegative then dX:= - dX;
DxDy2Angle:= arctan2(dY, dX) * 180 / pi
end;

function DxDy2Angle32(const _dY, _dX: hwFloat): LongInt;
const _16divPI: Extended = 16/pi;
var dY, dX: Extended;
begin
dY:= _dY.QWordValue / $100000000;
if _dY.isNegative then dY:= - dY;
dX:= _dX.QWordValue / $100000000;
if _dX.isNegative then dX:= - dX;
DxDy2Angle32:= trunc(arctan2(dY, dX) * _16divPI) and $1f
end;

function DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt;
const MaxAngleDivPI: Extended = cMaxAngle/pi;
var dY, dX: Extended;
begin
dY:= _dY.QWordValue / $100000000;
if _dY.isNegative then dY:= - dY;
dX:= _dX.QWordValue / $100000000;
if _dX.isNegative then dX:= - dX;
DxDy2AttackAngle:= trunc(arctan2(dY, dX) * MaxAngleDivPI)
end;

procedure SetKB(n: Longword);
begin
KBnum:= n
end;

procedure SendKB;
var s: shortstring;
begin
if KBnum <> 0 then
   begin
   s:= 'K' + inttostr(KBnum);
   SendIPCRaw(@s, Length(s) + 1)
   end
end;

procedure SetLittle(var r: hwFloat);
begin
r:= SignAs(cLittle, r)
end;

procedure SendStat(sit: TStatInfoType; s: shortstring);
const stc: array [TStatInfoType] of char = 'rDkK';
begin
SendIPC('i' + stc[sit] + s)
end;

function Str2PChar(const s: shortstring): PChar;
const CharArray: array[byte] of Char = '';
begin
CharArray:= s;
CharArray[Length(s)]:= #0;
Str2PChar:= @CharArray
end;

function isPowerOf2(i: Longword): boolean;
begin
if i = 0 then exit(true);
while (i and 1) = 0 do i:= i shr 1;
isPowerOf2:= (i = 1)
end;

function toPowerOf2(i: Longword): Longword;
begin
toPowerOf2:= 1;
while (toPowerOf2 < i) do toPowerOf2:= toPowerOf2 shl 1
end;

function NewTexture(width, height: Longword; buf: Pointer): PTexture;
begin
new(NewTexture);
NewTexture^.w:= width;
NewTexture^.h:= height;

glGenTextures(1, @NewTexture^.id);

glBindTexture(GL_TEXTURE_2D, NewTexture^.id);

glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
end;

function Surface2Tex(surf: PSDL_Surface): PTexture;
var mode: LongInt;
    tw, th: Longword;
    tmpp: pointer;
begin
new(Surface2Tex);
Surface2Tex^.w:= surf^.w;
Surface2Tex^.h:= surf^.h;

if (surf^.format^.BytesPerPixel = 3) then mode:= GL_RGB else
if (surf^.format^.BytesPerPixel = 4) then mode:= GL_RGBA else
   begin
   TryDo(false, 'Surface2Tex: BytesPerPixel not in [3, 4]', true);
   Surface2Tex^.id:= 0;
   exit
   end;

glGenTextures(1, @Surface2Tex^.id);

glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);

if SDL_MustLock(surf) then
   SDLTry(SDL_LockSurface(surf) >= 0, true);

if not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h)) then
   begin
   tw:= toPowerOf2(Surf^.w);
   th:= toPowerOf2(Surf^.h);

   GetMem(tmpp, tw * th * surf^.format^.BytesPerPixel);

   gluScaleImage(mode, Surf^.w, Surf^.h, GL_UNSIGNED_BYTE,
        Surf^.pixels, tw, th, GL_UNSIGNED_BYTE,
        tmpp);

   glTexImage2D(GL_TEXTURE_2D, 0, mode, tw, th, 0, mode, GL_UNSIGNED_BYTE, tmpp);

   FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
   end else
   glTexImage2D(GL_TEXTURE_2D, 0, mode, surf^.w, surf^.h, 0, mode, GL_UNSIGNED_BYTE, surf^.pixels);

if SDL_MustLock(surf) then
   SDL_UnlockSurface(surf);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
end;

procedure FreeTexture(tex: PTexture);
begin
glDeleteTextures(1, @tex^.id);
dispose(tex)
end;

function DecodeBase64(s: shortstring): shortstring;
const table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var i, t, c: Longword;
begin
c:= 0;
for i:= 1 to Length(s) do
	begin
	t:= Pos(s[i], table);
	if s[i] = '=' then inc(c);
	if t > 0 then byte(s[i]):= t - 1 else byte(s[i]):= 0
	end;

i:= 1;
t:= 1;
while i <= length(s) do
	begin
	DecodeBase64[t    ]:= char((byte(s[i    ]) shl 2) or (byte(s[i + 1]) shr 4));
	DecodeBase64[t + 1]:= char((byte(s[i + 1]) shl 4) or (byte(s[i + 2]) shr 2));
	DecodeBase64[t + 2]:= char((byte(s[i + 2]) shl 6) or (byte(s[i + 3])      ));
	inc(t, 3);
	inc(i, 4)
	end;

if c < 3 then t:= t - c;

byte(DecodeBase64[0]):= t - 1
end;

const GL_BGR = $80E0; // some opengl headers don't have that const (?)
procedure MakeScreenshot(s: shortstring);
const head: array[0..8] of Word = (0, 2, 0, 0, 0, 0, 0, 0, 24);
var p: Pointer;
	size: Longword;
	f: file;
begin
head[6]:= cScreenWidth;
head[7]:= cScreenHeight;

size:= cScreenWidth * cScreenHeight * 3;
p:= GetMem(size);

glReadBuffer(GL_FRONT);
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p);

{$I-}
Assign(f, s);
Rewrite(f, 1);
if IOResult = 0 then
	begin
	BlockWrite(f, head, sizeof(head));
	BlockWrite(f, p^, size);
	Close(f);
	end;
{$I+}

FreeMem(p)
end;

{$IFDEF DEBUGFILE}
procedure AddFileLog(s: shortstring);
begin
writeln(f, GameTicks: 6, ': ', s);
flush(f)
end;

function RectToStr(Rect: TSDL_Rect): shortstring;
begin
RectToStr:= '(x: ' + inttostr(rect.x) + '; y: ' + inttostr(rect.y) + '; w: ' + inttostr(rect.w) + '; h: ' + inttostr(rect.h) + ')'
end;

var i: LongInt;
{$ENDIF}

initialization
cDrownSpeed.QWordValue:= 257698038;// 0.06
cMaxWindSpeed.QWordValue:= 2147484;// 0.0005
cWindSpeed.QWordValue:=     429496;// 0.0001
cGravity:= cMaxWindSpeed;

{$IFDEF DEBUGFILE}
{$I-}
if ParamCount > 0 then
  for i:= 0 to 7 do
    begin
    Assign(f, ParamStr(1) + '/debug' + inttostr(i) + '.txt');
    rewrite(f);
    if IOResult = 0 then break
    end;
{$I+}

finalization
//uRandom.DumpBuffer;
writeln(f, '-= halt at ',GameTicks,' ticks =-');
Flush(f);
close(f)
{$ENDIF}

end.