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, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit g_basic;
  17
  18 interface
  19
  20 uses
  21   utils, g_phys;
  22
  23 const
  24   GAME_VERSION  = '0.667';
  25   GAME_BUILDDATE = {$I %DATE%};
  26   GAME_BUILDTIME = {$I %TIME%};
  27   UID_GAME    = 1;
  28   UID_PLAYER  = 2;
  29   UID_MONSTER = 3;
  30   UID_ITEM    = 10;
  31   UID_MAX_GAME    = $10;
  32   UID_MAX_PLAYER  = $7FFF;
  33   UID_MAX_MONSTER = $FFFF;
  34
  35 type
  36   TDirection = (D_LEFT, D_RIGHT);
  37   WArray = array of Word;
  38   DWArray = array of DWORD;
  39   String20 = String[20];
  40
  41 function g_CreateUID(UIDType: Byte): Word;
  42 function g_GetUIDType(UID: Word): Byte;
  43 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
  44                    X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
  45 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
  46 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
  47 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
  48 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
  49                          X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
  50 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
  51 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
  52 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean; // `true`: no wall hit
  53 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
  54 function g_Look(a, b: PObj; d: TDirection): Boolean;
  55 procedure IncMax(var A: Integer; B, Max: Integer); overload;
  56 procedure IncMax(var A: Single; B, Max: Single); overload;
  57 procedure IncMax(var A: Integer; Max: Integer); overload;
  58 procedure IncMax(var A: Single; Max: Single); overload;
  59 procedure IncMax(var A: Word; B, Max: Word); overload;
  60 procedure IncMax(var A: Word; Max: Word); overload;
  61 procedure IncMax(var A: SmallInt; B, Max: SmallInt); overload;
  62 procedure IncMax(var A: SmallInt; Max: SmallInt); overload;
  63 procedure DecMin(var A: Integer; B, Min: Integer); overload;
  64 procedure DecMin(var A: Single; B, Min: Single); overload;
  65 procedure DecMin(var A: Integer; Min: Integer); overload;
  66 procedure DecMin(var A: Single; Min: Single); overload;
  67 procedure DecMin(var A: Word; B, Min: Word); overload;
  68 procedure DecMin(var A: Word; Min: Word); overload;
  69 procedure DecMin(var A: Byte; B, Min: Byte); overload;
  70 procedure DecMin(var A: Byte; Min: Byte); overload;
  71 function Sign(A: Integer): ShortInt; overload;
  72 function Sign(A: Single): ShortInt; overload;
  73 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
  74 function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
  75 function GetAngle2(vx, vy: Integer): SmallInt;
  76 function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SSArray;
  77 procedure Sort(var a: SSArray);
  78 function Sscanf(const s: string; const fmt: string;
  79                 const Pointers: array of Pointer): Integer;
  80 function InDWArray(a: DWORD; arr: DWArray): Boolean;
  81 function InWArray(a: Word; arr: WArray): Boolean;
  82 function InSArray(a: string; arr: SSArray): Boolean;
  83 function GetPos(UID: Word; o: PObj): Boolean;
  84 function parse(s: string): SSArray;
  85 function parse2(s: string; delim: Char): SSArray;
  86 function g_GetFileTime(fileName: String): Integer;
  87 function g_SetFileTime(fileName: String; time: Integer): Boolean;
  88 procedure SortSArray(var S: SSArray);
  89 function b_Text_Format(S: string): string;
  90 function b_Text_Unformat(S: string): string;
  91 function b_Text_Wrap(S: string; LineLen: Integer): string;
  92 function b_Text_LineCount(S: string): Integer;
  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; FontID: DWORD; MaxWidth: Word): SSArray;
 632   var i, j, len, lines: Integer; w, cw, ch: Word; skip: Boolean;
 633 begin
 634   result := nil; lines := 0; w := 0;
 635   j := 1; i := 1; len := Length(Text);
 636   while i <= len do
 637   begin
 638     e_CharFont_GetSize(FontID, '' + Text[i], cw, ch);
 639     if (i >= len) or (w + cw >= MaxWidth) then
 640     begin
 641       skip := (i < len) and (Text[i] <> ' ');
 642       if skip then
 643       begin
 644         // alt: while (i >= j) and (Text[i] <> ' ') do Dec(i);
 645         while (i <= len) and (Text[i] <> ' ') do Inc(i);
 646       end;
 647       while (i >= j) and (Text[i] = ' ') do Dec(i);
 648       (* --- *)
 649       SetLength(result, lines + 1);
 650       result[lines] := Copy(Text, j, i - j + 1);
 651       Inc(lines);
 652       (* --- *)
 653       if skip then
 654       begin
 655         while (i <= len) and (Text[i] = ' ') do Inc(i);
 656         Inc(i);
 657       end;
 658       j := i + 1;
 659       w := 0
 660     end;
 661     Inc(w, cw);
 662     Inc(i)
 663   end;
 664 end;
 665
 666 procedure Sort(var a: SSArray);
 667 var
 668   i, j: Integer;
 669   s: string;
 670 begin
 671   if a = nil then Exit;
 672
 673   for i := High(a) downto Low(a) do
 674     for j := Low(a) to High(a)-1 do
 675       if LowerCase(a[j]) > LowerCase(a[j+1]) then
 676       begin
 677         s := a[j];
 678         a[j] := a[j+1];
 679         a[j+1] := s;
 680       end;
 681 end;
 682
 683 function Sscanf(const s: String; const fmt: String;
 684                 const Pointers: array of Pointer): Integer;
 685 var
 686   i, j, n, m: Integer;
 687   s1: ShortString;
 688   L: LongInt;
 689   X: Extended;
 690
 691   function GetInt(): Integer;
 692   begin
 693     s1 := '';
 694     while (n <= Length(s)) and (s[n] = ' ') do
 695       Inc(n);
 696
 697     while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do
 698     begin
 699       s1 := s1 + s[n];
 700       Inc(n);
 701     end;
 702
 703     Result := Length(s1);
 704   end;
 705
 706   function GetFloat(): Integer;
 707   begin
 708     s1 := '';
 709     while (n <= Length(s)) and (s[n] = ' ') do
 710       Inc(n);
 711
 712     while (n <= Length(s)) and //jd >= rather than >
 713           (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
 714     begin
 715       s1 := s1 + s[n];
 716       Inc(n);
 717     end;
 718
 719     Result := Length(s1);
 720   end;
 721
 722   function GetString(): Integer;
 723   begin
 724     s1 := '';
 725     while (n <= Length(s)) and (s[n] = ' ') do
 726       Inc(n);
 727
 728     while (n <= Length(s)) and (s[n] <> ' ') do
 729     begin
 730       s1 := s1 + s[n];
 731       Inc(n);
 732     end;
 733
 734     Result := Length(s1);
 735   end;
 736
 737   function ScanStr(c: Char): Boolean;
 738   begin
 739     while (n <= Length(s)) and (s[n] <> c) do
 740       Inc(n);
 741     Inc(n);
 742
 743     Result := (n <= Length(s));
 744   end;
 745
 746   function GetFmt(): Integer;
 747   begin
 748     Result := -1;
 749
 750     while (True) do
 751     begin
 752       while (fmt[m] = ' ') and (m < Length(fmt)) do
 753         Inc(m);
 754       if (m >= Length(fmt)) then
 755         Break;
 756
 757       if (fmt[m] = '%') then
 758       begin
 759         Inc(m);
 760         case fmt[m] of
 761           'd': Result := vtInteger;
 762           'f': Result := vtExtended;
 763           's': Result := vtString;
 764         end;
 765         Inc(m);
 766         Break;
 767       end;
 768
 769       if (not ScanStr(fmt[m])) then
 770         Break;
 771       Inc(m);
 772     end;
 773   end;
 774
 775 begin
 776   n := 1;
 777   m := 1;
 778   Result := 0;
 779   s1 := '';
 780
 781   for i := 0 to High(Pointers) do
 782   begin
 783     j := GetFmt();
 784
 785     case j of
 786       vtInteger :
 787       begin
 788         if GetInt() > 0 then
 789           begin
 790             L := StrToIntDef(s1, 0);
 791             Move(L, Pointers[i]^, SizeOf(LongInt));
 792             Inc(Result);
 793           end
 794         else
 795           Break;
 796       end;
 797
 798       vtExtended :
 799       begin
 800         if GetFloat() > 0 then
 801           begin
 802             X := StrToFloatDef(s1, 0.0);
 803             Move(X, Pointers[i]^, SizeOf(Extended));
 804             Inc(Result);
 805           end
 806         else
 807           Break;
 808       end;
 809
 810       vtString :
 811       begin
 812         if GetString() > 0 then
 813           begin
 814             Move(s1, Pointers[i]^, Length(s1)+1);
 815             Inc(Result);
 816           end
 817         else
 818           Break;
 819       end;
 820
 821       else {case}
 822         Break;
 823     end; {case}
 824   end;
 825 end;
 826
 827 function InDWArray(a: DWORD; arr: DWArray): Boolean;
 828 var
 829   b: Integer;
 830 begin
 831   Result := False;
 832
 833   if arr = nil then Exit;
 834
 835   for b := 0 to High(arr) do
 836     if arr[b] = a then
 837     begin
 838       Result := True;
 839       Exit;
 840     end;
 841 end;
 842
 843 function InWArray(a: Word; arr: WArray): Boolean;
 844 var
 845   b: Integer;
 846 begin
 847   Result := False;
 848
 849   if arr = nil then Exit;
 850
 851   for b := 0 to High(arr) do
 852     if arr[b] = a then
 853     begin
 854       Result := True;
 855       Exit;
 856     end;
 857 end;
 858
 859 function InSArray(a: string; arr: SSArray): Boolean;
 860 var
 861   b: Integer;
 862 begin
 863   Result := False;
 864
 865   if arr = nil then Exit;
 866
 867   a := AnsiLowerCase(a);
 868
 869   for b := 0 to High(arr) do
 870     if AnsiLowerCase(arr[b]) = a then
 871     begin
 872       Result := True;
 873       Exit;
 874     end;
 875 end;
 876
 877 function GetPos(UID: Word; o: PObj): Boolean;
 878 var
 879   p: TPlayer;
 880   m: TMonster;
 881 begin
 882   Result := False;
 883
 884   case g_GetUIDType(UID) of
 885     UID_PLAYER:
 886     begin
 887       p := g_Player_Get(UID);
 888       if p = nil then Exit;
 889       if not p.alive then Exit;
 890
 891       o^ := p.Obj;
 892     end;
 893
 894     UID_MONSTER:
 895     begin
 896       m := g_Monsters_ByUID(UID);
 897       if m = nil then Exit;
 898       if not m.alive then Exit;
 899
 900       o^ := m.Obj;
 901     end;
 902     else Exit;
 903   end;
 904
 905   Result := True;
 906 end;
 907
 908 function parse(s: String): SSArray;
 909 var
 910   a: Integer;
 911 begin
 912   Result := nil;
 913   if s = '' then
 914     Exit;
 915
 916   while s <> '' do
 917   begin
 918     for a := 1 to Length(s) do
 919       if (s[a] = ',') or (a = Length(s)) then
 920       begin
 921         SetLength(Result, Length(Result)+1);
 922
 923         if s[a] = ',' then
 924           Result[High(Result)] := Copy(s, 1, a-1)
 925         else // Êîíåö ñòðîêè
 926           Result[High(Result)] := s;
 927
 928         Delete(s, 1, a);
 929         Break;
 930       end;
 931   end;
 932 end;
 933
 934 function parse2(s: string; delim: Char): SSArray;
 935 var
 936   a: Integer;
 937 begin
 938   Result := nil;
 939   if s = '' then Exit;
 940
 941   while s <> '' do
 942   begin
 943     for a := 1 to Length(s) do
 944       if (s[a] = delim) or (a = Length(s)) then
 945       begin
 946         SetLength(Result, Length(Result)+1);
 947
 948         if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1)
 949         else Result[High(Result)] := s;
 950
 951         Delete(s, 1, a);
 952         Break;
 953       end;
 954   end;
 955 end;
 956
 957 function g_GetFileTime(fileName: String): Integer;
 958 var
 959   F: File;
 960 begin
 961   if not FileExists(fileName) then
 962   begin
 963     Result := -1;
 964     Exit;
 965   end;
 966
 967   AssignFile(F, fileName);
 968   Reset(F);
 969   Result := FileGetDate(TFileRec(F).Handle);
 970   CloseFile(F);
 971 end;
 972
 973 function g_SetFileTime(fileName: String; time: Integer): Boolean;
 974 var
 975   F: File;
 976 begin
 977   if (not FileExists(fileName)) or (time < 0) then
 978   begin
 979     Result := False;
 980     Exit;
 981   end;
 982
 983   AssignFile(F, fileName);
 984   Reset(F);
 985   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
 986   CloseFile(F);
 987 end;
 988
 989 procedure SortSArray(var S: SSArray);
 990 var
 991   b: Boolean;
 992   i: Integer;
 993   sw: ShortString;
 994 begin
 995   repeat
 996     b := False;
 997     for i := Low(S) to High(S) - 1 do
 998       if S[i] > S[i + 1] then begin
 999         sw := S[i];
