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