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