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;
 633
 634   function GetLine (j, i: Integer): String;
 635   begin
 636     result := Copy(text, j, i - j + 1);
 637   end;
 638
 639   function GetWidth (j, i: Integer): Integer;
 640     var w, h: Word;
 641   begin
 642     e_CharFont_GetSize(FontID, GetLine(j, i), w, h);
 643     result := w
 644   end;
 645
 646 begin
 647   result := nil; lines := 0;
 648   j := 1; i := 1; len := Length(Text);
 649   e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
 650   while j <= len do
 651   begin
 652     (* --- Get longest possible sequence --- *)
 653     while (i + 1 <= len) and (GetWidth(j, i + 1) <= MaxWidth) do Inc(i);
 654     (* --- Do not include part of word --- *)
 655     if (i < len) and (text[i] <> ' ') then
 656       while (i >= j) and (text[i] <> ' ') do Dec(i);
 657     (* --- Do not include spaces --- *)
 658     while (i >= j) and (text[i] = ' ') do Dec(i);
 659     (* --- Add line --- *)
 660     SetLength(result, lines + 1);
 661     result[lines] := GetLine(j, i);
 662     e_LogWritefln('  -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
 663     Inc(lines);
 664     (* --- Skip spaces --- *)
 665     while (i <= len) and (text[i] = ' ') do Inc(i);
 666     j := i + 2;
 667   end;
 668 end;
 669
 670 procedure Sort(var a: SSArray);
 671 var
 672   i, j: Integer;
 673   s: string;
 674 begin
 675   if a = nil then Exit;
 676
 677   for i := High(a) downto Low(a) do
 678     for j := Low(a) to High(a)-1 do
 679       if LowerCase(a[j]) > LowerCase(a[j+1]) then
 680       begin
 681         s := a[j];
 682         a[j] := a[j+1];
 683         a[j+1] := s;
 684       end;
 685 end;
 686
 687 function Sscanf(const s: String; const fmt: String;
 688                 const Pointers: array of Pointer): Integer;
 689 var
 690   i, j, n, m: Integer;
 691   s1: ShortString;
 692   L: LongInt;
 693   X: Extended;
 694
 695   function GetInt(): Integer;
 696   begin
 697     s1 := '';
 698     while (n <= Length(s)) and (s[n] = ' ') do
 699       Inc(n);
 700
 701     while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do
 702     begin
 703       s1 := s1 + s[n];
 704       Inc(n);
 705     end;
 706
 707     Result := Length(s1);
 708   end;
 709
 710   function GetFloat(): Integer;
 711   begin
 712     s1 := '';
 713     while (n <= Length(s)) and (s[n] = ' ') do
 714       Inc(n);
 715
 716     while (n <= Length(s)) and //jd >= rather than >
 717           (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
 718     begin
 719       s1 := s1 + s[n];
 720       Inc(n);
 721     end;
 722
 723     Result := Length(s1);
 724   end;
 725
 726   function GetString(): Integer;
 727   begin
 728     s1 := '';
 729     while (n <= Length(s)) and (s[n] = ' ') do
 730       Inc(n);
 731
 732     while (n <= Length(s)) and (s[n] <> ' ') do
 733     begin
 734       s1 := s1 + s[n];
 735       Inc(n);
 736     end;
 737
 738     Result := Length(s1);
 739   end;
 740
 741   function ScanStr(c: Char): Boolean;
 742   begin
 743     while (n <= Length(s)) and (s[n] <> c) do
 744       Inc(n);
 745     Inc(n);
 746
 747     Result := (n <= Length(s));
 748   end;
 749
 750   function GetFmt(): Integer;
 751   begin
 752     Result := -1;
 753
 754     while (True) do
 755     begin
 756       while (fmt[m] = ' ') and (m < Length(fmt)) do
 757         Inc(m);
 758       if (m >= Length(fmt)) then
 759         Break;
 760
 761       if (fmt[m] = '%') then
 762       begin
 763         Inc(m);
 764         case fmt[m] of
 765           'd': Result := vtInteger;
 766           'f': Result := vtExtended;
 767           's': Result := vtString;
 768         end;
 769         Inc(m);
 770         Break;
 771       end;
 772
 773       if (not ScanStr(fmt[m])) then
 774         Break;
 775       Inc(m);
 776     end;
 777   end;
 778
 779 begin
 780   n := 1;
 781   m := 1;
 782   Result := 0;
 783   s1 := '';
 784
 785   for i := 0 to High(Pointers) do
 786   begin
 787     j := GetFmt();
 788
 789     case j of
 790       vtInteger :
 791       begin
 792         if GetInt() > 0 then
 793           begin
 794             L := StrToIntDef(s1, 0);
 795             Move(L, Pointers[i]^, SizeOf(LongInt));
 796             Inc(Result);
 797           end
 798         else
 799           Break;
 800       end;
 801
 802       vtExtended :
 803       begin
 804         if GetFloat() > 0 then
 805           begin
 806             X := StrToFloatDef(s1, 0.0);
 807             Move(X, Pointers[i]^, SizeOf(Extended));
 808             Inc(Result);
 809           end
 810         else
 811           Break;
 812       end;
 813
 814       vtString :
 815       begin
 816         if GetString() > 0 then
 817           begin
 818             Move(s1, Pointers[i]^, Length(s1)+1);
 819             Inc(Result);
 820           end
 821         else
 822           Break;
 823       end;
 824
 825       else {case}
 826         Break;
 827     end; {case}
 828   end;
 829 end;
 830
 831 function InDWArray(a: DWORD; arr: DWArray): Boolean;
 832 var
 833   b: Integer;
 834 begin
 835   Result := False;
 836
 837   if arr = nil then Exit;
 838
 839   for b := 0 to High(arr) do
 840     if arr[b] = a then
 841     begin
 842       Result := True;
 843       Exit;
 844     end;
 845 end;
 846
 847 function InWArray(a: Word; arr: WArray): Boolean;
 848 var
 849   b: Integer;
 850 begin
 851   Result := False;
 852
 853   if arr = nil then Exit;
 854
 855   for b := 0 to High(arr) do
 856     if arr[b] = a then
 857     begin
 858       Result := True;
 859       Exit;
 860     end;
 861 end;
 862
 863 function InSArray(a: string; arr: SSArray): Boolean;
 864 var
 865   b: Integer;
 866 begin
 867   Result := False;
 868
 869   if arr = nil then Exit;
 870
 871   a := AnsiLowerCase(a);
 872
 873   for b := 0 to High(arr) do
 874     if AnsiLowerCase(arr[b]) = a then
 875     begin
 876       Result := True;
 877       Exit;
 878     end;
 879 end;
 880
 881 function GetPos(UID: Word; o: PObj): Boolean;
 882 var
 883   p: TPlayer;
 884   m: TMonster;
 885 begin
 886   Result := False;
 887
 888   case g_GetUIDType(UID) of
 889     UID_PLAYER:
 890     begin
 891       p := g_Player_Get(UID);
 892       if p = nil then Exit;
 893       if not p.alive then Exit;
 894
 895       o^ := p.Obj;
 896     end;
 897
 898     UID_MONSTER:
 899     begin
 900       m := g_Monsters_ByUID(UID);
 901       if m = nil then Exit;
 902       if not m.alive then Exit;
 903
 904       o^ := m.Obj;
 905     end;
 906     else Exit;
 907   end;
 908
 909   Result := True;
 910 end;
 911
 912 function parse(s: String): SSArray;
 913 var
 914   a: Integer;
 915 begin
 916   Result := nil;
 917   if s = '' then
 918     Exit;
 919
 920   while s <> '' do
 921   begin
 922     for a := 1 to Length(s) do
 923       if (s[a] = ',') or (a = Length(s)) then
 924       begin
 925         SetLength(Result, Length(Result)+1);
 926
 927         if s[a] = ',' then
 928           Result[High(Result)] := Copy(s, 1, a-1)
 929         else // Êîíåö ñòðîêè
 930           Result[High(Result)] := s;
 931
 932         Delete(s, 1, a);
 933         Break;
 934       end;
 935   end;
 936 end;
 937
 938 function parse2(s: string; delim: Char): SSArray;
 939 var
 940   a: Integer;
 941 begin
 942   Result := nil;
 943   if s = '' then Exit;
 944
 945   while s <> '' do
 946   begin
 947     for a := 1 to Length(s) do
 948       if (s[a] = delim) or (a = Length(s)) then
 949       begin
 950         SetLength(Result, Length(Result)+1);
 951
 952         if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1)
 953         else Result[High(Result)] := s;
 954
 955         Delete(s, 1, a);
 956         Break;
 957       end;
 958   end;
 959 end;
 960
 961 function g_GetFileTime(fileName: String): Integer;
 962 var
 963   F: File;
 964 begin
 965   if not FileExists(fileName) then
 966   begin
 967     Result := -1;
 968     Exit;
 969   end;
 970
 971   AssignFile(F, fileName);
 972   Reset(F);
 973   Result := FileGetDate(TFileRec(F).Handle);
 974   CloseFile(F);
 975 end;
 976
 977 function g_SetFileTime(fileName: String; time: Integer): Boolean;
 978 var
 979   F: File;
 980 begin
 981   if (not FileExists(fileName)) or (time < 0) then
 982   begin
 983     Result := False;
 984     Exit;
 985   end;
 986
 987   AssignFile(F, fileName);
 988   Reset(F);
 989   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
 990   CloseFile(F);
 991 end;
 992
 993 procedure SortSArray(var S: SSArray);
 994 var
 995   b: Boolean;
 996   i: Integer;
 997   sw: ShortString;
 998 begin
 999   repeat
1000     b := False;
1001     for i := Low(S) to High(S) - 1 do
1002       if S[i] > S[i + 1] then begin
1003         sw := S[i];
1004         S[i] := S[i + 1];
1005         S[i + 1] := sw;
1006         b := True;
1007       end;
1008   until not b;
1009 end;
1010
1011 function b_Text_Format(S: string): string;
1012 var
1013   Spec, Rst: Boolean;
1014   I: Integer;
1015 begin
1016   Result := '';
1017   Spec := False;
1018   Rst := False;
1019   for I := 1 to Length(S) do
1020   begin
1021     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1022     begin
1023       Spec := True;
1024       Rst := True;
1025       continue;
1026     end;
1027     if Spec then
1028     begin
1029       case S[I] of
1030         'n': // line feed
1031           Result := Result + #10;
1032         '0': // black
1033           Result := Result + #1;
1034         '1': // white
1035           Result := Result + #2;
1036         'd': // darker
1037           Result := Result + #3;
1038         'l': // lighter
1039           Result := Result + #4;
1040         'r': // red
1041           Result := Result + #18;
1042         'g': // green
1043           Result := Result + #19;
1044         'b': // blue
1045           Result := Result + #20;
1046         'y': // yellow
1047           Result := Result + #21;
1048         '\': // escape
1049           Result := Result + '\';
1050         else
1051           Result := Result + '\' + S[I];
1052       end;
1053       Spec := False;
1054     end else
1055       Result := Result + S[I];
1056   end;
1057   // reset to white at end
1058   if Rst then Result := Result + #2;
1059 end;
1060
1061 function b_Text_Unformat(S: string): string;
1062 var
1063   Spec: Boolean;
1064   I: Integer;
1065 begin
1066   Result := '';
1067   Spec := False;
1068   for I := 1 to Length(S) do
1069   begin
1070     if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1071     begin
1072       Spec := False;
1073       continue;
1074     end;
1075     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1076     begin
1077       Spec := True;
1078       continue;
1079     end;
1080     if Spec then
1081     begin
1082       case S[I] of
1083         'n': ;
1084         '0': ;
1085         '1': ;
1086         'd': ;
1087         'l': ;
1088         'r': ;
1089         'g': ;
1090         'b': ;
1091         'y': ;
1092         '\': Result := Result + '\';
1093         else
1094           Result := Result + '\' + S[I];
1095       end;
1096       Spec := False;
1097     end else
1098       Result := Result + S[I];
1099   end;
1100 end;
1101
1102 function b_Text_Wrap(S: string; LineLen: Integer): string;
1103 begin
1104   Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen);
1105 end;
1106
1107 function b_Text_LineCount(S: string): Integer;
1108 var
1109   I: Integer;
1110 begin
1111   Result := IfThen(S = '', 0, 1);
1112   for I := 1 to High(S) do
1113     if S[I] = #10 then
1114       Inc(Result);
1115 end;
1116
1117 end.