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