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