source: trunk/World.pas

unit World;

interface

uses
  Classes, SysUtils, Graphics, GraphType, SpecializedMatrix, Matter;

type
  { TWorld }

  TWorld = class
  private
    function GetSize: TMatrixByteIndex;
    procedure SetSize(const AValue: TMatrixByteIndex);
    procedure InitMatter;
  public
    Surface: TMatrixByte;
    Matters: TMatters;
    procedure Generate;
    constructor Create;
    destructor Destroy; override;
    procedure DrawToBitmap(Bitmap: TBitmap);
    property Size: TMatrixByteIndex read GetSize write SetSize;
  end;


implementation

uses
  FastPixel;

{ TWorld }

function TWorld.GetSize: TMatrixByteIndex;
begin
  Result := Surface.Count;
end;

procedure TWorld.SetSize(const AValue: TMatrixByteIndex);
begin
  Surface.Count := AValue;
  Generate;
end;

procedure TWorld.InitMatter;
var
  I: Integer;
begin
  // Space
  with Matters.AddNew do begin
    Kind := mkSpace;
    Color := clBlack;
    Player := -1;
  end;
  // Dirt1
  with Matters.AddNew do begin
    Kind := mkDirt;
    Color := $0756b0;
    Player := -1;
    Diggable := True;
  end;
  // Dirt2
  with Matters.AddNew do begin
    Kind := mkDirt;
    Color := $2170c3;
    Player := -1;
    Diggable := True;
  end;
  // Rock
  with Matters.AddNew do begin
    Kind := mkRock;
    Color := TColor($9a9a9a);
    Player := -1;
    Blocking := True;
  end;
  // Bullet1
  with Matters.AddNew do begin
    Kind := mkBullet;
    Color := clRed;
    Player := -1;
  end;
  // Bullet2
  with Matters.AddNew do begin
    Kind := mkBullet;
    Color := clRed;
    Player := -1;
  end;
  // Border
  with Matters.AddNew do begin
    Kind := mkBorder;
    Color := clBlack;
    Player := -1;
  end;

  for I := 0 to 7 do begin
    // Player cannon
    with Matters.AddNew do begin
      Kind := mkTankBody;
      Player := I;
      Blocking := True;
    end;
    // Player home
    with Matters.AddNew do begin
      Kind := mkHome;
      Player := I;
      Blocking := True;
    end;
    // Player body1
    with Matters.AddNew do begin
      Kind := mkTankBody;
      Player := I;
      Blocking := True;
    end;
    // Player body2
    with Matters.AddNew do begin
      Kind := mkTankBody;
      Player := I;
      Blocking := True;
    end;
  end;
end;

procedure TWorld.Generate;
var
  X, Y: Integer;
  Distance: Double;
  Delta: Double;
begin
  for Y := 0 to Surface.Count.Y - 1 do
    for X := 0 to Surface.Count.X - 1 do begin
      if Random < 0.5 then
        Surface.ItemsXY[X, Y] := Byte(miDirt1) else
        Surface.ItemsXY[X, Y] := Byte(miDirt2);
    end;

  Distance := 0.1 * Surface.Count.X;
  Delta := 0;
  for Y := 0 to Surface.Count.Y - 1 do begin
    for X := 0 to Round(Distance) - 1 do begin
      Surface.ItemsXY[X, Y] := Byte(miRock);
    end;
    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);
    Distance := Distance + Delta;
  end;

  Distance := 0.1 * Surface.Count.X;
  Delta := 0;
  for Y := 0 to Surface.Count.Y - 1 do begin
    for X := 0 to Round(Distance) - 1 do begin
      Surface.ItemsXY[Surface.Count.X - 1 - X, Y] := Byte(miRock);
    end;
    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);
    Distance := Distance + Delta;
  end;

  Distance := 0.1 * Surface.Count.Y;
  Delta := 0;
  for X := 0 to Surface.Count.X - 1 do begin
    for Y := 0 to Round(Distance) - 1 do begin
      Surface.ItemsXY[X, Y] := Byte(miRock);
    end;
    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);
    Distance := Distance + Delta;
  end;

  Distance := 0.1 * Surface.Count.Y;
  Delta := 0;
  for X := 0 to Surface.Count.X - 1 do begin
    for Y := 0 to Round(Distance) - 1 do begin
      Surface.ItemsXY[X, Surface.Count.Y - 1 - Y] := Byte(miRock);
    end;
    Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);
    Distance := Distance + Delta;
  end;
end;

constructor TWorld.Create;
var
  NewSize: TMatrixByteIndex;
begin
  Matters := TMatters.Create;
  InitMatter;
  Surface := TMatrixByte.Create;
  NewSize.X := 800;
  NewSize.Y := 300;
  Size := NewSize;
end;

destructor TWorld.Destroy;
begin
  FreeAndNil(Surface);
  FreeAndNil(Matters);
  inherited;
end;

procedure TWorld.DrawToBitmap(Bitmap: TBitmap);
var
  X, Y: Integer;
  PixelPtr: PInteger;
  PixelRowPtr: PInteger;
  RawImage: TRawImage;
  BytePerPixel: Integer;
  P: Integer;
begin
  Bitmap.BeginUpdate;
  try
    RawImage := Bitmap.RawImage;
    PixelRowPtr := PInteger(RawImage.Data);
    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    for Y := 0 to Bitmap.Height - 1 do begin
      PixelPtr := PixelRowPtr;
      for X := 0 to Bitmap.Width - 1 do begin
        P := Matters[Surface.ItemsXY[Trunc(X / Bitmap.Width * Surface.Count.X),
            Trunc(Y / Bitmap.Height * Surface.Count.Y)]].Color;
        PixelPtr^ := SwapBRComponent(P);
        Inc(PByte(PixelPtr), BytePerPixel);
      end;
      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
    end;
  finally
    Bitmap.EndUpdate;
  end;
end;


end.