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