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