Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uMisc.pas
changeset 4374 bcefeeabaa33
parent 4371 ae172b2b03ed
child 4375 ae5507ddb989
equal deleted inserted replaced
4373:fe0e3903bb9e 4374:bcefeeabaa33 
    19 {$INCLUDE "options.inc"}
 
    19 {$INCLUDE "options.inc"}
 
    20 
    20 
    21 unit uMisc;
 
    21 unit uMisc;
 
    22 interface
 
    22 interface
 
    23 
    23 
    24 uses    SDLh, uConsts, uFloat, GLunit, Math, uTypes;
 
    24 uses    SDLh, uConsts, GLunit, uTypes;
 
    25 
    25 
    26 
    26 
    27 procedure SplitBySpace(var a, b: shortstring);
 
       
    28 procedure SplitByChar(var a, b: ansistring; c: char);
 
       
    29 function  EnumToStr(const en : TGearType) : shortstring; overload;
 
       
    30 function  EnumToStr(const en : TSound) : shortstring; overload;
 
       
    31 function  EnumToStr(const en : TAmmoType) : shortstring; overload;
 
       
    32 function  EnumToStr(const en : THogEffect) : shortstring; overload;
 
       
    33 procedure movecursor(dx, dy: LongInt);
 
    27 procedure movecursor(dx, dy: LongInt);
 
    34 function  hwSign(r: hwFloat): LongInt; inline;
 
       
    35 function  Min(a, b: LongInt): LongInt; inline;
 
       
    36 function  Max(a, b: LongInt): LongInt; inline;
 
       
    37 procedure OutError(Msg: shortstring; isFatalError: boolean);
 
       
    38 procedure TryDo(Assert: boolean; Msg: shortstring; isFatal: boolean); inline;
 
       
    39 procedure SDLTry(Assert: boolean; isFatal: boolean);
 
       
    40 function  IntToStr(n: LongInt): shortstring;
 
       
    41 function  FloatToStr(n: hwFloat): shortstring;
 
       
    42 function  DxDy2Angle(const _dY, _dX: hwFloat): GLfloat;
 
       
    43 function  DxDy2Angle32(const _dY, _dX: hwFloat): LongInt;
 
       
    44 function  DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt;
 
       
    45 (*
 
    28 (*
 
    46 procedure AdjustColor(var Color: Longword);
 
    29 procedure AdjustColor(var Color: Longword);
 
    47 procedure SetKB(n: Longword);
 
    30 procedure SetKB(n: Longword);
 
    48 *)
 
    31 *)
 
    49 procedure SendKB;
 
    32 procedure SendKB;
 
    50 procedure SetLittle(var r: hwFloat);
 
       
    51 procedure SendStat(sit: TStatInfoType; s: shortstring);
 
    33 procedure SendStat(sit: TStatInfoType; s: shortstring);
 
    52 function  Str2PChar(const s: shortstring): PChar;
 
       
    53 function  NewTexture(width, height: Longword; buf: Pointer): PTexture;
 
    34 function  NewTexture(width, height: Longword; buf: Pointer): PTexture;
 
    54 function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
 
    35 function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
 
    55 procedure FreeTexture(tex: PTexture);
 
    36 procedure FreeTexture(tex: PTexture);
 
    56 function  toPowerOf2(i: Longword): Longword; inline;
 
       
    57 function  DecodeBase64(s: shortstring): shortstring;
 
       
    58 function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
 
    37 function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
 
    59 function  endian(independent: LongWord): LongWord; inline;
 
    38 procedure OutError(Msg: shortstring; isFatalError: boolean);
 
    60 {$IFDEF DEBUGFILE}
 
    39 procedure TryDo(Assert: boolean; Msg: shortstring; isFatal: boolean); inline;
 
    61 procedure AddFileLog(s: shortstring);
 
    40 procedure SDLTry(Assert: boolean; isFatal: boolean);
 
    62 (* function  RectToStr(Rect: TSDL_Rect): shortstring; *)
 
       
    63 {$ENDIF}
 
       
    64 procedure MakeScreenshot(filename: shortstring);
 
    41 procedure MakeScreenshot(filename: shortstring);
 
    65 
    42 
    66 procedure initModule;
 
    43 procedure initModule;
 
    67 procedure freeModule;
 
    44 procedure freeModule;
 
    68 
    45 
    69 implementation
 
    46 implementation
 
    70 uses uConsole, uIO, typinfo, sysutils, uVariables;
 
    47 uses uConsole, uIO, typinfo, sysutils, uVariables, uUtils;
 
    71 
    48 
    72 var KBnum: Longword;
 
    49 var KBnum: Longword;
 
    73 {$IFDEF DEBUGFILE}
 
    50 
    74     f: textfile;
 
       
    75 {$ENDIF}
 
       
    76 
       
    77 // should this include "strtolower()" for the split string?
 
       
    78 procedure SplitBySpace(var a, b: shortstring);
 
       
    79 var i, t: LongInt;
 
       
    80 begin
 
       
    81 i:= Pos(' ', a);
 
       
    82 if i > 0 then
 
       
    83     begin
 
       
    84     for t:= 1 to Pred(i) do
 
       
    85         if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32);
 
       
    86     b:= copy(a, i + 1, Length(a) - i);
 
       
    87     byte(a[0]):= Pred(i)
 
       
    88     end else b:= '';
 
       
    89 end;
 
       
    90 
       
    91 procedure SplitByChar(var a, b: ansistring; c: char);
 
       
    92 var i: LongInt;
 
       
    93 begin
 
       
    94 i:= Pos(c, a);
 
       
    95 if i > 0 then
 
       
    96     begin
 
       
    97     b:= copy(a, i + 1, Length(a) - i);
 
       
    98     setlength(a, Pred(i));
 
       
    99     end else b:= '';
 
       
   100 end;
 
       
   101 
       
   102 function EnumToStr(const en : TGearType) : shortstring; overload;
 
       
   103 begin
 
       
   104 EnumToStr:= GetEnumName(TypeInfo(TGearType), ord(en))
 
       
   105 end;
 
       
   106 
       
   107 function EnumToStr(const en : TSound) : shortstring; overload;
 
       
   108 begin
 
       
   109 EnumToStr:= GetEnumName(TypeInfo(TSound), ord(en))
 
       
   110 end;
 
       
   111 
       
   112 function EnumToStr(const en : TAmmoType) : shortstring; overload;
 
       
   113 begin
 
       
   114 EnumToStr:= GetEnumName(TypeInfo(TAmmoType), ord(en))
 
       
   115 end;
 
       
   116 
       
   117 function EnumToStr(const en: THogEffect) : shortstring; overload;
 
       
   118 begin
 
       
   119     EnumToStr := GetEnumName(TypeInfo(THogEffect), ord(en))
 
       
   120 end;
 
       
   121 
    51 
   122 procedure movecursor(dx, dy: LongInt);
 
    52 procedure movecursor(dx, dy: LongInt);
 
   123 var x, y: LongInt;
 
    53 var x, y: LongInt;
 
   124 begin
 
    54 begin
 
   125 if (dx = 0) and (dy = 0) then exit;
 
    55 if (dx = 0) and (dy = 0) then exit;
 
   128 Inc(x, dx);
 
    58 Inc(x, dx);
 
   129 Inc(y, dy);
 
    59 Inc(y, dy);
 
   130 SDL_WarpMouse(x, y);
 
    60 SDL_WarpMouse(x, y);
 
   131 end;
 
    61 end;
 
   132 
    62 
   133 function hwSign(r: hwFloat): LongInt;
 
       
   134 begin
 
       
   135 // yes, we have negative zero for a reason
 
       
   136 if r.isNegative then hwSign:= -1 else hwSign:= 1
 
       
   137 end;
 
       
   138 
       
   139 function Min(a, b: LongInt): LongInt;
 
       
   140 begin
 
       
   141 if a < b then Min:= a else Min:= b
 
       
   142 end;
 
       
   143 
       
   144 function Max(a, b: LongInt): LongInt;
 
       
   145 begin
 
       
   146 if a > b then Max:= a else Max:= b
 
       
   147 end;
 
       
   148 
    63 
   149 procedure OutError(Msg: shortstring; isFatalError: boolean);
 
    64 procedure OutError(Msg: shortstring; isFatalError: boolean);
 
   150 begin
 
    65 begin
 
   151 // obsolete? written in WriteLnToConsole() anyway
 
    66 // obsolete? written in WriteLnToConsole() anyway
 
   152 // {$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF}
 
    67 // {$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF}
 
   180 KBnum:= n
 
    95 KBnum:= n
 
   181 end;
 
    96 end;
 
   182 *)
 
    97 *)
 
   183 
    98 
   184 
    99 
   185 function IntToStr(n: LongInt): shortstring;
 
       
   186 begin
 
       
   187 str(n, IntToStr)
 
       
   188 end;
 
       
   189 
       
   190 function FloatToStr(n: hwFloat): shortstring;
 
       
   191 begin
 
       
   192 FloatToStr:= cstr(n) + '_' + inttostr(Lo(n.QWordValue))
 
       
   193 end;
 
       
   194 
       
   195 procedure SetTextureParameters(enableClamp: Boolean);
 
   100 procedure SetTextureParameters(enableClamp: Boolean);
 
   196 begin
 
   101 begin
 
   197     if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
 
   102     if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
 
   198     begin
 
   103     begin
 
   199         glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
 
   104         glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
 
   201     end;
 
   106     end;
 
   202     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
 
   107     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
 
   203     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
 
   108     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
 
   204 end;
 
   109 end;
 
   205 
   110 
   206 function DxDy2Angle(const _dY, _dX: hwFloat): GLfloat;
 
       
   207 var dY, dX: Extended;
 
       
   208 begin
 
       
   209 dY:= _dY.QWordValue / $100000000;
 
       
   210 if _dY.isNegative then dY:= - dY;
 
       
   211 dX:= _dX.QWordValue / $100000000;
 
       
   212 if _dX.isNegative then dX:= - dX;
 
       
   213 DxDy2Angle:= arctan2(dY, dX) * 180 / pi
 
       
   214 end;
 
       
   215 
       
   216 function DxDy2Angle32(const _dY, _dX: hwFloat): LongInt;
 
       
   217 const _16divPI: Extended = 16/pi;
 
       
   218 var dY, dX: Extended;
 
       
   219 begin
 
       
   220 dY:= _dY.QWordValue / $100000000;
 
       
   221 if _dY.isNegative then dY:= - dY;
 
       
   222 dX:= _dX.QWordValue / $100000000;
 
       
   223 if _dX.isNegative then dX:= - dX;
 
       
   224 DxDy2Angle32:= trunc(arctan2(dY, dX) * _16divPI) and $1f
 
       
   225 end;
 
       
   226 
       
   227 function DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt;
 
       
   228 const MaxAngleDivPI: Extended = cMaxAngle/pi;
 
       
   229 var dY, dX: Extended;
 
       
   230 begin
 
       
   231 dY:= _dY.QWordValue / $100000000;
 
       
   232 if _dY.isNegative then dY:= - dY;
 
       
   233 dX:= _dX.QWordValue / $100000000;
 
       
   234 if _dX.isNegative then dX:= - dX;
 
       
   235 DxDy2AttackAngle:= trunc(arctan2(dY, dX) * MaxAngleDivPI)
 
       
   236 end;
 
       
   237 
   111 
   238 procedure SendKB;
 
   112 procedure SendKB;
 
   239 var s: shortstring;
 
   113 var s: shortstring;
 
   240 begin
 
   114 begin
 
   241 if KBnum <> 0 then
 
   115 if KBnum <> 0 then
 
   243 s:= 'K' + inttostr(KBnum);
 
   117 s:= 'K' + inttostr(KBnum);
 
   244 SendIPCRaw(@s, Length(s) + 1)
 
   118 SendIPCRaw(@s, Length(s) + 1)
 
   245 end
 
   119 end
 
   246 end;
 
   120 end;
 
   247 
   121 
   248 procedure SetLittle(var r: hwFloat);
 
       
   249 begin
 
       
   250 r:= SignAs(cLittle, r)
 
       
   251 end;
 
       
   252 
       
   253 procedure SendStat(sit: TStatInfoType; s: shortstring);
 
   122 procedure SendStat(sit: TStatInfoType; s: shortstring);
 
   254 const stc: array [TStatInfoType] of char = 'rDkKHTPsSB';
 
   123 const stc: array [TStatInfoType] of char = 'rDkKHTPsSB';
 
   255 var buf: shortstring;
 
   124 var buf: shortstring;
 
   256 begin
 
   125 begin
 
   257 buf:= 'i' + stc[sit] + s;
 
   126 buf:= 'i' + stc[sit] + s;
 
   258 SendIPCRaw(@buf[0], length(buf) + 1)
 
   127 SendIPCRaw(@buf[0], length(buf) + 1)
 
   259 end;
 
   128 end;
 
   260 
   129 
   261 function Str2PChar(const s: shortstring): PChar;
 
       
   262 const CharArray: array[byte] of Char = '';
 
       
   263 begin
 
       
   264 CharArray:= s;
 
       
   265 CharArray[Length(s)]:= #0;
 
       
   266 Str2PChar:= @CharArray
 
       
   267 end;
 
       
   268 
       
   269 function isPowerOf2(i: Longword): boolean;
 
       
   270 begin
 
       
   271 if i = 0 then exit(true);
 
       
   272 while (i and 1) = 0 do i:= i shr 1;
 
       
   273 isPowerOf2:= (i = 1)
 
       
   274 end;
 
       
   275 
       
   276 function toPowerOf2(i: Longword): Longword;
 
       
   277 begin
 
       
   278 toPowerOf2:= 1;
 
       
   279 while (toPowerOf2 < i) do toPowerOf2:= toPowerOf2 shl 1
 
       
   280 end;
 
       
   281 
   130 
   282 procedure ResetVertexArrays(texture: PTexture);
 
   131 procedure ResetVertexArrays(texture: PTexture);
 
   283 begin
 
   132 begin
 
   284 with texture^ do
 
   133 with texture^ do
 
   285     begin
 
   134     begin
 
   423         glDeleteTextures(1, @tex^.id);
 
   272         glDeleteTextures(1, @tex^.id);
 
   424         Dispose(tex);
 
   273         Dispose(tex);
 
   425     end
 
   274     end
 
   426 end;
 
   275 end;
 
   427 
   276 
   428 function DecodeBase64(s: shortstring): shortstring;
 
       
   429 const table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
 
       
   430 var i, t, c: Longword;
 
       
   431 begin
 
       
   432 c:= 0;
 
       
   433 for i:= 1 to Length(s) do
 
       
   434     begin
 
       
   435     t:= Pos(s[i], table);
 
       
   436     if s[i] = '=' then inc(c);
 
       
   437     if t > 0 then byte(s[i]):= t - 1 else byte(s[i]):= 0
 
       
   438     end;
 
       
   439 
       
   440 i:= 1;
 
       
   441 t:= 1;
 
       
   442 while i <= length(s) do
 
       
   443     begin
 
       
   444     DecodeBase64[t    ]:= char((byte(s[i    ]) shl 2) or (byte(s[i + 1]) shr 4));
 
       
   445     DecodeBase64[t + 1]:= char((byte(s[i + 1]) shl 4) or (byte(s[i + 2]) shr 2));
 
       
   446     DecodeBase64[t + 2]:= char((byte(s[i + 2]) shl 6) or (byte(s[i + 3])      ));
 
       
   447     inc(t, 3);
 
       
   448     inc(i, 4)
 
       
   449     end;
 
       
   450 
       
   451 if c < 3 then t:= t - c;
 
       
   452 
       
   453 byte(DecodeBase64[0]):= t - 1
 
       
   454 end;
 
       
   455 
   277 
   456 procedure MakeScreenshot(filename: shortstring);
 
   278 procedure MakeScreenshot(filename: shortstring);
 
   457 var p: Pointer;
 
   279 var p: Pointer;
 
   458     size: Longword;
 
   280     size: Longword;
 
   459     f: file;
 
   281     f: file;
 
   521 {$I+}
 
   343 {$I+}
 
   522 
   344 
   523 FreeMem(p)
 
   345 FreeMem(p)
 
   524 end;
 
   346 end;
 
   525 
   347 
   526 {$IFDEF DEBUGFILE}
 
       
   527 procedure AddFileLog(s: shortstring);
 
       
   528 begin
 
       
   529 writeln(f, GameTicks: 6, ': ', s);
 
       
   530 flush(f)
 
       
   531 end;
 
       
   532 (*
 
       
   533 function RectToStr(Rect: TSDL_Rect): shortstring;
 
       
   534 begin
 
       
   535 RectToStr:= '(x: ' + inttostr(rect.x) + '; y: ' + inttostr(rect.y) + '; w: ' + inttostr(rect.w) + '; h: ' + inttostr(rect.h) + ')'
 
       
   536 end;
 
       
   537 *)
 
       
   538 {$ENDIF}
 
       
   539 
       
   540 function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
 
   348 function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
 
   541 {* for more information http://www.idevgames.com/forum/showpost.php?p=85864&postcount=7 *}
 
   349 {* for more information http://www.idevgames.com/forum/showpost.php?p=85864&postcount=7 *}
 
   542 var convertedSurf: PSDL_Surface = nil;
 
   350 var convertedSurf: PSDL_Surface = nil;
 
   543 begin
 
   351 begin
 
   544     if (tmpsurf^.format^.bitsperpixel = 24) or ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) then
 
   352     if (tmpsurf^.format^.bitsperpixel = 24) or ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) then
 
   549     end;
 
   357     end;
 
   550 
   358 
   551     exit(tmpsurf);
 
   359     exit(tmpsurf);
 
   552 end;
 
   360 end;
 
   553 
   361 
   554 function endian(independent: LongWord): LongWord; inline;
 
       
   555 begin
 
       
   556 {$IFDEF ENDIAN_LITTLE}
 
       
   557 endian:= independent;
 
       
   558 {$ELSE}
 
       
   559 endian:= (((independent and $FF000000) shr 24) or
 
       
   560           ((independent and $00FF0000) shr 8) or
 
       
   561           ((independent and $0000FF00) shl 8) or
 
       
   562           ((independent and $000000FF) shl 24))
 
       
   563 {$ENDIF}
 
       
   564 end;
 
       
   565 
       
   566 
   362 
   567 procedure initModule;
 
   363 procedure initModule;
 
   568 {$IFDEF DEBUGFILE}{$IFNDEF IPHONEOS}var i: LongInt;{$ENDIF}{$ENDIF}
 
       
   569 begin
 
   364 begin
 
   570     KBnum           := 0;
 
   365     KBnum           := 0;
 
   571 
       
   572 {$IFDEF DEBUGFILE}
 
       
   573 {$I-}
 
       
   574 {$IFDEF IPHONEOS}
 
       
   575     Assign(f,'../Documents/hw-' + cLogfileBase + '.log');
 
       
   576     Rewrite(f);
 
       
   577 {$ELSE}
 
       
   578     if (ParamStr(1) <> '') and (ParamStr(2) <> '') then
 
       
   579         if (ParamCount <> 3) and (ParamCount <> cDefaultParamNum) then
 
       
   580         begin
 
       
   581             for i:= 0 to 7 do
 
       
   582             begin
 
       
   583                 assign(f, ExtractFileDir(ParamStr(2)) + '/' + cLogfileBase + inttostr(i) + '.log');
 
       
   584                 rewrite(f);
 
       
   585                 if IOResult = 0 then break;
 
       
   586             end;
 
       
   587             if IOResult <> 0 then f:= stderr; // if everything fails, write to stderr
 
       
   588         end
 
       
   589         else
 
       
   590         begin
 
       
   591             for i:= 0 to 7 do
 
       
   592             begin
 
       
   593                 assign(f, ParamStr(1) + '/Logs/' + cLogfileBase + inttostr(i) + '.log');
 
       
   594                 rewrite(f);
 
       
   595                 if IOResult = 0 then break;
 
       
   596             end;
 
       
   597             if IOResult <> 0 then f:= stderr; // if everything fails, write to stderr
 
       
   598         end
 
       
   599     else
 
       
   600         f:= stderr;
 
       
   601 {$ENDIF}
 
       
   602 {$I+}
 
       
   603 {$ENDIF}
 
       
   604 
       
   605 end;
 
   366 end;
 
   606 
   367 
   607 procedure freeModule;
 
   368 procedure freeModule;
 
   608 begin
 
   369 begin
 
   609     recordFileName:= '';
 
   370     recordFileName:= '';
 
   610     while TextureList <> nil do FreeTexture(TextureList);
 
   371     while TextureList <> nil do FreeTexture(TextureList);
 
   611 
       
   612 {$IFDEF DEBUGFILE}
 
       
   613     writeln(f, 'halt at ', GameTicks, ' ticks. TurnTimeLeft = ', TurnTimeLeft);
 
       
   614     flush(f);
 
       
   615     close(f);
 
       
   616 {$ENDIF}
 
       
   617 end;
 
   372 end;
 
   618 
   373 
   619 end.
 
   374 end.
hedgewars