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