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