hedgewars/uUtils.pas
changeset 4374 bcefeeabaa33
child 4380 b78638b36b89
equal deleted inserted replaced
4373:fe0e3903bb9e 4374:bcefeeabaa33
       
     1 {$INCLUDE "options.inc"}
       
     2 unit uUtils;
       
     3 
       
     4 interface
       
     5 uses uTypes, uFloat, GLunit;
       
     6 
       
     7 procedure SplitBySpace(var a, b: shortstring);
       
     8 procedure SplitByChar(var a, b: ansistring; c: char);
       
     9 
       
    10 function  EnumToStr(const en : TGearType) : shortstring; overload;
       
    11 function  EnumToStr(const en : TSound) : shortstring; overload;
       
    12 function  EnumToStr(const en : TAmmoType) : shortstring; overload;
       
    13 function  EnumToStr(const en : THogEffect) : shortstring; overload;
       
    14 
       
    15 function  Min(a, b: LongInt): LongInt; inline;
       
    16 function  Max(a, b: LongInt): LongInt; inline;
       
    17 
       
    18 function  IntToStr(n: LongInt): shortstring;
       
    19 function  FloatToStr(n: hwFloat): shortstring;
       
    20 
       
    21 function  DxDy2Angle(const _dY, _dX: hwFloat): GLfloat;
       
    22 function  DxDy2Angle32(const _dY, _dX: hwFloat): LongInt;
       
    23 function  DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt;
       
    24 
       
    25 procedure SetLittle(var r: hwFloat);
       
    26 
       
    27 function  Str2PChar(const s: shortstring): PChar;
       
    28 function  DecodeBase64(s: shortstring): shortstring;
       
    29 
       
    30 function  isPowerOf2(i: Longword): boolean;
       
    31 function  toPowerOf2(i: Longword): Longword; inline;
       
    32 
       
    33 function  endian(independent: LongWord): LongWord; inline;
       
    34 
       
    35 {$IFDEF DEBUGFILE}
       
    36 procedure AddFileLog(s: shortstring);
       
    37 {$ENDIF}
       
    38 
       
    39 procedure initModule;
       
    40 procedure freeModule;
       
    41 
       
    42 implementation
       
    43 uses typinfo, Math, uConsts, uVariables, SysUtils;
       
    44 
       
    45 var
       
    46 {$IFDEF DEBUGFILE}
       
    47     f: textfile;
       
    48 {$ENDIF}
       
    49 
       
    50 // should this include "strtolower()" for the split string?
       
    51 procedure SplitBySpace(var a, b: shortstring);
       
    52 var i, t: LongInt;
       
    53 begin
       
    54 i:= Pos(' ', a);
       
    55 if i > 0 then
       
    56     begin
       
    57     for t:= 1 to Pred(i) do
       
    58         if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32);
       
    59     b:= copy(a, i + 1, Length(a) - i);
       
    60     byte(a[0]):= Pred(i)
       
    61     end else b:= '';
       
    62 end;
       
    63 
       
    64 procedure SplitByChar(var a, b: ansistring; c: char);
       
    65 var i: LongInt;
       
    66 begin
       
    67 i:= Pos(c, a);
       
    68 if i > 0 then
       
    69     begin
       
    70     b:= copy(a, i + 1, Length(a) - i);
       
    71     setlength(a, Pred(i));
       
    72     end else b:= '';
       
    73 end;
       
    74 
       
    75 function EnumToStr(const en : TGearType) : shortstring; overload;
       
    76 begin
       
    77 EnumToStr:= GetEnumName(TypeInfo(TGearType), ord(en))
       
    78 end;
       
    79 
       
    80 function EnumToStr(const en : TSound) : shortstring; overload;
       
    81 begin
       
    82 EnumToStr:= GetEnumName(TypeInfo(TSound), ord(en))
       
    83 end;
       
    84 
       
    85 function EnumToStr(const en : TAmmoType) : shortstring; overload;
       
    86 begin
       
    87 EnumToStr:= GetEnumName(TypeInfo(TAmmoType), ord(en))
       
    88 end;
       
    89 
       
    90 function EnumToStr(const en: THogEffect) : shortstring; overload;
       
    91 begin
       
    92     EnumToStr := GetEnumName(TypeInfo(THogEffect), ord(en))
       
    93 end;
       
    94 
       
    95 
       
    96 function Min(a, b: LongInt): LongInt;
       
    97 begin
       
    98 if a < b then Min:= a else Min:= b
       
    99 end;
       
   100 
       
   101 function Max(a, b: LongInt): LongInt;
       
   102 begin
       
   103 if a > b then Max:= a else Max:= b
       
   104 end;
       
   105 
       
   106 
       
   107 function IntToStr(n: LongInt): shortstring;
       
   108 begin
       
   109 str(n, IntToStr)
       
   110 end;
       
   111 
       
   112 function FloatToStr(n: hwFloat): shortstring;
       
   113 begin
       
   114 FloatToStr:= cstr(n) + '_' + inttostr(Lo(n.QWordValue))
       
   115 end;
       
   116 
       
   117 
       
   118 function DxDy2Angle(const _dY, _dX: hwFloat): GLfloat;
       
   119 var dY, dX: Extended;
       
   120 begin
       
   121 dY:= _dY.QWordValue / $100000000;
       
   122 if _dY.isNegative then dY:= - dY;
       
   123 dX:= _dX.QWordValue / $100000000;
       
   124 if _dX.isNegative then dX:= - dX;
       
   125 DxDy2Angle:= arctan2(dY, dX) * 180 / pi
       
   126 end;
       
   127 
       
   128 function DxDy2Angle32(const _dY, _dX: hwFloat): LongInt;
       
   129 const _16divPI: Extended = 16/pi;
       
   130 var dY, dX: Extended;
       
   131 begin
       
   132 dY:= _dY.QWordValue / $100000000;
       
   133 if _dY.isNegative then dY:= - dY;
       
   134 dX:= _dX.QWordValue / $100000000;
       
   135 if _dX.isNegative then dX:= - dX;
       
   136 DxDy2Angle32:= trunc(arctan2(dY, dX) * _16divPI) and $1f
       
   137 end;
       
   138 
       
   139 function DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt;
       
   140 const MaxAngleDivPI: Extended = cMaxAngle/pi;
       
   141 var dY, dX: Extended;
       
   142 begin
       
   143 dY:= _dY.QWordValue / $100000000;
       
   144 if _dY.isNegative then dY:= - dY;
       
   145 dX:= _dX.QWordValue / $100000000;
       
   146 if _dX.isNegative then dX:= - dX;
       
   147 DxDy2AttackAngle:= trunc(arctan2(dY, dX) * MaxAngleDivPI)
       
   148 end;
       
   149 
       
   150 
       
   151 procedure SetLittle(var r: hwFloat);
       
   152 begin
       
   153 r:= SignAs(cLittle, r)
       
   154 end;
       
   155 
       
   156 
       
   157 function isPowerOf2(i: Longword): boolean;
       
   158 begin
       
   159 if i = 0 then exit(true);
       
   160 while not odd(i) do i:= i shr 1;
       
   161 isPowerOf2:= (i = 1)
       
   162 end;
       
   163 
       
   164 function toPowerOf2(i: Longword): Longword;
       
   165 begin
       
   166 toPowerOf2:= 1;
       
   167 while (toPowerOf2 < i) do toPowerOf2:= toPowerOf2 shl 1
       
   168 end;
       
   169 
       
   170 
       
   171 function DecodeBase64(s: shortstring): shortstring;
       
   172 const table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
       
   173 var i, t, c: Longword;
       
   174 begin
       
   175 c:= 0;
       
   176 for i:= 1 to Length(s) do
       
   177     begin
       
   178     t:= Pos(s[i], table);
       
   179     if s[i] = '=' then inc(c);
       
   180     if t > 0 then byte(s[i]):= t - 1 else byte(s[i]):= 0
       
   181     end;
       
   182 
       
   183 i:= 1;
       
   184 t:= 1;
       
   185 while i <= length(s) do
       
   186     begin
       
   187     DecodeBase64[t    ]:= char((byte(s[i    ]) shl 2) or (byte(s[i + 1]) shr 4));
       
   188     DecodeBase64[t + 1]:= char((byte(s[i + 1]) shl 4) or (byte(s[i + 2]) shr 2));
       
   189     DecodeBase64[t + 2]:= char((byte(s[i + 2]) shl 6) or (byte(s[i + 3])      ));
       
   190     inc(t, 3);
       
   191     inc(i, 4)
       
   192     end;
       
   193 
       
   194 if c < 3 then t:= t - c;
       
   195 
       
   196 byte(DecodeBase64[0]):= t - 1
       
   197 end;
       
   198 
       
   199 
       
   200 function Str2PChar(const s: shortstring): PChar;
       
   201 const CharArray: array[byte] of Char = '';
       
   202 begin
       
   203 CharArray:= s;
       
   204 CharArray[Length(s)]:= #0;
       
   205 Str2PChar:= @CharArray
       
   206 end;
       
   207 
       
   208 
       
   209 function endian(independent: LongWord): LongWord; inline;
       
   210 begin
       
   211 {$IFDEF ENDIAN_LITTLE}
       
   212 endian:= independent;
       
   213 {$ELSE}
       
   214 endian:= (((independent and $FF000000) shr 24) or
       
   215           ((independent and $00FF0000) shr 8) or
       
   216           ((independent and $0000FF00) shl 8) or
       
   217           ((independent and $000000FF) shl 24))
       
   218 {$ENDIF}
       
   219 end;
       
   220 
       
   221 
       
   222 {$IFDEF DEBUGFILE}
       
   223 procedure AddFileLog(s: shortstring);
       
   224 begin
       
   225 writeln(f, GameTicks: 6, ': ', s);
       
   226 flush(f)
       
   227 end;
       
   228 {$ENDIF}
       
   229 
       
   230 
       
   231 procedure initModule;
       
   232 {$IFDEF DEBUGFILE}{$IFNDEF IPHONEOS}var i: LongInt;{$ENDIF}{$ENDIF}
       
   233 begin
       
   234 {$IFDEF DEBUGFILE}
       
   235 {$I-}
       
   236 {$IFDEF IPHONEOS}
       
   237     Assign(f,'../Documents/hw-' + cLogfileBase + '.log');
       
   238     Rewrite(f);
       
   239 {$ELSE}
       
   240     if (ParamStr(1) <> '') and (ParamStr(2) <> '') then
       
   241         if (ParamCount <> 3) and (ParamCount <> cDefaultParamNum) then
       
   242         begin
       
   243             for i:= 0 to 7 do
       
   244             begin
       
   245                 assign(f, ExtractFileDir(ParamStr(2)) + '/' + cLogfileBase + inttostr(i) + '.log');
       
   246                 rewrite(f);
       
   247                 if IOResult = 0 then break;
       
   248             end;
       
   249             if IOResult <> 0 then f:= stderr; // if everything fails, write to stderr
       
   250         end
       
   251         else
       
   252         begin
       
   253             for i:= 0 to 7 do
       
   254             begin
       
   255                 assign(f, ParamStr(1) + '/Logs/' + cLogfileBase + inttostr(i) + '.log');
       
   256                 rewrite(f);
       
   257                 if IOResult = 0 then break;
       
   258             end;
       
   259             if IOResult <> 0 then f:= stderr; // if everything fails, write to stderr
       
   260         end
       
   261     else
       
   262         f:= stderr;
       
   263 {$ENDIF}
       
   264 {$I+}
       
   265 {$ENDIF}
       
   266 
       
   267 end;
       
   268 
       
   269 procedure freeModule;
       
   270 begin
       
   271     recordFileName:= '';
       
   272 
       
   273 {$IFDEF DEBUGFILE}
       
   274     writeln(f, 'halt at ', GameTicks, ' ticks. TurnTimeLeft = ', TurnTimeLeft);
       
   275     flush(f);
       
   276     close(f);
       
   277 {$ENDIF}
       
   278 end;
       
   279 
       
   280 end.