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