src/game/g_basic.pas

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