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