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   for a := 1 to Length(Str) do
 618     if (a = Length(Str)) or (Str[a+1] = ' ') then
 619     begin
 620       Result := Copy(Str, 1, a);
 621       Delete(Str, 1, a+1);
 622       Str := Trim(Str);
 623       Exit;
 624     end;
 625 end;
 626
 627 {function GetLines(Text: string; MaxChars: Word): SArray;
 628 var
 629   a: Integer;
 630   b: array of string;
 631   str: string;
 632 begin
 633  Text := Trim(Text);
 634
 635  while Pos('  ', Text) <> 0 do Text := AnsiReplaceStr(Text, '  ', ' ');
 636
 637  while Text <> '' do
 638  begin
 639   SetLength(b, Length(b)+1);
 640   b[High(b)] := GetStr(Text);
 641  end;
 642
 643  a := 0;
 644  while True do
 645  begin
 646   if a > High(b) then Break;
 647
 648   str := b[a];
 649   a := a+1;
 650
 651   if Length(str) >= MaxChars then
 652   begin
 653    while str <> '' do
 654    begin
 655     SetLength(Result, Length(Result)+1);
 656     Result[High(Result)] := Copy(str, 1, MaxChars);
 657     Delete(str, 1, MaxChars);
 658    end;
 659
 660    Continue;
 661   end;
 662
 663   while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
 664   begin
 665    str := str+' '+b[a];
 666    a := a+1;
 667   end;
 668
 669   SetLength(Result, Length(Result)+1);
 670   Result[High(Result)] := str;
 671  end;
 672 end;}
 673
 674 function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray;
 675
 676 function TextLen(Text: string): Word;
 677 var
 678   h: Word;
 679 begin
 680   e_CharFont_GetSize(FontID, Text, Result, h);
 681 end;
 682
 683 var
 684   a, c: Integer;
 685   b: array of string;
 686   str: string;
 687 begin
 688   SetLength(Result, 0);
 689   SetLength(b, 0);
 690
 691   Text := Trim(Text);
 692
 693 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
 694   while Pos('  ', Text) <> 0 do
 695     Text := AnsiReplaceStr(Text, '  ', ' ');
 696
 697   while Text <> '' do
 698   begin
 699     SetLength(b, Length(b)+1);
 700     b[High(b)] := GetStr(Text);
 701   end;
 702
 703   a := 0;
 704   while True do
 705   begin
 706     if a > High(b) then
 707       Break;
 708
 709     str := b[a];
 710     a := a+1;
 711
 712     if TextLen(str) > MaxWidth then
 713     begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
 714       while str <> '' do
 715       begin
 716         SetLength(Result, Length(Result)+1);
 717
 718         c := 0;
 719         while (c < Length(str)) and
 720               (TextLen(Copy(str, 1, c+1)) < MaxWidth) do
 721           c := c+1;
 722
 723         Result[High(Result)] := Copy(str, 1, c);
 724         Delete(str, 1, c);
 725       end;
 726     end
 727     else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
 728     begin
 729       while (a <= High(b)) and
 730             (TextLen(str+' '+b[a]) < MaxWidth) do
 731       begin
 732         str := str+' '+b[a];
 733         a := a + 1;
 734       end;
 735
 736       SetLength(Result, Length(Result)+1);
 737       Result[High(Result)] := str;
 738     end;
 739   end;
 740 end;
 741
 742 procedure Sort(var a: SArray);
 743 var
 744   i, j: Integer;
 745   s: string;
 746 begin
 747   if a = nil then Exit;
 748
 749   for i := High(a) downto Low(a) do
 750     for j := Low(a) to High(a)-1 do
 751       if LowerCase(a[j]) > LowerCase(a[j+1]) then
 752       begin
 753         s := a[j];
 754         a[j] := a[j+1];
 755         a[j+1] := s;
 756       end;
 757 end;
 758
 759 function Sscanf(const s: String; const fmt: String;
 760                 const Pointers: array of Pointer): Integer;
 761 var
 762   i, j, n, m: Integer;
 763   s1: ShortString;
 764   L: LongInt;
 765   X: Extended;
 766
 767   function GetInt(): Integer;
 768   begin
 769     s1 := '';
 770     while (n <= Length(s)) and (s[n] = ' ') do
 771       Inc(n);
 772
 773     while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do
 774     begin
 775       s1 := s1 + s[n];
 776       Inc(n);
 777     end;
 778
 779     Result := Length(s1);
 780   end;
 781
 782   function GetFloat(): Integer;
 783   begin
 784     s1 := '';
 785     while (n <= Length(s)) and (s[n] = ' ') do
 786       Inc(n);
 787
 788     while (n <= Length(s)) and //jd >= rather than >
 789           (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
 790     begin
 791       s1 := s1 + s[n];
 792       Inc(n);
 793     end;
 794
 795     Result := Length(s1);
 796   end;
 797
 798   function GetString(): Integer;
 799   begin
 800     s1 := '';
 801     while (n <= Length(s)) and (s[n] = ' ') do
 802       Inc(n);
 803
 804     while (n <= Length(s)) and (s[n] <> ' ') do
 805     begin
 806       s1 := s1 + s[n];
 807       Inc(n);
 808     end;
 809
 810     Result := Length(s1);
 811   end;
 812
 813   function ScanStr(c: Char): Boolean;
 814   begin
 815     while (n <= Length(s)) and (s[n] <> c) do
 816       Inc(n);
 817     Inc(n);
 818
 819     Result := (n <= Length(s));
 820   end;
 821
 822   function GetFmt(): Integer;
 823   begin
 824     Result := -1;
 825
 826     while (True) do
 827     begin
 828       while (fmt[m] = ' ') and (m < Length(fmt)) do
 829         Inc(m);
 830       if (m >= Length(fmt)) then
 831         Break;
 832
 833       if (fmt[m] = '%') then
 834       begin
 835         Inc(m);
 836         case fmt[m] of
 837           'd': Result := vtInteger;
 838           'f': Result := vtExtended;
 839           's': Result := vtString;
 840         end;
 841         Inc(m);
 842         Break;
 843       end;
 844
 845       if (not ScanStr(fmt[m])) then
 846         Break;
 847       Inc(m);
 848     end;
 849   end;
 850
 851 begin
 852   n := 1;
 853   m := 1;
 854   Result := 0;
 855
 856   for i := 0 to High(Pointers) do
 857   begin
 858     j := GetFmt();
 859
 860     case j of
 861       vtInteger :
 862       begin
 863         if GetInt() > 0 then
 864           begin
 865             L := StrToIntDef(s1, 0);
 866             Move(L, Pointers[i]^, SizeOf(LongInt));
 867             Inc(Result);
 868           end
 869         else
 870           Break;
 871       end;
 872
 873       vtExtended :
 874       begin
 875         if GetFloat() > 0 then
 876           begin
 877             X := StrToFloatDef(s1, 0.0);
 878             Move(X, Pointers[i]^, SizeOf(Extended));
 879             Inc(Result);
 880           end
 881         else
 882           Break;
 883       end;
 884
 885       vtString :
 886       begin
 887         if GetString() > 0 then
 888           begin
 889             Move(s1, Pointers[i]^, Length(s1)+1);
 890             Inc(Result);
 891           end
 892         else
 893           Break;
 894       end;
 895
 896       else {case}
 897         Break;
 898     end; {case}
 899   end;
 900 end;
 901
 902 function InDWArray(a: DWORD; arr: DWArray): Boolean;
 903 var
 904   b: Integer;
 905 begin
 906   Result := False;
 907
 908   if arr = nil then Exit;
 909
 910   for b := 0 to High(arr) do
 911     if arr[b] = a then
 912     begin
 913       Result := True;
 914       Exit;
 915     end;
 916 end;
 917
 918 function InWArray(a: Word; arr: WArray): Boolean;
 919 var
 920   b: Integer;
 921 begin
 922   Result := False;
 923
 924   if arr = nil then Exit;
 925
 926   for b := 0 to High(arr) do
 927     if arr[b] = a then
 928     begin
 929       Result := True;
 930       Exit;
 931     end;
 932 end;
 933
 934 function InSArray(a: string; arr: SArray): Boolean;
 935 var
 936   b: Integer;
 937 begin
 938   Result := False;
 939
 940   if arr = nil then Exit;
 941
 942   a := AnsiLowerCase(a);
 943
 944   for b := 0 to High(arr) do
 945     if AnsiLowerCase(arr[b]) = a then
 946     begin
 947       Result := True;
 948       Exit;
 949     end;
 950 end;
 951
 952 function GetPos(UID: Word; o: PObj): Boolean;
 953 var
 954   p: TPlayer;
 955   m: TMonster;
 956 begin
 957   Result := False;
 958
 959   case g_GetUIDType(UID) of
 960     UID_PLAYER:
 961     begin
 962       p := g_Player_Get(UID);
 963       if p = nil then Exit;
 964       if not p.Live then Exit;
 965
 966       o^ := p.Obj;
 967     end;
 968
 969     UID_MONSTER:
 970     begin
 971       m := g_Monsters_Get(UID);
 972       if m = nil then Exit;
 973       if not m.Live then Exit;
 974
 975       o^ := m.Obj;
 976     end;
 977     else Exit;
 978   end;
 979
 980   Result := True;
 981 end;
 982
 983 function parse(s: String): SArray;
 984 var
 985   a: Integer;
 986 begin
 987   Result := nil;
 988   if s = '' then
 989     Exit;
 990
 991   while s <> '' do
 992   begin
 993     for a := 1 to Length(s) do
 994       if (s[a] = ',') or (a = Length(s)) then
 995       begin
 996         SetLength(Result, Length(Result)+1);
 997
 998         if s[a] = ',' then
 999           Result[High(Result)] := Copy(s, 1, a-1)
1000         else // Êîíåö ñòðîêè
1001           Result[High(Result)] := s;
1002
1003         Delete(s, 1, a);
1004         Break;
1005       end;
1006   end;
1007 end;
1008
1009 function parse2(s: string; delim: Char): SArray;
1010 var
1011   a: Integer;
1012 begin
1013   Result := nil;
1014   if s = '' then Exit;
1015
1016   while s <> '' do
1017   begin
1018     for a := 1 to Length(s) do
1019       if (s[a] = delim) or (a = Length(s)) then
1020       begin
1021         SetLength(Result, Length(Result)+1);
1022
1023         if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1)
1024         else Result[High(Result)] := s;
1025
1026         Delete(s, 1, a);
1027         Break;
1028       end;
1029   end;
1030 end;
1031
1032 function g_GetFileTime(fileName: String): Integer;
1033 var
1034   F: File;
1035 begin
1036   if not FileExists(fileName) then
1037   begin
1038     Result := -1;
1039     Exit;
1040   end;
1041
1042   AssignFile(F, fileName);
1043   Reset(F);
1044   Result := FileGetDate(TFileRec(F).Handle);
1045   CloseFile(F);
1046 end;
1047
1048 function g_SetFileTime(fileName: String; time: Integer): Boolean;
1049 var
1050   F: File;
1051 begin
1052   if (not FileExists(fileName)) or (time < 0) then
1053   begin
1054     Result := False;
1055     Exit;
1056   end;
1057
1058   AssignFile(F, fileName);
1059   Reset(F);
1060   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
1061   CloseFile(F);
1062 end;
1063
1064 procedure SortSArray(var S: SArray);
1065 var
1066   b: Boolean;
1067   i: Integer;
1068   sw: ShortString;
1069 begin
1070   repeat
1071     b := False;
1072     for i := Low(S) to High(S) - 1 do
1073       if S[i] > S[i + 1] then begin
1074         sw := S[i];
1075         S[i] := S[i + 1];
1076         S[i + 1] := sw;
1077         b := True;
1078       end;
1079   until not b;
1080 end;
1081
1082 function b_Text_Format(S: string): string;
1083 var
1084   Spec, Rst: Boolean;
1085   I: Integer;
1086 begin
1087   Result := '';
1088   Spec := False;
1089   Rst := False;
1090   for I := 1 to Length(S) do
1091   begin
1092     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1093     begin
1094       Spec := True;
1095       Rst := True;
1096       continue;
1097     end;
1098     if Spec then
1099     begin
1100       case S[I] of
1101         'n': // line feed
1102           Result := Result + #10;
1103         '0': // black
1104           Result := Result + #1;
1105         '1': // white
1106           Result := Result + #2;
1107         'd': // darker
1108           Result := Result + #3;
1109         'l': // lighter
1110           Result := Result + #4;
1111         'r': // red
1112           Result := Result + #18;
1113         'g': // green
1114           Result := Result + #19;
1115         'b': // blue
1116           Result := Result + #20;
1117         'y': // yellow
1118           Result := Result + #21;
1119         '\': // escape
1120           Result := Result + '\';
1121         else
1122           Result := Result + '\' + S[I];
1123       end;
1124       Spec := False;
1125     end else
1126       Result := Result + S[I];
1127   end;
1128   // reset to white at end
1129   if Rst then Result := Result + #2;
1130 end;
1131
1132 function b_Text_Unformat(S: string): string;
1133 var
1134   Spec: Boolean;
1135   I: Integer;
1136 begin
1137   Result := '';
1138   Spec := False;
1139   for I := 1 to Length(S) do
1140   begin
1141     if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1142     begin
1143       Spec := False;
1144       continue;
1145     end;
1146     if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1147     begin
1148       Spec := True;
1149       continue;
1150     end;
1151     if Spec then
1152     begin
1153       case S[I] of
1154         'n': ;
1155         '0': ;
1156         '1': ;
1157         'd': ;
1158         'l': ;
1159         'r': ;
1160         'g': ;
1161         'b': ;
1162         'y': ;
1163         '\': Result := Result + '\';
1164         else
1165           Result := Result + '\' + S[I];
1166       end;
1167       Spec := False;
1168     end else
1169       Result := Result + S[I];
1170   end;
1171 end;
1172
1173 end.