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   if (g_Map_traceToNearestWall(x1, y1, x2, y2, @wallHitX, @wallHitY) >= 0) then
 205   begin
 206     // check distance
 207     //result := ((wallHitX-x1)*(wallHitX-x1)+(wallHitY-y1)*(wallHitY-y1) > (x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
 208     result := false;
 209   end
 210   else
 211   begin
 212     result := true; // no obstacles
 213   end;
 214 end;
 215
 216
 217 function g_CreateUID(UIDType: Byte): Word;
 218 var
 219   ok: Boolean;
 220   i: Integer;
 221 begin
 222   Result := $0;
 223
 224   case UIDType of
 225     UID_PLAYER:
 226     begin
 227       repeat
 228         Result := UID_MAX_GAME+$1+Random(UID_MAX_PLAYER-UID_MAX_GAME+$1);
 229
 230         ok := True;
 231         if gPlayers <> nil then
 232           for i := 0 to High(gPlayers) do
 233             if gPlayers[i] <> nil then
 234               if Result = gPlayers[i].UID then
 235               begin
 236                 ok := False;
 237                 Break;
 238               end;
 239       until ok;
 240     end;
 241
 242     UID_MONSTER:
 243     begin
 244       //FIXME!!!
 245       while true do
 246       begin
 247         result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1);
 248         if (g_Monsters_ByUID(result) = nil) then break;
 249       end;
 250     end;
 251   end;
 252 end;
 253
 254 function g_GetUIDType(UID: Word): Byte;
 255 begin
 256   if UID <= UID_MAX_GAME then
 257     Result := UID_GAME
 258   else
 259     if UID <= UID_MAX_PLAYER then
 260       Result := UID_PLAYER
 261     else
 262       Result := UID_MONSTER;
 263 end;
 264
 265 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
 266                    X2, Y2: Integer; Width2, Height2: Word): Boolean;
 267 begin
 268   Result := not ( ((Y1 + Height1 <= Y2) or
 269                    (Y2 + Height2 <= Y1)) or
 270                   ((X1 + Width1  <= X2) or
 271                    (X2 + Width2  <= X1)) );
 272 end;
 273
 274 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
 275                          X2, Y2: Integer; Width2, Height2: Word): Boolean;
 276 begin
 277   Result := g_Collide(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 278             g_Collide(X1+1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 279             g_Collide(X1-1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
 280             g_Collide(X1, Y1+1, Width1, Height1, X2, Y2, Width2, Height2) or
 281             g_Collide(X1, Y1-1, Width1, Height1, X2, Y2, Width2, Height2);
 282 end;
 283
 284 function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean;
 285 begin
 286   Result := not (((Y1 + Height1 <= Y2) or
 287                   (Y1           >= Y2 + Height2)) or
 288                   ((X1 + Width1 <= X2) or
 289                    (X1          >= X2 + Width2)));
 290 end;
 291
 292 function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean;
 293 begin
 294   //Result :=  not (((Y2 <= Y3) or (Y1  >= Y4)) or ((X2 <= X3) or (X1  >= X4)));
 295   Result := c(X1, Y1, X2-X1, Y2-Y1, X3, Y3, X4-X3, Y4-Y3);
 296 end;
 297
 298 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
 299 begin
 300   X := X-X2;
 301   Y := Y-Y2;
 302   Result := (x >= 0) and (x <= Width) and
 303             (y >= 0) and (y <= Height);
 304 end;
 305
 306 procedure IncMax(var A: Integer; B, Max: Integer);
 307 begin
 308   if A+B > Max then A := Max else A := A+B;
 309 end;
 310
 311 procedure IncMax(var A: Single; B, Max: Single);
 312 begin
 313   if A+B > Max then A := Max else A := A+B;
 314 end;
 315
 316 procedure DecMin(var A: Integer; B, Min: Integer);
 317 begin
 318   if A-B < Min then A := Min else A := A-B;
 319 end;
 320
 321 procedure DecMin(var A: Word; B, Min: Word);
 322 begin
 323   if A-B < Min then A := Min else A := A-B;
 324 end;
 325
 326 procedure DecMin(var A: Single; B, Min: Single);
 327 begin
 328   if A-B < Min then A := Min else A := A-B;
 329 end;
 330
 331 procedure IncMax(var A: Integer; Max: Integer);
 332 begin
 333   if A+1 > Max then A := Max else A := A+1;
 334 end;
 335
 336 procedure IncMax(var A: Single; Max: Single);
 337 begin
 338   if A+1 > Max then A := Max else A := A+1;
 339 end;
 340
 341 procedure IncMax(var A: Word; B, Max: Word);
 342 begin
 343   if A+B > Max then A := Max else A := A+B;
 344 end;
 345
 346 procedure IncMax(var A: Word; Max: Word);
 347 begin
 348   if A+1 > Max then A := Max else A := A+1;
 349 end;
 350
 351 procedure IncMax(var A: SmallInt; B, Max: SmallInt);
 352 begin
 353   if A+B > Max then A := Max else A := A+B;
 354 end;
 355
 356 procedure IncMax(var A: SmallInt; Max: SmallInt);
 357 begin
 358   if A+1 > Max then A := Max else A := A+1;
 359 end;
 360
 361 procedure DecMin(var A: Integer; Min: Integer);
 362 begin
 363   if A-1 < Min then A := Min else A := A-1;
 364 end;
 365
 366 procedure DecMin(var A: Single; Min: Single);
 367 begin
 368   if A-1 < Min then A := Min else A := A-1;
 369 end;
 370
 371 procedure DecMin(var A: Word; Min: Word);
 372 begin
 373   if A-1 < Min then A := Min else A := A-1;
 374 end;
 375
 376 procedure DecMin(var A: Byte; B, Min: Byte);
 377 begin
 378   if A-B < Min then A := Min else A := A-B;
 379 end;
 380
 381 procedure DecMin(var A: Byte; Min: Byte); overload;
 382 begin
 383   if A-1 < Min then A := Min else A := A-1;
 384 end;
 385
 386 function Sign(A: Integer): ShortInt;
 387 begin
 388   if A < 0 then Result := -1
 389     else if A > 0 then Result := 1
 390       else Result := 0;
 391 end;
 392
 393 function Sign(A: Single): ShortInt;
 394 const
 395   Eps = 1.0E-5;
 396 begin
 397   if Abs(A) < Eps then Result := 0
 398     else if A < 0 then Result := -1
 399       else Result := 1;
 400 end;
 401
 402 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
 403 begin
 404   X := X-X1;            // A(0;0) --- B(W;0)
 405   Y := Y-Y1;            // |          |
 406                         // D(0;H) --- C(W;H)
 407   if X < 0 then
 408     begin // Ñëåâà
 409       if Y < 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
 410         Result := Round(Hypot(X, Y))
 411       else
 412         if Y > Height then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
 413           Result := Round(Hypot(X, Y-Height))
 414         else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
 415           Result := -X;
 416     end
 417   else
 418     if X > Width then
 419       begin // Ñïðàâà
 420         X := X-Width;
 421         if y < 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
 422           Result := Round(Hypot(X, Y))
 423         else
 424           if Y > Height then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
 425             Result := Round(Hypot(X, Y-Height))
 426           else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
 427             Result := X;
 428       end
 429     else // Ïîñåðåäèíå
 430       begin
 431         if Y < 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
 432           Result := -Y
 433         else
 434           if Y > Height then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
 435             Result := Y-Height
 436           else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
 437             Result := 0;
 438       end;
 439 end;
 440
 441 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
 442 const
 443   tab: array[0..3] of Byte = (0, 5, 10, 20);
 444 var
 445   a: Byte;
 446 begin
 447   a := 0;
 448
 449   if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID1, False) then a := a or 1;
 450   if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID2, False) then a := a or 2;
 451
 452   Result := tab[a];
 453 end;
 454
 455 function g_Look(a, b: PObj; d: TDirection): Boolean;
 456 begin
 457   if ((b^.X > a^.X) and (d = D_LEFT)) or
 458      ((b^.X < a^.X) and (d = 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.Live 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.Live 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.