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   utils, g_phys;
  23
  24 const
  25   GAME_VERSION  = '0.667';
  26   GAME_BUILDDATE = {$I %DATE%};
  27   GAME_BUILDTIME = {$I %TIME%};
  28   UID_GAME    = 1;
  29   UID_PLAYER  = 2;
  30   UID_MONSTER = 3;
  31   UID_ITEM    = 10;
  32   UID_MAX_GAME    = $10;
  33   UID_MAX_PLAYER  = $7FFF;
  34   UID_MAX_MONSTER = $FFFF;
  35
  36 type
  37   TDirection = (D_LEFT, D_RIGHT);
  38   WArray = array of Word;
  39   DWArray = array of DWORD;
  40   String20 = String[20];
  41
  42 function g_CreateUID(UIDType: Byte): Word;
  43 function g_GetUIDType(UID: Word): Byte;
  44 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
  45                    X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
  46 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
  47 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
  48 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
  49 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
  50                          X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
  51 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
  52 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
  53 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean; // `true`: no wall hit
  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): SSArray;
  78 procedure Sort(var a: SSArray);
  79 function Sscanf(const s: string; const fmt: string;
  80                 const Pointers: array of Pointer): Integer;
  81 function InDWArray(a: DWORD; arr: DWArray): Boolean;
  82 function InWArray(a: Word; arr: WArray): Boolean;
  83 function InSArray(a: string; arr: SSArray): Boolean;
  84 function GetPos(UID: Word; o: PObj): Boolean;
  85 function parse(s: string): SSArray;
  86 function parse2(s: string; delim: Char): SSArray;
  87 function g_GetFileTime(fileName: String): Integer;
  88 function g_SetFileTime(fileName: String; time: Integer): Boolean;
  89 procedure SortSArray(var S: SSArray);
  90 function b_Text_Format(S: string): string;
  91 function b_Text_Unformat(S: string): string;
  92 function b_Text_Wrap(S: string; LineLen: Integer): string;
  93
  94 var
  95   gmon_dbg_los_enabled: Boolean = true;
  96
  97 implementation
  98
  99 uses
 100   Math, geom, e_log, g_map, g_gfx, g_player, SysUtils, MAPDEF,
 101   StrUtils, e_graphics, g_monsters, g_items, g_game;
 102
 103 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
 104 begin
 105   Result := Min(Round(Hypot(Abs(X2-X1), Abs(Y2-Y1))), 65535);
 106 end;
 107
 108 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
 109 begin
 110   result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
 111 end;
 112 (*
 113 var
 114   a: Integer;
 115 begin
 116   Result := False;
 117
 118   if gWalls = nil then
 119     Exit;
 120
 121   for a := 0 to High(gWalls) do
 122     if gWalls[a].Enabled and
 123        not ( ((Y + Height <= gWalls[a].Y) or
 124               (Y          >= gWalls[a].Y + gWalls[a].Height)) or
 125              ((X + Width  <= gWalls[a].X) or
 126               (X          >= gWalls[a].X + gWalls[a].Width)) ) then
 127     begin
 128       Result := True;
 129       Exit;
 130     end;
 131 end;
 132 *)
 133
 134 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
 135 var
 136   a: Integer;
 137 begin
 138   Result := False;
 139
 140   if gPlayers = nil then Exit;
 141
 142   for a := 0 to High(gPlayers) do
 143     if (gPlayers[a] <> nil) and gPlayers[a].alive then
 144       if gPlayers[a].Collide(X, Y, Width, Height) then
 145       begin
 146         Result := True;
 147         Exit;
 148       end;
 149 end;
 150
 151
 152 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean;
 153 var
 154   wallHitX: Integer = 0;
 155   wallHitY: Integer = 0;
 156 (*
 157   i: Integer;
 158   dx, dy: Integer;
 159   Xerr, Yerr, d: LongWord;
 160   incX, incY: Integer;
 161   x, y: Integer;
 162 *)
 163 begin
 164   (*
 165   result := False;
 166
 167   Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
 168
 169   Xerr := 0;
 170   Yerr := 0;
 171   dx := X2-X1;
 172   dy := Y2-Y1;
 173
 174   if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
 175   if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
 176
 177   dx := abs(dx);
 178   dy := abs(dy);
 179
 180   if dx > dy then d := dx else d := dy;
 181
 182   x := X1;
 183   y := Y1;
 184
 185   for i := 1 to d do
 186   begin
 187     Inc(Xerr, dx);
 188     Inc(Yerr, dy);
 189     if Xerr>d then
 190     begin
 191       Dec(Xerr, d);
 192       Inc(x, incX);
 193     end;
 194     if Yerr > d then
 195     begin
 196       Dec(Yerr, d);
 197       Inc(y, incY);
 198     end;
 199
 200     if (y > gMapInfo.Height-1) or
 201     (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
 202       Exit;
 203     if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
 204       Exit;
 205   end;
 206
 207   Result := True;
 208   *)
 209
 210   // `true` if no obstacles
 211   if (g_profile_los) then g_Mons_LOS_Start();
 212   result := (g_Map_traceToNearestWall(x1, y1, x2, y2, @wallHitX, @wallHitY) = nil);
 213   if (g_profile_los) then g_Mons_LOS_End();
 214 end;
 215
 216
 217 function g_CreateUID(UIDType: Byte): Word;
 218 var
 219   ok: Boolean;
 220   i: Integer;
 221 begin
 222   Result := $0;
 223
 224   case UIDType of
 225     UID_PLAYER:
 226     begin
 227       repeat
 228         Result := UID_MAX_GAME+$1+Random(UID_MAX_PLAYER-UID_MAX_GAME+$1);
 229
 230         ok := True;
 231         if gPlayers <> nil then
 232           for i := 0 to High(gPlayers) do
 233             if gPlayers[i] <> nil then
 234               if Result = gPlayers[i].UID then
 235               begin
 236                 ok := False;
 237                 Break;
 238               end;
 239       until ok;
 240     end;
 241
 242     UID_MONSTER:
 243     begin
 244       //FIXME!!!
 245       while true do
 246       begin
 247         result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1);
 248         if (g_Monsters_ByUID(result) = nil) then break;
 249       end;
 250     end;
 251   end;
 252 end;
 253
 254 function g_GetUIDType(UID: Word): Byte;
 255 begin
 256   if UID <= UID_MAX_GAME then
 257     Result := UID_GAME
 258   else
 259     if UID <= UID_MAX_PLAYER then
 260       Result := UID_PLAYER
 261     else
 262       Result := UID_MONSTER;
 263 end;
 264
 265 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
 266                    X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
 267 begin
 268   Result := not ( ((Y1 + Height1 <= Y2) or
 269                    (Y2 + Height2 <= Y1)) or
 270                   ((X1 + Width1  <= X2) or
 271                    (X2 + Width2  <= X1)) );
 272 end;
 273
 274 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
 275                          X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
 276 begin
 277   Result := g_Collide(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 278             g_Collide(X1+1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 279             g_Collide(X1-1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 280             g_Collide(X1, Y1+1, Width1, Height1, X2, Y2, Width2, Height2) or
 281             g_Collide(X1, Y1-1, Width1, Height1, X2, Y2, Width2, Height2);
 282 end;
 283
 284 function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean; inline;
 285 begin
 286   Result := not (((Y1 + Height1 <= Y2) or
 287                   (Y1           >= Y2 + Height2)) or
 288                   ((X1 + Width1 <= X2) or
 289                    (X1          >= X2 + Width2)));
 290 end;
 291
 292 function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean; inline;
 293 begin
 294   //Result :=  not (((Y2 <= Y3) or (Y1  >= Y4)) or ((X2 <= X3) or (X1  >= X4)));
 295   Result := c(X1, Y1, X2-X1, Y2-Y1, X3, Y3, X4-X3, Y4-Y3);
 296 end;
 297
 298 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
 299 begin
 300   X := X-X2;
 301   Y := Y-Y2;
 302   Result := (x >= 0) and (x <= Width) and
 303             (y >= 0) and (y <= Height);
 304 end;
 305
 306 procedure IncMax(var A: Integer; B, Max: Integer);
 307 begin
 308   if A+B > Max then A := Max else A := A+B;
 309 end;
 310
 311 procedure IncMax(var A: Single; B, Max: Single);
 312 begin
 313   if A+B > Max then A := Max else A := A+B;
 314 end;
 315
 316 procedure DecMin(var A: Integer; B, Min: Integer);
 317 begin
 318   if A-B < Min then A := Min else A := A-B;
 319 end;
 320
 321 procedure DecMin(var A: Word; B, Min: Word);
 322 begin
 323   if A-B < Min then A := Min else A := A-B;
 324 end;
 325
 326 procedure DecMin(var A: Single; B, Min: Single);
 327 begin
 328   if A-B < Min then A := Min else A := A-B;
 329 end;
 330
 331 procedure IncMax(var A: Integer; Max: Integer);
 332 begin
 333   if A+1 > Max then A := Max else A := A+1;
 334 end;
 335
 336 procedure IncMax(var A: Single; Max: Single);
 337 begin
 338   if A+1 > Max then A := Max else A := A+1;
 339 end;
 340
 341 procedure IncMax(var A: Word; B, Max: Word);
 342 begin
 343   if A+B > Max then A := Max else A := A+B;
 344 end;
 345
 346 procedure IncMax(var A: Word; Max: Word);
 347 begin
 348   if A+1 > Max then A := Max else A := A+1;
 349 end;
 350
 351 procedure IncMax(var A: SmallInt; B, Max: SmallInt);
 352 begin
 353   if A+B > Max then A := Max else A := A+B;
 354 end;
 355
 356 procedure IncMax(var A: SmallInt; Max: SmallInt);
 357 begin
 358   if A+1 > Max then A := Max else A := A+1;
 359 end;
 360
 361 procedure DecMin(var A: Integer; Min: Integer);
 362 begin
 363   if A-1 < Min then A := Min else A := A-1;
 364 end;
 365
 366 procedure DecMin(var A: Single; Min: Single);
 367 begin
 368   if A-1 < Min then A := Min else A := A-1;
 369 end;
 370
 371 procedure DecMin(var A: Word; Min: Word);
 372 begin
 373   if A-1 < Min then A := Min else A := A-1;
 374 end;
 375
 376 procedure DecMin(var A: Byte; B, Min: Byte);
 377 begin
 378   if A-B < Min then A := Min else A := A-B;
 379 end;
 380
 381 procedure DecMin(var A: Byte; Min: Byte); overload;
 382 begin
 383   if A-1 < Min then A := Min else A := A-1;
 384 end;
 385
 386 function Sign(A: Integer): ShortInt;
 387 begin
 388   if A < 0 then Result := -1
 389     else if A > 0 then Result := 1
 390       else Result := 0;
 391 end;
 392
 393 function Sign(A: Single): ShortInt;
 394 const
 395   Eps = 1.0E-5;
 396 begin
 397   if Abs(A) < Eps then Result := 0
 398     else if A < 0 then Result := -1
 399       else Result := 1;
 400 end;
 401
 402 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
 403 begin
 404   X := X-X1;            // A(0;0) --- B(W;0)
 405   Y := Y-Y1;            // |          |
 406                         // D(0;H) --- C(W;H)
 407   if X < 0 then
 408     begin // Ñëåâà
 409       if Y < 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
 410         Result := Round(Hypot(X, Y))
 411       else
 412         if Y > Height then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
 413           Result := Round(Hypot(X, Y-Height))
 414         else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
 415           Result := -X;
 416     end
 417   else
 418     if X > Width then
 419       begin // Ñïðàâà
 420         X := X-Width;
 421         if y < 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
 422           Result := Round(Hypot(X, Y))
 423         else
 424           if Y > Height then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
 425             Result := Round(Hypot(X, Y-Height))
 426           else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
 427             Result := X;
 428       end
 429     else // Ïîñåðåäèíå
 430       begin
 431         if Y < 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
 432           Result := -Y
 433         else
 434           if Y > Height then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
 435             Result := Y-Height
 436           else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
 437             Result := 0;
 438       end;
 439 end;
 440
 441 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
 442 const
 443   tab: array[0..3] of Byte = (0, 5, 10, 20);
 444 var
 445   a: Byte;
 446 begin
 447   a := 0;
 448
 449   if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID1, False) then a := a or 1;
 450   if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID2, False) then a := a or 2;
 451
 452   Result := tab[a];
 453 end;
 454
 455 function g_Look(a, b: PObj; d: TDirection): Boolean;
 456 begin
 457   if not gmon_dbg_los_enabled then begin result := false; exit; end; // always "wall hit"
 458
 459   if ((b^.X > a^.X) and (d = TDirection.D_LEFT)) or
 460      ((b^.X < a^.X) and (d = TDirection.D_RIGHT)) then
 461   begin
 462     Result := False;
 463     Exit;
 464   end;
 465
 466   Result := g_TraceVector(a^.X+a^.Rect.X+(a^.Rect.Width div 2),
 467                           a^.Y+a^.Rect.Y+(a^.Rect.Height div 2),
 468                           b^.X+b^.Rect.X+(b^.Rect.Width div 2),
 469                           b^.Y+b^.Rect.Y+(b^.Rect.Height div 2));
 470 end;
 471
 472 function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
 473 var
 474   c: Single;
 475   a, b: Integer;
 476 begin
 477   a := abs(pointX-baseX);
 478   b := abs(pointY-baseY);
 479
 480   if a = 0 then c := 90
 481     else c := RadToDeg(ArcTan(b/a));
 482
 483   if pointY < baseY then c := -c;
 484   if pointX > baseX then c := 180-c;
 485
 486   Result := Round(c);
 487 end;
 488
 489 function GetAngle2(vx, vy: Integer): SmallInt;
 490 var
 491   c: Single;
 492   a, b: Integer;
 493 begin
 494   a := abs(vx);
 495   b := abs(vy);
 496
 497   if a = 0 then
 498     c := 90
 499   else
 500     c := RadToDeg(ArcTan(b/a));
 501
 502   if vy < 0 then
 503     c := -c;
 504   if vx > 0 then
 505     c := 180 - c;
 506
 507   c := c + 180;
 508
 509   Result := Round(c);
 510 end;
 511
 512 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
 513 const
 514   table: array[0..8, 0..8] of Byte =
 515          ((0, 0, 3, 3, 1, 2, 2, 0, 1),
 516           (0, 0, 0, 0, 4, 7, 2, 0, 1),
 517           (3, 0, 0, 0, 4, 4, 1, 3, 1),
 518           (3, 0, 0, 0, 0, 0, 5, 6, 1),
 519           (1, 4, 4, 0, 0, 0, 5, 5, 1),
 520           (2, 7, 4, 0, 0, 0, 0, 0, 1),
 521           (2, 2, 1, 5, 5, 0, 0, 0, 1),
 522           (0, 0, 3, 6, 5, 0, 0, 0, 1),
 523           (1, 1, 1, 1, 1, 1, 1, 1, 1));
 524
 525 function GetClass(x, y: Integer): Byte;
 526 begin
 527  if y < rY then
 528  begin
 529   if x < rX then Result := 7
 530    else if x < rX+rWidth then Result := 0
 531     else Result := 1;
 532  end
 533   else if y < rY+rHeight then
 534  begin
 535   if x < rX then Result := 6
 536    else if x < rX+rWidth then Result := 8
 537     else Result := 2;
 538  end
 539   else
 540  begin
 541   if x < rX then Result := 5
 542    else if x < rX+rWidth then Result := 4
 543     else Result := 3;
 544  end;
 545 end;
 546
 547 begin
 548  case table[GetClass(x1, y1), GetClass(x2, y2)] of
 549   0: Result := False;
 550   1: Result := True;
 551   2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
 552   3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
 553   4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
 554   5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
 555   6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
 556                (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
 557   7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
 558                (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
 559   else Result := False;
 560  end;
 561 end;}
 562
 563 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
 564 {
 565 var
 566   i: Integer;
 567   dx, dy: Integer;
 568   Xerr, Yerr: Integer;
 569   incX, incY: Integer;
 570   x, y, d: Integer;
 571 }
 572 begin
 573   result := lineAABBIntersects(x1, y1, x2, y2, rX, rY, rWidth, rHeight);
 574 {
 575   Result := True;
 576
 577   Xerr := 0;
 578   Yerr := 0;
 579   dx := X2-X1;
 580   dy := Y2-Y1;
 581
 582   if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
 583   if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
 584
 585   dx := abs(dx);
 586   dy := abs(dy);
 587
 588   if dx > dy then d := dx else d := dy;
 589
 590   x := X1;
 591   y := Y1;
 592
 593   for i := 1 to d+1 do
 594   begin
 595     Inc(Xerr, dx);
 596     Inc(Yerr, dy);
 597     if Xerr > d then
 598     begin
 599       Dec(Xerr, d);
 600       Inc(x, incX);
 601     end;
 602     if Yerr > d then
 603     begin
 604       Dec(Yerr, d);
 605       Inc(y, incY);
 606     end;
 607
 608     if (x >= rX) and (x <= (rX + rWidth - 1)) and
 609        (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
 610   end;
 611
 612   Result := False;
 613 }
 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): SSArray;
 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): SSArray;
 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: SSArray);
 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: SSArray): 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.alive 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.alive 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): SSArray;
 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): SSArray;
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: SSArray);
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 function b_Text_Wrap(S: string; LineLen: Integer): string;
1179 begin
1180   Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen);
1181 end;
1182
1183 end.