src/game/g_basic.pas

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