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