src/game/g_basic.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit g_basic;
  17
  18 interface
  19
  20 uses
  21   utils, g_phys;
  22
  23 const
  24   GAME_VERSION  = '0.667';
  25   GAME_BUILDDATE = {$I %DATE%};
  26   GAME_BUILDTIME = {$I %TIME%};
  27   UID_GAME    = 1;
  28   UID_PLAYER  = 2;
  29   UID_MONSTER = 3;
  30   UID_ITEM    = 10;
  31   UID_MAX_GAME    = $10;
  32   UID_MAX_PLAYER  = $7FFF;
  33   UID_MAX_MONSTER = $FFFF;
  34
  35 type
  36   TDirection = (D_LEFT, D_RIGHT);
  37   WArray = array of Word;
  38   DWArray = array of DWORD;
  39   String20 = String[20];
  40
  41 function g_GetBuilderName (): AnsiString;
  42 function g_GetBuildHash (full: Boolean = True): AnsiString;
  43 function g_GetBuildArch (): AnsiString;
  44
  45 function g_CreateUID(UIDType: Byte): Word;
  46 function g_GetUIDType(UID: Word): Byte;
  47 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
  48                    X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
  49 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
  50 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
  51 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
  52 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
  53                          X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
  54 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
  55 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
  56 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean; // `true`: no wall hit
  57 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
  58 function g_Look(a, b: PObj; d: TDirection): Boolean;
  59 procedure IncMax(var A: Integer; B, Max: Integer); overload;
  60 procedure IncMax(var A: Single; B, Max: Single); overload;
  61 procedure IncMax(var A: Integer; Max: Integer); overload;
  62 procedure IncMax(var A: Single; Max: Single); overload;
  63 procedure IncMax(var A: Word; B, Max: Word); overload;
  64 procedure IncMax(var A: Word; Max: Word); overload;
  65 procedure IncMax(var A: SmallInt; B, Max: SmallInt); overload;
  66 procedure IncMax(var A: SmallInt; Max: SmallInt); overload;
  67 procedure DecMin(var A: Integer; B, Min: Integer); overload;
  68 procedure DecMin(var A: Single; B, Min: Single); overload;
  69 procedure DecMin(var A: Integer; Min: Integer); overload;
  70 procedure DecMin(var A: Single; Min: Single); overload;
  71 procedure DecMin(var A: Word; B, Min: Word); overload;
  72 procedure DecMin(var A: Word; Min: Word); overload;
  73 procedure DecMin(var A: Byte; B, Min: Byte); overload;
  74 procedure DecMin(var A: Byte; Min: Byte); overload;
  75 function Sign(A: Integer): ShortInt; overload;
  76 function Sign(A: Single): ShortInt; overload;
  77 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
  78 function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
  79 function GetAngle2(vx, vy: Integer): SmallInt;
  80 function Sscanf(const s: string; const fmt: string;
  81                 const Pointers: array of Pointer): Integer;
  82 function InDWArray(a: DWORD; arr: DWArray): Boolean;
  83 function InWArray(a: Word; arr: WArray): Boolean;
  84 function InSArray(a: string; arr: SSArray): Boolean;
  85 function GetPos(UID: Word; o: PObj): Boolean;
  86 function parse(s: string): SSArray;
  87 function parse2(s: string; delim: Char): SSArray;
  88 function g_GetFileTime(fileName: String): Integer;
  89 function g_SetFileTime(fileName: String; time: Integer): Boolean;
  90 procedure SortSArray(var S: SSArray);
  91 function b_Text_Format(S: string): string;
  92 function b_Text_Unformat(S: string): string;
  93 function b_Text_Wrap(S: string; LineLen: Integer): string;
  94 function b_Text_LineCount(S: string): Integer;
  95
  96 var
  97   gmon_dbg_los_enabled: Boolean = true;
  98
  99 implementation
 100
 101 uses
 102   Math, geom, e_log, g_map, g_gfx, g_player, SysUtils, MAPDEF,
 103   StrUtils, g_monsters, g_items, g_game;
 104
 105 {$PUSH}
 106 {$WARN 2054 OFF} // unknwon env var
 107 {$WARN 6018 OFF} // unreachable code
 108 function g_GetBuilderName (): AnsiString;
 109 begin
 110   if {$I %D2DF_BUILD_USER%} <> '' then
 111     result := {$I %D2DF_BUILD_USER%} // custom
 112   else if {$I %USER%} <> '' then
 113     result := {$I %USER%} // unix username
 114   else if {$I %USERNAME%} <> '' then
 115     result := {$I %USERNAME%} // windows username
 116   else
 117     result := 'unknown'
 118 end;
 119
 120 function g_GetBuildHash (full: Boolean = True): AnsiString;
 121 begin
 122   if {$I %D2DF_BUILD_HASH%} <> '' then
 123     if full then
 124       result := {$I %D2DF_BUILD_HASH%}
 125     else
 126       result := Copy({$I %D2DF_BUILD_HASH%}, 1, 7)
 127   else
 128     result := 'custom build'
 129 end;
 130 {$POP}
 131
 132 function g_GetBuildArch (): AnsiString;
 133   var cpu, mode, fpu: AnsiString;
 134 begin
 135   {$IF DEFINED(CPUX86_64) OR DEFINED(CPUAMD64) OR DEFINED(CPUX64)}
 136     cpu := 'x86_64';
 137   {$ELSEIF DEFINED(CPUI386) OR DEFINED(CPU386)}
 138     cpu := 'x86';
 139   {$ELSEIF DEFINED(CPUI8086)}
 140     cpu := 'i8086';
 141   {$ELSEIF DEFINED(CPUI64)}
 142     cpu := 'Itanium64';
 143   {$ELSEIF DEFINED(CPUARM)}
 144     cpu := 'ARM';
 145   {$ELSEIF DEFINED(CPUAVR)}
 146     cpu := 'AVR';
 147   {$ELSEIF DEFINED(CPUPOWERPC32)}
 148     cpu := 'PowerPC_32';
 149   {$ELSEIF DEFINED(CPUPOWERPC64)}
 150     cpu := 'PowerPC_64';
 151   {$ELSEIF DEFINED(CPUALPHA)}}
 152     cpu := 'Alpha';
 153   {$ELSEIF DEFINED(CPUSPARC32)}
 154     cpu := 'Sparc32';
 155   {$ELSEIF DEFINED(CPUM68020)}
 156     cpu := 'M68020';
 157   {$ELSEIF DEFINED(CPU68K) OR DEFINED(CPUM68K)}
 158     cpu := 'm68k';
 159   {$ELSEIF DEFINED(CPUSPARC)}
 160     cpu := 'unknown-sparc';
 161   {$ELSEIF DEFINED(CPUPOWERPC)}
 162     cpu := 'unknown-ppc';
 163   {$ELSEIF DEFINED(CPU86) OR DEFINED(CPU87)}
 164     cpu := 'unknown-intel';
 165   {$ELSE}
 166     cpu := 'unknown-arch';
 167   {$ENDIF}
 168
 169   {$IF DEFINED(CPU64)}
 170     mode := '64-bit';
 171   {$ELSEIF DEFINED(CPU32)}
 172     mode := '32-bit';
 173   {$ELSEIF DEFINED(CPU16)}
 174     mode := '16-bit';
 175   {$ELSE}
 176     mode := 'unknown-mode';
 177   {$ENDIF}
 178
 179   {$IF DEFINED(FPUSOFT)}
 180     fpu := 'soft';
 181   {$ELSEIF DEFINED(FPUSSE3)}
 182     fpu := 'sse3';
 183   {$ELSEIF DEFINED(FPUSSE2)}
 184     fpu := 'sse2';
 185   {$ELSEIF DEFINED(FPUSSE)}
 186     fpu := 'sse';
 187   {$ELSEIF DEFINED(FPUSSE64)}
 188     fpu := 'sse64';
 189   {$ELSEIF DEFINED(FPULIBGCC)}
 190     fpu := 'libgcc';
 191   {$ELSEIF DEFINED(FPU68881)}
 192     fpu := '68881';
 193   {$ELSEIF DEFINED(FPUVFP)}
 194     fpu := 'vfp';
 195   {$ELSEIF DEFINED(FPUFPA11)}
 196     fpu := 'fpa11';
 197   {$ELSEIF DEFINED(FPUFPA10)}
 198     fpu := 'fpa10';
 199   {$ELSEIF DEFINED(FPUFPA)}
 200     fpu := 'fpa';
 201   {$ELSEIF DEFINED(FPUX87)}
 202     fpu := 'x87';
 203   {$ELSEIF DEFINED(FPUITANIUM)}
 204     fpu := 'itanium';
 205   {$ELSEIF DEFINED(FPUSTANDARD)}
 206     fpu := 'standard';
 207   {$ELSEIF DEFINED(FPUHARD)}
 208     fpu := 'hard';
 209   {$ELSE}
 210     fpu := 'unknown-fpu';
 211   {$ENDIF}
 212
 213   result := cpu + ' ' + mode + ' ' + fpu;
 214 end;
 215
 216 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
 217 begin
 218   Result := Min(Round(Hypot(Abs(X2-X1), Abs(Y2-Y1))), 65535);
 219 end;
 220
 221 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
 222 begin
 223   result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
 224 end;
 225 (*
 226 var
 227   a: Integer;
 228 begin
 229   Result := False;
 230
 231   if gWalls = nil then
 232     Exit;
 233
 234   for a := 0 to High(gWalls) do
 235     if gWalls[a].Enabled and
 236        not ( ((Y + Height <= gWalls[a].Y) or
 237               (Y          >= gWalls[a].Y + gWalls[a].Height)) or
 238              ((X + Width  <= gWalls[a].X) or
 239               (X          >= gWalls[a].X + gWalls[a].Width)) ) then
 240     begin
 241       Result := True;
 242       Exit;
 243     end;
 244 end;
 245 *)
 246
 247 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
 248 var
 249   a: Integer;
 250 begin
 251   Result := False;
 252
 253   if gPlayers = nil then Exit;
 254
 255   for a := 0 to High(gPlayers) do
 256     if (gPlayers[a] <> nil) and gPlayers[a].alive then
 257       if gPlayers[a].Collide(X, Y, Width, Height) then
 258       begin
 259         Result := True;
 260         Exit;
 261       end;
 262 end;
 263
 264
 265 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean;
 266 var
 267   wallHitX: Integer = 0;
 268   wallHitY: Integer = 0;
 269 (*
 270   i: Integer;
 271   dx, dy: Integer;
 272   Xerr, Yerr, d: LongWord;
 273   incX, incY: Integer;
 274   x, y: Integer;
 275 *)
 276 begin
 277   (*
 278   result := False;
 279
 280   Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
 281
 282   Xerr := 0;
 283   Yerr := 0;
 284   dx := X2-X1;
 285   dy := Y2-Y1;
 286
 287   if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
 288   if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
 289
 290   dx := abs(dx);
 291   dy := abs(dy);
 292
 293   if dx > dy then d := dx else d := dy;
 294
 295   x := X1;
 296   y := Y1;
 297
 298   for i := 1 to d do
 299   begin
 300     Inc(Xerr, dx);
 301     Inc(Yerr, dy);
 302     if Xerr>d then
 303     begin
 304       Dec(Xerr, d);
 305       Inc(x, incX);
 306     end;
 307     if Yerr > d then
 308     begin
 309       Dec(Yerr, d);
 310       Inc(y, incY);
 311     end;
 312
 313     if (y > gMapInfo.Height-1) or
 314     (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
 315       Exit;
 316     if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
 317       Exit;
 318   end;
 319
 320   Result := True;
 321   *)
 322
 323   // `true` if no obstacles
 324   if (g_profile_los) then g_Mons_LOS_Start();
 325   result := (g_Map_traceToNearestWall(x1, y1, x2, y2, @wallHitX, @wallHitY) = nil);
 326   if (g_profile_los) then g_Mons_LOS_End();
 327 end;
 328
 329
 330 function g_CreateUID(UIDType: Byte): Word;
 331 var
 332   ok: Boolean;
 333   i: Integer;
 334 begin
 335   Result := $0;
 336
 337   case UIDType of
 338     UID_PLAYER:
 339     begin
 340       repeat
 341         Result := UID_MAX_GAME+$1+Random(UID_MAX_PLAYER-UID_MAX_GAME+$1);
 342
 343         ok := True;
 344         if gPlayers <> nil then
 345           for i := 0 to High(gPlayers) do
 346             if gPlayers[i] <> nil then
 347               if Result = gPlayers[i].UID then
 348               begin
 349                 ok := False;
 350                 Break;
 351               end;
 352       until ok;
 353     end;
 354
 355     UID_MONSTER:
 356     begin
 357       //FIXME!!!
 358       while true do
 359       begin
 360         result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1);
 361         if (g_Monsters_ByUID(result) = nil) then break;
 362       end;
 363     end;
 364   end;
 365 end;
 366
 367 function g_GetUIDType(UID: Word): Byte;
 368 begin
 369   if UID <= UID_MAX_GAME then
 370     Result := UID_GAME
 371   else
 372     if UID <= UID_MAX_PLAYER then
 373       Result := UID_PLAYER
 374     else
 375       Result := UID_MONSTER;
 376 end;
 377
 378 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
 379                    X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
 380 begin
 381   Result := not ( ((Y1 + Height1 <= Y2) or
 382                    (Y2 + Height2 <= Y1)) or
 383                   ((X1 + Width1  <= X2) or
 384                    (X2 + Width2  <= X1)) );
 385 end;
 386
 387 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
 388                          X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
 389 begin
 390   Result := g_Collide(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 391             g_Collide(X1+1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 392             g_Collide(X1-1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 393             g_Collide(X1, Y1+1, Width1, Height1, X2, Y2, Width2, Height2) or
 394             g_Collide(X1, Y1-1, Width1, Height1, X2, Y2, Width2, Height2);
 395 end;
 396
 397 function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean; inline;
 398 begin
 399   Result := not (((Y1 + Height1 <= Y2) or
 400                   (Y1           >= Y2 + Height2)) or
 401                   ((X1 + Width1 <= X2) or
 402                    (X1          >= X2 + Width2)));
 403 end;
 404
 405 function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean; inline;
 406 begin
 407   //Result :=  not (((Y2 <= Y3) or (Y1  >= Y4)) or ((X2 <= X3) or (X1  >= X4)));
 408   Result := c(X1, Y1, X2-X1, Y2-Y1, X3, Y3, X4-X3, Y4-Y3);
 409 end;
 410
 411 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
 412 begin
 413   X := X-X2;
 414   Y := Y-Y2;
 415   Result := (x >= 0) and (x <= Width) and
 416             (y >= 0) and (y <= Height);
 417 end;
 418
 419 procedure IncMax(var A: Integer; B, Max: Integer);
 420 begin
 421   if A+B > Max then A := Max else A := A+B;
 422 end;
 423
 424 procedure IncMax(var A: Single; B, Max: Single);
 425 begin
 426   if A+B > Max then A := Max else A := A+B;
 427 end;
 428
 429 procedure DecMin(var A: Integer; B, Min: Integer);
 430 begin
 431   if A-B < Min then A := Min else A := A-B;
 432 end;
 433
 434 procedure DecMin(var A: Word; B, Min: Word);
 435 begin
 436   if A-B < Min then A := Min else A := A-B;
 437 end;
 438
 439 procedure DecMin(var A: Single; B, Min: Single);
 440 begin
 441   if A-B < Min then A := Min else A := A-B;
 442 end;
 443
 444 procedure IncMax(var A: Integer; Max: Integer);
 445 begin
 446   if A+1 > Max then A := Max else A := A+1;
 447 end;
 448
 449 procedure IncMax(var A: Single; Max: Single);
 450 begin
 451   if A+1 > Max then A := Max else A := A+1;
 452 end;
 453
 454 procedure IncMax(var A: Word; B, Max: Word);
 455 begin
 456   if A+B > Max then A := Max else A := A+B;
 457 end;
 458
 459 procedure IncMax(var A: Word; Max: Word);
 460 begin
 461   if A+1 > Max then A := Max else A := A+1;
 462 end;
 463
 464 procedure IncMax(var A: SmallInt; B, Max: SmallInt);
 465 begin
 466   if A+B > Max then A := Max else A := A+B;
 467 end;
 468
 469 procedure IncMax(var A: SmallInt; Max: SmallInt);
 470 begin
 471   if A+1 > Max then A := Max else A := A+1;
 472 end;
 473
 474 procedure DecMin(var A: Integer; Min: Integer);
 475 begin
 476   if A-1 < Min then A := Min else A := A-1;
 477 end;
 478
 479 procedure DecMin(var A: Single; Min: Single);
 480 begin
 481   if A-1 < Min then A := Min else A := A-1;
 482 end;
 483
 484 procedure DecMin(var A: Word; Min: Word);
 485 begin
 486   if A-1 < Min then A := Min else A := A-1;
 487 end;
 488
 489 procedure DecMin(var A: Byte; B, Min: Byte);
 490 begin
 491   if A-B < Min then A := Min else A := A-B;
 492 end;
 493
 494 procedure DecMin(var A: Byte; Min: Byte); overload;
 495 begin
 496   if A-1 < Min then A := Min else A := A-1;
 497 end;
 498
 499 function Sign(A: Integer): ShortInt;
 500 begin
 501   if A < 0 then Result := -1
 502     else if A > 0 then Result := 1
 503       else Result := 0;
 504 end;
 505
 506 function Sign(A: Single): ShortInt;
 507 const
 508   Eps = 1.0E-5;
 509 begin
 510   if Abs(A) < Eps then Result := 0
 511     else if A < 0 then Result := -1
 512       else Result := 1;
 513 end;
 514
 515 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
 516 begin
 517   X := X-X1;            // A(0;0) --- B(W;0)
 518   Y := Y-Y1;            // |          |
 519                         // D(0;H) --- C(W;H)
 520   if X < 0 then
 521     begin // Ñëåâà
 522       if Y < 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
 523         Result := Round(Hypot(X, Y))
 524       else
 525         if Y > Height then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
 526           Result := Round(Hypot(X, Y-Height))
 527         else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
 528           Result := -X;
 529     end
 530   else
 531     if X > Width then
 532       begin // Ñïðàâà
 533         X := X-Width;
 534         if y < 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
 535           Result := Round(Hypot(X, Y))
 536         else
 537           if Y > Height then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
 538             Result := Round(Hypot(X, Y-Height))
 539           else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
 540             Result := X;
 541       end
 542     else // Ïîñåðåäèíå
 543       begin
 544         if Y < 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
 545           Result := -Y
 546         else
 547           if Y > Height then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
 548             Result := Y-Height
 549           else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
 550             Result := 0;
 551       end;
 552 end;
 553
 554 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
 555 const
 556   tab: array[0..3] of Byte = (0, 5, 10, 20);
 557 var
 558   a: Byte;
 559 begin
 560   a := 0;
 561
 562   if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID1, False) then a := a or 1;
 563   if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID2, False) then a := a or 2;
 564
 565   Result := tab[a];
 566 end;
 567
 568 function g_Look(a, b: PObj; d: TDirection): Boolean;
 569 begin
 570   if not gmon_dbg_los_enabled then begin result := false; exit; end; // always "wall hit"
 571
 572   if ((b^.X > a^.X) and (d = TDirection.D_LEFT)) or
 573      ((b^.X < a^.X) and (d = TDirection.D_RIGHT)) then
 574   begin
 575     Result := False;
 576     Exit;
 577   end;
 578
 579   Result := g_TraceVector(a^.X+a^.Rect.X+(a^.Rect.Width div 2),
 580                           a^.Y+a^.Rect.Y+(a^.Rect.Height div 2),
 581                           b^.X+b^.Rect.X+(b^.Rect.Width div 2),
 582                           b^.Y+b^.Rect.Y+(b^.Rect.Height div 2));
 583 end;
 584
 585 function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
 586 var
 587   c: Single;
 588   a, b: Integer;
 589 begin
 590   a := abs(pointX-baseX);
 591   b := abs(pointY-baseY);
 592
 593   if a = 0 then c := 90
 594     else c := RadToDeg(ArcTan(b/a));
 595
 596   if pointY < baseY then c := -c;
 597   if pointX > baseX then c := 180-c;
 598
 599   Result := Round(c);
 600 end;
 601
 602 function GetAngle2(vx, vy: Integer): SmallInt;
 603 var
 604   c: Single;
 605   a, b: Integer;
 606 begin
 607   a := abs(vx);
 608   b := abs(vy);
 609
 610   if a = 0 then
 611     c := 90
 612   else
 613     c := RadToDeg(ArcTan(b/a));
 614
 615   if vy < 0 then
 616     c := -c;
 617   if vx > 0 then
 618     c := 180 - c;
 619
 620   c := c + 180;
 621
 622   Result := Round(c);
 623 end;
 624
 625 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
 626 const
 627   table: array[0..8, 0..8] of Byte =
 628          ((0, 0, 3, 3, 1, 2, 2, 0, 1),
 629           (0, 0, 0, 0, 4, 7, 2, 0, 1),
 630           (3, 0, 0, 0, 4, 4, 1, 3, 1),
 631           (3, 0, 0, 0, 0, 0, 5, 6, 1),
 632           (1, 4, 4, 0, 0, 0, 5, 5, 1),
 633           (2, 7, 4, 0, 0, 0, 0, 0, 1),
 634           (2, 2, 1, 5, 5, 0, 0, 0, 1),
 635           (0, 0, 3, 6, 5, 0, 0, 0, 1),
 636           (1, 1, 1, 1, 1, 1, 1, 1, 1));
 637
 638 function GetClass(x, y: Integer): Byte;
 639 begin
 640  if y < rY then
 641  begin
 642   if x < rX then Result := 7
 643    else if x < rX+rWidth then Result := 0
 644     else Result := 1;
 645  end
 646   else if y < rY+rHeight then
 647  begin
 648   if x < rX then Result := 6
 649    else if x < rX+rWidth then Result := 8
 650     else Result := 2;
 651  end
 652   else
 653  begin
 654   if x < rX then Result := 5
 655    else if x < rX+rWidth then Result := 4
 656     else Result := 3;
 657  end;
 658 end;
 659
 660 begin
 661  case table[GetClass(x1, y1), GetClass(x2, y2)] of
 662   0: Result := False;
 663   1: Result := True;
 664   2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
 665   3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
 666   4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
 667   5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
 668   6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
 669                (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
 670   7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
 671                (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
 672   else Result := False;
 673  end;
 674 end;}
 675
 676 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
 677 {
 678 var
 679   i: Integer;
 680   dx, dy: Integer;
 681   Xerr, Yerr: Integer;
 682   incX, incY: Integer;
 683   x, y, d: Integer;
 684 }
 685 begin
 686   result := lineAABBIntersects(x1, y1, x2, y2, rX, rY, rWidth, rHeight);
 687 {
 688   Result := True;
 689
 690   Xerr := 0;
 691   Yerr := 0;
 692   dx := X2-X1;
 693   dy := Y2-Y1;
 694
 695   if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
 696   if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
 697
 698   dx := abs(dx);
 699   dy := abs(dy);
 700
 701   if dx > dy then d := dx else d := dy;
 702
 703   x := X1;
 704   y := Y1;
 705
 706   for i := 1 to d+1 do
 707   begin
 708     Inc(Xerr, dx);
 709     Inc(Yerr, dy);
 710     if Xerr > d then
 711     begin
 712       Dec(Xerr, d);
 713       Inc(x, incX);
 714     end;
 715     if Yerr > d then
 716     begin
 717       Dec(Yerr, d);
 718       Inc(y, incY);
 719     end;
 720
 721     if (x >= rX) and (x <= (rX + rWidth - 1)) and
 722        (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
 723   end;
 724
 725   Result := False;
 726 }
 727 end;
 728
 729 function GetStr(var Str: string): string;
 730 var
 731   a: Integer;
 732 begin
 733   Result := '';
 734   for a := 1 to Length(Str) do
 735     if (a = Length(Str)) or (Str[a+1] = ' ') then
 736     begin
 737       Result := Copy(Str, 1, a);
 738       Delete(Str, 1, a+1);
 739       Str := Trim(Str);
 740       Exit;
 741     end;
 742 end;
 743
 744 function Sscanf(const s: String; const fmt: String;
 745                 const Pointers: array of Pointer): Integer;
 746 var
 747   i, j, n, m: Integer;
 748   s1: ShortString;
 749   L: LongInt;
 750   X: Extended;
 751
 752   function GetInt(): Integer;
 753   begin
 754     s1 := '';
 755     while (n <= Length(s)) and (s[n] = ' ') do
 756       Inc(n);
 757
 758     while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do
 759     begin
 760       s1 := s1 + s[n];
 761       Inc(n);
 762     end;
 763
 764     Result := Length(s1);
 765   end;
 766
 767   function GetFloat(): Integer;
 768   begin
 769     s1 := '';
 770     while (n <= Length(s)) and (s[n] = ' ') do
 771       Inc(n);
 772
 773     while (n <= Length(s)) and //jd >= rather than >
 774           (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
 775     begin
 776       s1 := s1 + s[n];
 777       Inc(n);
 778     end;
 779
 780     Result := Length(s1);
 781   end;
 782
 783   function GetString(): Integer;
 784   begin
 785     s1 := '';
 786     while (n <= Length(s)) and (s[n] = ' ') do
 787       Inc(n);
 788
 789     while (n <= Length(s)) and (s[n] <> ' ') do
 790     begin
 791       s1 := s1 + s[n];
 792       Inc(n);
 793     end;
 794
 795     Result := Length(s1);
 796   end;
 797
 798   function ScanStr(c: Char): Boolean;
 799   begin
 800     while (n <= Length(s)) and (s[n] <> c) do
 801       Inc(n);
 802     Inc(n);
 803
 804     Result := (n <= Length(s));
 805   end;
 806
 807   function GetFmt(): Integer;
 808   begin
 809     Result := -1;
 810
 811     while (True) do
 812     begin
 813       while (fmt[m] = ' ') and (m < Length(fmt)) do
 814         Inc(m);
 815       if (m >= Length(fmt)) then
 816         Break;
 817
 818       if (fmt[m] = '%') then
 819       begin
 820         Inc(m);
 821         case fmt[m] of
 822           'd': Result := vtInteger;
 823           'f': Result := vtExtended;
 824           's': Result := vtString;
 825         end;
 826         Inc(m);
 827         Break;
 828       end;
 829
 830       if (not ScanStr(fmt[m])) then
 831         Break;
 832       Inc(m);
 833     end;
 834   end;
 835
 836 begin
 837   n := 1;
 838   m := 1;
 839   Result := 0;
 840   s1 := '';
 841
 842   for i := 0 to High(Pointers) do
 843   begin
 844     j := GetFmt();
 845
 846     case j of
 847       vtInteger :
 848       begin
 849         if GetInt() > 0 then
 850           begin
 851             L := StrToIntDef(s1, 0);
 852             Move(L, Pointers[i]^, SizeOf(LongInt));
 853             Inc(Result);
 854           end
 855         else
 856           Break;
 857       end;
 858
 859       vtExtended :
 860       begin
 861         if GetFloat() > 0 then
 862           begin
 863             X := StrToFloatDef(s1, 0.0);
 864             Move(X, Pointers[i]^, SizeOf(Extended));
 865             Inc(Result);
 866           end
 867         else
 868           Break;
 869       end;
 870
 871       vtString :
 872       begin
 873         if GetString() > 0 then
 874           begin
 875             Move(s1, Pointers[i]^, Length(s1)+1);
 876             Inc(Result);
 877           end
 878         else
 879           Break;
 880       end;
 881
 882       else {case}
 883         Break;
 884     end; {case}
 885   end;
 886 end;
 887
 888 function InDWArray(a: DWORD; arr: DWArray): Boolean;
 889 var
 890   b: Integer;
 891 begin
 892   Result := False;
 893
 894   if arr = nil then Exit;
 895
 896   for b := 0 to High(arr) do
 897     if arr[b] = a then
 898     begin
 899       Result := True;
 900       Exit;
 901     end;
 902 end;
 903
 904 function InWArray(a: Word; arr: WArray): Boolean;
 905 var
 906   b: Integer;
 907 begin
 908   Result := False;
 909
 910   if arr = nil then Exit;
 911
 912   for b := 0 to High(arr) do
 913     if arr[b] = a then
 914     begin
 915       Result := True;
 916       Exit;
 917     end;
 918 end;
 919
 920 function InSArray(a: string; arr: SSArray): Boolean;
 921 var
 922   b: Integer;
 923 begin
 924   Result := False;
 925
 926   if arr = nil then Exit;
 927
 928   a := AnsiLowerCase(a);
 929
 930   for b := 0 to High(arr) do
 931     if AnsiLowerCase(arr[b]) = a then
 932     begin
 933       Result := True;
 934       Exit;
 935     end;
 936 end;
 937
 938 function GetPos(UID: Word; o: PObj): Boolean;
 939 var
 940   p: TPlayer;
 941   m: TMonster;
 942 begin
 943   Result := False;
 944
 945   case g_GetUIDType(UID) of
 946     UID_PLAYER:
 947     begin
 948       p := g_Player_Get(UID);
 949       if p = nil then Exit;
 950       if not p.alive then Exit;
 951
 952       o^ := p.Obj;
 953     end;
 954
 955     UID_MONSTER:
 956     begin
 957       m := g_Monsters_ByUID(UID);
 958       if m = nil then Exit;
 959       if not m.alive then Exit;
 960
 961       o^ := m.Obj;
 962     end;
 963     else Exit;
 964   end;
 965
 966   Result := True;
 967 end;
 968
 969 function parse(s: String): SSArray;
 970 var
 971   a: Integer;
 972 begin
 973   Result := nil;
 974   if s = '' then
 975     Exit;
 976
 977   while s <> '' do
 978   begin
 979     for a := 1 to Length(s) do
 980       if (s[a] = ',') or (a = Length(s)) then
 981       begin
 982         SetLength(Result, Length(Result)+1);
 983
 984         if s[a] = ',' then
 985           Result[High(Result)] := Copy(s, 1, a-1)
 986         else // Êîíåö ñòðîêè
 987           Result[High(Result)] := s;
 988
 989         Delete(s, 1, a);
 990         Break;
 991       end;
 992   end;
 993 end;
 994
 995 function parse2(s: string; delim: Char): SSArray;
 996 var
 997   a: Integer;
 998 begin
 999   Result := nil;
1000   if s = '' then Exit;
1001
1002   while s <> '' do
1003   begin
1004     for a := 1 to Length(s) do
1005       if (s[a] = delim) or (a = Length(s)) then
1006       begin
1007         SetLength(Result, Length(Result)+1);
1008
1009         if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1)
1010         else Result[High(Result)] := s;
1011
1012         Delete(s, 1, a);
1013         Break;
1014       end;
1015   end;
1016 end;
1017
1018 function g_GetFileTime(fileName: String): Integer;
1019 var
1020   F: File;
1021 begin
1022   if not FileExists(fileName) then
1023   begin
1024     Result := -1;
1025     Exit;
1026   end;
1027
1028   AssignFile(F, fileName);
1029   Reset(F);
1030   Result := FileGetDate(TFileRec(F).Handle);
1031   CloseFile(F);
1032 end;
1033
1034 function g_SetFileTime(fileName: String; time: Integer): Boolean;
1035 var
1036   F: File;
1037 begin
1038   if (not FileExists(fileName)) or (time < 0) then
1039   begin
1040     Result := False;
1041     Exit;
1042   end;
1043
1044   AssignFile(F, fileName);
1045   Reset(F);
1046   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
1047   CloseFile(F);
1048 end;
1049
1050 procedure SortSArray(var S: SSArray);
1051 var
1052   b: Boolean;
1053   i: Integer;
1054   sw: ShortString;
1055 begin
1056   repeat
1057     b := False;
1058     for i := Low(S) to High(S) - 1 do
1059       if S[i] > S[i + 1] then begin
1060         sw := S[i];
1061         S[i] := S[i + 1];
1062         S[i + 1] := sw;
1063         b := True;
1064       end;
1065   until not b;
1066 end;
1067
1068 function b_Text_Format(S: string): string;
1069 var
1070   Spec, Rst: Boolean;
1071   I: Integer;
1072 begin
1073   Result := '';
1074   Spec := False;
1075   Rst := False;
1076   for I := 1 to Length(S) do
1077   begin
1078     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1079     begin
1080       Spec := True;
1081       Rst := True;
1082       continue;
1083     end;
1084     if Spec then
1085     begin
1086       case S[I] of
1087         'n': // line feed
1088           Result := Result + #10;
1089         '0': // black
1090           Result := Result + #1;
1091         '1': // white
1092           Result := Result + #2;
1093         'd': // darker
1094           Result := Result + #3;
1095         'l': // lighter
1096           Result := Result + #4;
1097         'r': // red
1098           Result := Result + #18;
1099         'g': // green
1100           Result := Result + #19;
1101         'b': // blue
1102           Result := Result + #20;
1103         'y': // yellow
1104           Result := Result + #21;
1105         '\': // escape
1106           Result := Result + '\';
1107         else
1108           Result := Result + '\' + S[I];
1109       end;
1110       Spec := False;
1111     end else
1112       Result := Result + S[I];
1113   end;
1114   // reset to white at end
1115   if Rst then Result := Result + #2;
1116 end;
1117
1118 function b_Text_Unformat(S: string): string;
1119 var
1120   Spec: Boolean;
1121   I: Integer;
1122 begin
1123   Result := '';
1124   Spec := False;
1125   for I := 1 to Length(S) do
1126   begin
1127     if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1128     begin
1129       Spec := False;
1130       continue;
1131     end;
1132     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1133     begin
1134       Spec := True;
1135       continue;
1136     end;
1137     if Spec then
1138     begin
1139       case S[I] of
1140         'n': ;
1141         '0': ;
1142         '1': ;
1143         'd': ;
1144         'l': ;
1145         'r': ;
1146         'g': ;
1147         'b': ;
1148         'y': ;
1149         '\': Result := Result + '\';
1150         else
1151           Result := Result + '\' + S[I];
1152       end;
1153       Spec := False;
1154     end else
1155       Result := Result + S[I];
1156   end;
1157 end;
1158
1159 function b_Text_Wrap(S: string; LineLen: Integer): string;
1160 begin
1161   Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen);
1162 end;
1163
1164 function b_Text_LineCount(S: string): Integer;
1165 var
1166   I: Integer;
1167 begin
1168   Result := IfThen(S = '', 0, 1);
1169   for I := 1 to High(S) do
1170     if S[I] = #10 then
1171       Inc(Result);
1172 end;
1173
1174 end.