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