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