1000         S[i] := S[i + 1];
1001         S[i + 1] := sw;
1002         b := True;
1003       end;
1004   until not b;
1005 end;
1006
1007 function b_Text_Format(S: string): string;
1008 var
1009   Spec, Rst: Boolean;
1010   I: Integer;
1011 begin
1012   Result := '';
1013   Spec := False;
1014   Rst := False;
1015   for I := 1 to Length(S) do
1016   begin
1017     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1018     begin
1019       Spec := True;
1020       Rst := True;
1021       continue;
1022     end;
1023     if Spec then
1024     begin
1025       case S[I] of
1026         'n': // line feed
1027           Result := Result + #10;
1028         '0': // black
1029           Result := Result + #1;
1030         '1': // white
1031           Result := Result + #2;
1032         'd': // darker
1033           Result := Result + #3;
1034         'l': // lighter
1035           Result := Result + #4;
1036         'r': // red
1037           Result := Result + #18;
1038         'g': // green
1039           Result := Result + #19;
1040         'b': // blue
1041           Result := Result + #20;
1042         'y': // yellow
1043           Result := Result + #21;
1044         '\': // escape
1045           Result := Result + '\';
1046         else
1047           Result := Result + '\' + S[I];
1048       end;
1049       Spec := False;
1050     end else
1051       Result := Result + S[I];
1052   end;
1053   // reset to white at end
1054   if Rst then Result := Result + #2;
1055 end;
1056
1057 function b_Text_Unformat(S: string): string;
1058 var
1059   Spec: Boolean;
1060   I: Integer;
1061 begin
1062   Result := '';
1063   Spec := False;
1064   for I := 1 to Length(S) do
1065   begin
1066     if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1067     begin
1068       Spec := False;
1069       continue;
1070     end;
1071     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1072     begin
1073       Spec := True;
1074       continue;
1075     end;
1076     if Spec then
1077     begin
1078       case S[I] of
1079         'n': ;
1080         '0': ;
1081         '1': ;
1082         'd': ;
1083         'l': ;
1084         'r': ;
1085         'g': ;
1086         'b': ;
1087         'y': ;
1088         '\': Result := Result + '\';
1089         else
1090           Result := Result + '\' + S[I];
1091       end;
1092       Spec := False;
1093     end else
1094       Result := Result + S[I];
1095   end;
1096 end;
1097
1098 function b_Text_Wrap(S: string; LineLen: Integer): string;
1099 begin
1100   Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen);
1101 end;
1102
1103 function b_Text_LineCount(S: string): Integer;
1104 var
1105   I: Integer;
1106 begin
1107   Result := IfThen(S = '', 0, 1);
1108   for I := 1 to High(S) do
1109     if S[I] = #10 then
1110       Inc(Result);
1111 end;
1112
1113 end.