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