src/game/g_basic.pas

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