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