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 i, j, len, lines: Integer;
 748
 749   function GetLine (j, i: Integer): String;
 750   begin
 751     result := Copy(text, j, i - j + 1);
 752   end;
 753
 754   function GetWidth (j, i: Integer): Integer;
 755     var w, h: Word;
 756   begin
 757     e_CharFont_GetSize(FontID, GetLine(j, i), w, h);
 758     result := w
 759   end;
 760
 761 begin
 762   result := nil; lines := 0;
 763   j := 1; i := 1; len := Length(Text);
 764   // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
 765   while j <= len do
 766   begin
 767     (* --- Get longest possible sequence --- *)
 768     while (i + 1 <= len) and (GetWidth(j, i + 1) <= MaxWidth) do Inc(i);
 769     (* --- Do not include part of word --- *)
 770     if (i < len) and (text[i] <> ' ') then
 771       while (i >= j) and (text[i] <> ' ') do Dec(i);
 772     (* --- Do not include spaces --- *)
 773     while (i >= j) and (text[i] = ' ') do Dec(i);
 774     (* --- Add line --- *)
 775     SetLength(result, lines + 1);
 776     result[lines] := GetLine(j, i);
 777     // e_LogWritefln('  -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
 778     Inc(lines);
 779     (* --- Skip spaces --- *)
 780     while (i <= len) and (text[i] = ' ') do Inc(i);
 781     j := i + 2;
 782   end;
 783 end;
 784
 785 procedure Sort(var a: SSArray);
 786 var
 787   i, j: Integer;
 788   s: string;
 789 begin
 790   if a = nil then Exit;
 791
 792   for i := High(a) downto Low(a) do
 793     for j := Low(a) to High(a)-1 do
 794       if LowerCase(a[j]) > LowerCase(a[j+1]) then
 795       begin
 796         s := a[j];
 797         a[j] := a[j+1];
 798         a[j+1] := s;
 799       end;
 800 end;
 801
 802 function Sscanf(const s: String; const fmt: String;
 803                 const Pointers: array of Pointer): Integer;
 804 var
 805   i, j, n, m: Integer;
 806   s1: ShortString;
 807   L: LongInt;
 808   X: Extended;
 809
 810   function GetInt(): Integer;
 811   begin
 812     s1 := '';
 813     while (n <= Length(s)) and (s[n] = ' ') do
 814       Inc(n);
 815
 816     while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do
 817     begin
 818       s1 := s1 + s[n];
 819       Inc(n);
 820     end;
 821
 822     Result := Length(s1);
 823   end;
 824
 825   function GetFloat(): Integer;
 826   begin
 827     s1 := '';
 828     while (n <= Length(s)) and (s[n] = ' ') do
 829       Inc(n);
 830
 831     while (n <= Length(s)) and //jd >= rather than >
 832           (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
 833     begin
 834       s1 := s1 + s[n];
 835       Inc(n);
 836     end;
 837
 838     Result := Length(s1);
 839   end;
 840
 841   function GetString(): Integer;
 842   begin
 843     s1 := '';
 844     while (n <= Length(s)) and (s[n] = ' ') do
 845       Inc(n);
 846
 847     while (n <= Length(s)) and (s[n] <> ' ') do
 848     begin
 849       s1 := s1 + s[n];
 850       Inc(n);
 851     end;
 852
 853     Result := Length(s1);
 854   end;
 855
 856   function ScanStr(c: Char): Boolean;
 857   begin
 858     while (n <= Length(s)) and (s[n] <> c) do
 859       Inc(n);
 860     Inc(n);
 861
 862     Result := (n <= Length(s));
 863   end;
 864
 865   function GetFmt(): Integer;
 866   begin
 867     Result := -1;
 868
 869     while (True) do
 870     begin
 871       while (fmt[m] = ' ') and (m < Length(fmt)) do
 872         Inc(m);
 873       if (m >= Length(fmt)) then
 874         Break;
 875
 876       if (fmt[m] = '%') then
 877       begin
 878         Inc(m);
 879         case fmt[m] of
 880           'd': Result := vtInteger;
 881           'f': Result := vtExtended;
 882           's': Result := vtString;
 883         end;
 884         Inc(m);
 885         Break;
 886       end;
 887
 888       if (not ScanStr(fmt[m])) then
 889         Break;
 890       Inc(m);
 891     end;
 892   end;
 893
 894 begin
 895   n := 1;
 896   m := 1;
 897   Result := 0;
 898   s1 := '';
 899
 900   for i := 0 to High(Pointers) do
 901   begin
 902     j := GetFmt();
 903
 904     case j of
 905       vtInteger :
 906       begin
 907         if GetInt() > 0 then
 908           begin
 909             L := StrToIntDef(s1, 0);
 910             Move(L, Pointers[i]^, SizeOf(LongInt));
 911             Inc(Result);
 912           end
 913         else
 914           Break;
 915       end;
 916
 917       vtExtended :
 918       begin
 919         if GetFloat() > 0 then
 920           begin
 921             X := StrToFloatDef(s1, 0.0);
 922             Move(X, Pointers[i]^, SizeOf(Extended));
 923             Inc(Result);
 924           end
 925         else
 926           Break;
 927       end;
 928
 929       vtString :
 930       begin
 931         if GetString() > 0 then
 932           begin
 933             Move(s1, Pointers[i]^, Length(s1)+1);
 934             Inc(Result);
 935           end
 936         else
 937           Break;
 938       end;
 939
 940       else {case}
 941         Break;
 942     end; {case}
 943   end;
 944 end;
 945
 946 function InDWArray(a: DWORD; arr: DWArray): Boolean;
 947 var
 948   b: Integer;
 949 begin
 950   Result := False;
 951
 952   if arr = nil then Exit;
 953
 954   for b := 0 to High(arr) do
 955     if arr[b] = a then
 956     begin
 957       Result := True;
 958       Exit;
 959     end;
 960 end;
 961
 962 function InWArray(a: Word; arr: WArray): Boolean;
 963 var
 964   b: Integer;
 965 begin
 966   Result := False;
 967
 968   if arr = nil then Exit;
 969
 970   for b := 0 to High(arr) do
 971     if arr[b] = a then
 972     begin
 973       Result := True;
 974       Exit;
 975     end;
 976 end;
 977
 978 function InSArray(a: string; arr: SSArray): Boolean;
 979 var
 980   b: Integer;
 981 begin
 982   Result := False;
 983
 984   if arr = nil then Exit;
 985
 986   a := AnsiLowerCase(a);
 987
 988   for b := 0 to High(arr) do
 989     if AnsiLowerCase(arr[b]) = a then
 990     begin
 991       Result := True;
 992       Exit;
 993     end;
 994 end;
 995
 996 function GetPos(UID: Word; o: PObj): Boolean;
 997 var
 998   p: TPlayer;
 999   m: TMonster;
1000 begin
1001   Result := False;
1002
1003   case g_GetUIDType(UID) of
1004     UID_PLAYER:
1005     begin
1006       p := g_Player_Get(UID);
1007       if p = nil then Exit;
1008       if not p.alive then Exit;
1009
1010       o^ := p.Obj;
1011     end;
1012
1013     UID_MONSTER:
1014     begin
1015       m := g_Monsters_ByUID(UID);
1016       if m = nil then Exit;
1017       if not m.alive then Exit;
1018
1019       o^ := m.Obj;
1020     end;
1021     else Exit;
1022   end;
1023
1024   Result := True;
1025 end;
1026
1027 function parse(s: String): SSArray;
1028 var
1029   a: Integer;
1030 begin
1031   Result := nil;
1032   if s = '' then
1033     Exit;
1034
1035   while s <> '' do
1036   begin
1037     for a := 1 to Length(s) do
1038       if (s[a] = ',') or (a = Length(s)) then
1039       begin
1040         SetLength(Result, Length(Result)+1);
1041
1042         if s[a] = ',' then
1043           Result[High(Result)] := Copy(s, 1, a-1)
1044         else // Êîíåö ñòðîêè
1045           Result[High(Result)] := s;
1046
1047         Delete(s, 1, a);
1048         Break;
1049       end;
1050   end;
1051 end;
1052
1053 function parse2(s: string; delim: Char): SSArray;
1054 var
1055   a: Integer;
1056 begin
1057   Result := nil;
1058   if s = '' then Exit;
1059
1060   while s <> '' do
1061   begin
1062     for a := 1 to Length(s) do
1063       if (s[a] = delim) or (a = Length(s)) then
1064       begin
1065         SetLength(Result, Length(Result)+1);
1066
1067         if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1)
1068         else Result[High(Result)] := s;
1069
1070         Delete(s, 1, a);
1071         Break;
1072       end;
1073   end;
1074 end;
1075
1076 function g_GetFileTime(fileName: String): Integer;
1077 var
1078   F: File;
1079 begin
1080   if not FileExists(fileName) then
1081   begin
1082     Result := -1;
1083     Exit;
1084   end;
1085
1086   AssignFile(F, fileName);
1087   Reset(F);
1088   Result := FileGetDate(TFileRec(F).Handle);
1089   CloseFile(F);
1090 end;
1091
1092 function g_SetFileTime(fileName: String; time: Integer): Boolean;
1093 var
1094   F: File;
1095 begin
1096   if (not FileExists(fileName)) or (time < 0) then
1097   begin
1098     Result := False;
1099     Exit;
1100   end;
1101
1102   AssignFile(F, fileName);
1103   Reset(F);
1104   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
1105   CloseFile(F);
1106 end;
1107
1108 procedure SortSArray(var S: SSArray);
1109 var
1110   b: Boolean;
1111   i: Integer;
1112   sw: ShortString;
1113 begin
1114   repeat
1115     b := False;
1116     for i := Low(S) to High(S) - 1 do
1117       if S[i] > S[i + 1] then begin
1118         sw := S[i];
1119         S[i] := S[i + 1];
1120         S[i + 1] := sw;
1121         b := True;
1122       end;
1123   until not b;
1124 end;
1125
1126 function b_Text_Format(S: string): string;
1127 var
1128   Spec, Rst: Boolean;
1129   I: Integer;
1130 begin
1131   Result := '';
1132   Spec := False;
1133   Rst := False;
1134   for I := 1 to Length(S) do
1135   begin
1136     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1137     begin
1138       Spec := True;
1139       Rst := True;
1140       continue;
1141     end;
1142     if Spec then
1143     begin
1144       case S[I] of
1145         'n': // line feed
1146           Result := Result + #10;
1147         '0': // black
1148           Result := Result + #1;
1149         '1': // white
1150           Result := Result + #2;
1151         'd': // darker
1152           Result := Result + #3;
1153         'l': // lighter
1154           Result := Result + #4;
1155         'r': // red
1156           Result := Result + #18;
1157         'g': // green
1158           Result := Result + #19;
1159         'b': // blue
1160           Result := Result + #20;
1161         'y': // yellow
1162           Result := Result + #21;
1163         '\': // escape
1164           Result := Result + '\';
1165         else
1166           Result := Result + '\' + S[I];
1167       end;
1168       Spec := False;
1169     end else
1170       Result := Result + S[I];
1171   end;
1172   // reset to white at end
1173   if Rst then Result := Result + #2;
1174 end;
1175
1176 function b_Text_Unformat(S: string): string;
1177 var
1178   Spec: Boolean;
1179   I: Integer;
1180 begin
1181   Result := '';
1182   Spec := False;
1183   for I := 1 to Length(S) do
1184   begin
1185     if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1186     begin
1187       Spec := False;
1188       continue;
1189     end;
1190     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1191     begin
1192       Spec := True;
1193       continue;
1194     end;
1195     if Spec then
1196     begin
1197       case S[I] of
1198         'n': ;
1199         '0': ;
1200         '1': ;
1201         'd': ;
1202         'l': ;
1203         'r': ;
1204         'g': ;
1205         'b': ;
1206         'y': ;
1207         '\': Result := Result + '\';
1208         else
1209           Result := Result + '\' + S[I];
1210       end;
1211       Spec := False;
1212     end else
1213       Result := Result + S[I];
1214   end;
1215 end;
1216
1217 function b_Text_Wrap(S: string; LineLen: Integer): string;
1218 begin
1219   Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen);
1220 end;
1221
1222 function b_Text_LineCount(S: string): Integer;
1223 var
1224   I: Integer;
1225 begin
1226   Result := IfThen(S = '', 0, 1);
1227   for I := 1 to High(S) do
1228     if S[I] = #10 then
1229       Inc(Result);
1230 end;
1231
1232 end.