unit PlayFld;

interface

uses System.Drawing, System.Windows.Forms;

    // We assume that the playing field
    // cannot be bigger than 100x100, and the
    // game piece is limited to 4x4
CONST MAX_PIECE =  3;
      MAX_FIELD = 99;

type
  MyColors =
  (
    Red     = 1,
    Blue    = 2,
    Orange  = 3,
    Yellow  = 4,
    Lime    = 5,
    Aqua    = 6,
    Magenta = 7,
    Black   = 8
  );

  TPiece = Array[0..MAX_PIECE, 0..MAX_PIECE] of Integer;
  TGamePiece = class;

  TPlayingField = class(System.Windows.Forms.PictureBox)
  private

    FOwner: System.Windows.Forms.Form;
    gp: TGamePiece;
    MainTimer: Timer;
    RowsRemoved: Integer;
    CurrentDelay: Integer;

    procedure TimerEvent(sender: System.Object; e: System.EventArgs);
    procedure GameOver;
    procedure EmptyPlayingField;
    procedure SpeedUp(r: Integer);
    procedure RemoveRow(r: Integer);
    procedure RemoveRows(score: Integer);
    function  ConsolidatePiece(p: TGamePiece): Boolean;

  strict protected
    procedure OnPaint(e: PaintEventArgs); override;

  public
    FieldHeight: Integer;
    FieldWidth: Integer;

    pfmatrix: Array[0..MAX_FIELD, 0..MAX_FIELD] of Integer; //col, row

    constructor Create(aOwner: Form; x, y, h, w: Integer);

    procedure Drop;
    procedure GoDown;
    procedure GoLeft;
    procedure GoRight;
    procedure NewGame;
    procedure PauseGame;
    procedure ResumeGame;
    procedure TurnClockwise;
    procedure TurnCounterclockwise;
  end;

  TGamePiece = class
  private
    FOwner: TPlayingField;
    cColor, nColor: MyColors;
    cMaxCols, cMaxRows: Integer;
    nMaxCols, nMaxRows: Integer;
    cPiece, nPiece: TPiece; //current, next
    col, row: Integer;

    procedure InitPiece;
    procedure ClearPiece(VAR piece: TPiece);
    procedure Rotate(clockwise: Boolean);
    function  Overlap(piece: TPiece; MaxCols, MaxRows: Integer): Boolean;
    procedure DropDown;
    procedure ConsolidatePiece;
    procedure StepDown;
    procedure StepLeft;
    procedure StepRight;

  public
    constructor Create(aOwner: TPlayingField);
  end;

implementation

uses WinForm;

function GetColorValue(i: Integer; default: Color): Color;
begin
    case (i) of
      Integer(MyColors.Red):     Result := Color.Red;
      Integer(MyColors.Lime):    Result := Color.Lime;
      Integer(MyColors.Orange):  Result := Color.Orange;
      Integer(MyColors.Blue):    Result := Color.Blue;
      Integer(MyColors.Yellow):  Result := Color.Yellow;
      Integer(MyColors.Black):   Result := Color.Black;
      Integer(MyColors.Magenta): Result := Color.Magenta;
      Integer(MyColors.Aqua):    Result := Color.Aqua;
      else                       Result := default;
    end;
end;


constructor TPlayingField.Create(aOwner: Form; x, y, h, w: Integer);
begin
  inherited Create;

  FOwner := aOwner;

  FieldWidth := 10;
  FieldHeight := 20;
  CurrentDelay := 500;

  Self.Parent := FOwner;
  Self.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top
      or System.Windows.Forms.AnchorStyles.Bottom) or System.Windows.Forms.AnchorStyles.Right)));
  Self.BorderStyle := System.Windows.Forms.BorderStyle.None;
  Self.Location := System.Drawing.Point.Create(x, y);
  Self.Name := 'MainPanel';
  Self.Size := System.Drawing.Size.Create(h, w);
  Self.TabIndex := 3;

  EmptyPlayingField();
  gp := TGamePiece.Create(Self);

  MainTimer := Timer.Create;
  Include(MainTimer.Tick, Self.TimerEvent);
end;

PROCEDURE TPlayingField.EmptyPlayingField;
VAR row, col: Integer;
begin
  for row := 0 to Pred(FieldHeight) do
    for col := 0 to Pred(FieldWidth) do
      pfmatrix[col,row] := 0
end;

procedure TPlayingField.OnPaint(e: PaintEventArgs);
VAR g: Graphics;
    b: SolidBrush;
    p: Pen;
    hor_offset, ver_offset, current: Integer;
    r,c,x: Integer;
begin
  g := e.Graphics;

  SuspendLayout();

  b := SolidBrush.Create(Color.FromArgb(180, Color.White));

  if ((Width / (FieldWidth + MAX_PIECE+2)) < (Height / FieldHeight)) then
    x := Width div (FieldWidth + MAX_PIECE+2)
  else
    x := Height div FieldHeight;

  hor_offset := (Width - x * (FieldWidth + MAX_PIECE+2)) div 2;
  ver_offset := (Height - x * FieldHeight) div 2;

  p := Pen.Create(Color.Gray);

  g.DrawLine(p, hor_offset,
                ver_offset,
                hor_offset,
                ver_offset+x * (MAX_PIECE+1));
  g.DrawLine(p, hor_offset,
                ver_offset+x * (MAX_PIECE+1),
                hor_offset+x * (MAX_PIECE+1),
                ver_offset+x * (MAX_PIECE+1));
  g.DrawLine(p, hor_offset+x * (MAX_PIECE+1),
                ver_offset+x * (MAX_PIECE+1),
                hor_offset+x * (MAX_PIECE+1),
                ver_offset);
  g.DrawLine(p, hor_offset,
                ver_offset,
                hor_offset+x * (MAX_PIECE+1),
                ver_offset);

  for r := 0 to MAX_PIECE do
    for c := 0 to MAX_PIECE do
    begin
      b.Color := GetColorValue(gp.nPiece[c,r], BackColor);
      g.FillRectangle(b, hor_offset+1+c*x,
                         ver_offset+1+(MAX_PIECE-r)*x,
                         x-1,x-1);
    end;

  hor_offset := hor_offset+x * (MAX_PIECE+2);

  g.DrawLine(p, hor_offset,
                ver_offset,
                hor_offset,
                ver_offset+x * FieldHeight);
  g.DrawLine(p, hor_offset,
                ver_offset+x * FieldHeight,
                hor_offset+x * FieldWidth,
                ver_offset+x * FieldHeight);
  g.DrawLine(p, hor_offset+x * FieldWidth,
                ver_offset+x * FieldHeight,
                hor_offset+x * FieldWidth,
                ver_offset);

  Dec(x);

  for r := 0 to Pred(FieldHeight) do
    for c := 0 to Pred(FieldWidth) do
    begin
      current := pfmatrix[c,r];

      if Assigned(gp) then
      begin
        if ((gp.row <= r) AND (r < gp.row+gp.cMaxRows) AND
            (gp.col <= c) AND (c < gp.col+gp.cMaxCols)) then
            current := current OR gp.cPiece[c-gp.col,r-gp.row];
      end;

      b.Color := GetColorValue(current, BackColor);
      g.FillRectangle(b, hor_offset+1+c*(x+1), ver_offset+1+(FieldHeight-1-r)*(x+1),x,x);
    end;
  ResumeLayout(false);
end;

procedure TPlayingField.SpeedUp(r: Integer);
begin
  if (r > 10) then Exit; { don't speed up at the top }
  Inc(RowsRemoved);
  if ((RowsRemoved > 35) AND (CurrentDelay > 450)) then
    Dec(CurrentDelay, 50);
  if ((RowsRemoved > 55) AND (CurrentDelay > 400)) then
    Dec(CurrentDelay, 50);
  if ((RowsRemoved > 75) AND (CurrentDelay > 350)) then
    Dec(CurrentDelay, 50);
  if ((RowsRemoved > 85) AND (CurrentDelay > 300)) then
    Dec(CurrentDelay, 50);
  if ((RowsRemoved > 90) AND (CurrentDelay > 250)) then
    Dec(CurrentDelay, 50);
  if ((RowsRemoved > 95) AND (CurrentDelay > 200)) then
    Dec(CurrentDelay, 50);
  if ((RowsRemoved > 100) AND (CurrentDelay > 150)) then
    Dec(CurrentDelay, 50);
end;

procedure TPlayingField.RemoveRow(r: Integer);
VAR row, col: Integer;
begin
  SpeedUp(r);
  (FOwner as TWinForm).AddScore(10*(r+1));

  for row := r to Pred(FieldHeight-1) do
    for col := 0 to Pred(FieldWidth) do
      pfmatrix[col,row] := pfmatrix[col,row+1];

  for col := 0 to Pred(FieldWidth) do
    pfmatrix[col,FieldHeight-1] := 0;
end;

procedure TPlayingField.RemoveRows(score: Integer);
VAR hole: Boolean;
    c,r: Integer;
begin
  r := 0;
  (FOwner as TWinForm).AddScore(score);
  repeat
    hole := false;
    for c := 0 to Pred(FieldWidth) do
      if (pfmatrix[c,r] = 0) then hole := true;
    if (hole) then
      Inc(r)
    else
      RemoveRow(r);
  until (r >= FieldHeight);
end;

procedure TPlayingField.GoLeft;
begin
  if Assigned(gp) then gp.StepLeft();
end;

procedure TPlayingField.GoRight;
begin
  if Assigned(gp) then gp.StepRight();
end;

procedure TPlayingField.TurnClockwise;
begin
  if Assigned(gp) then gp.Rotate(true);
end;

procedure TPlayingField.TurnCounterclockwise;
begin
  if Assigned(gp) then gp.Rotate(false);
end;

procedure TPlayingField.GoDown;
begin
  if Assigned(gp) then gp.StepDown();
end;

procedure TPlayingField.Drop;
begin
  if Assigned(gp) then gp.DropDown();
end;

procedure TPlayingField.TimerEvent(sender: System.Object; e: System.EventArgs);
begin
  if Assigned(gp) then gp.StepDown();
end;

procedure TPlayingField.PauseGame;
begin
  MainTimer.Enabled := false
end;

procedure TPlayingField.ResumeGame;
begin
  MainTimer.Enabled := true;
end;

procedure TPlayingField.GameOver;
begin
  MainTimer.Enabled := false;
  (FOwner as TWinForm).GameOver();
end;

procedure TPlayingField.NewGame;
begin
  EmptyPlayingField();
  RowsRemoved := 0;
  CurrentDelay := 500;
  Invalidate();
  gp.InitPiece();
  MainTimer.Interval := CurrentDelay;
  MainTimer.Enabled := true;
end;

function  TPlayingField.ConsolidatePiece(p: TGamePiece): Boolean;
VAR count,c,r: Integer;
begin
  Result := false;

  if (p.row + p.cMaxRows > FieldHeight) then
    GameOver()
  else begin
    count := 0;
    for c := 0 to Pred(FieldWidth) do
      for r := 0 to Pred(FieldHeight) do
        if ((p.row <= r) AND (r < p.row+p.cMaxRows) AND
            (p.col <= c) AND (c < p.col+p.cMaxCols)) then
            begin
              pfmatrix[c,r] := pfmatrix[c,r] OR p.cPiece[c-p.col,r-p.row];
              if (p.cPiece[c-p.col,r-p.row] <> 0) then Inc(count);
            end;

    RemoveRows(count);
    Invalidate();

    Result := true;
  end;
end;

{  TGamePiece  }

constructor TGamePiece.Create(aOwner: TPlayingField);
begin
  inherited Create;
  FOwner := aOwner;
  InitPiece;
  InitPiece;
end;

procedure TGamePiece.ClearPiece(VAR piece: TPiece);
VAR i,j: Integer;
begin
  for i := 0 to MAX_PIECE do
    for j := 0 to MAX_PIECE do
      piece[i,j] := 0
end;

procedure TGamePiece.InitPiece;
VAR i,c,r: Integer;
    rdm: System.Random;
begin
  for c := 0 to MAX_PIECE do
    for r := 0 to MAX_PIECE do
      cPiece[c,r] := nPiece[c,r];

  cColor := nColor;
  cMaxCols := nMaxCols;
  cMaxRows := nMaxRows;

  col := FOwner.FieldWidth div 2 - 1;
  row := FOwner.FieldHeight;

  rdm := System.Random.Create(Integer(DateTime.Now.Ticks));

  repeat
    i := rdm.Next(1, 9);
    nColor := MyColors(i);
  until (cColor <> nColor);

  case (rdm.Next(1,8)) of
    1: begin
          //  WW
          //  WW
          ClearPiece(nPiece); //{i,i},{i,i}
          nPiece[0,0] := i;
          nPiece[0,1] := i;
          nPiece[1,0] := i;
          nPiece[1,1] := i;
          nMaxCols := 2;
          nMaxRows := 2;
       end;

    2: begin
          //  W
          //  W
          //  W
          //  W
          ClearPiece(nPiece); //{i,i,i,i}
          nPiece[0,0] := i;
          nPiece[0,1] := i;
          nPiece[0,2] := i;
          nPiece[0,3] := i;
          nMaxCols := 1;
          nMaxRows := 4;
       end;
    3: begin
          //  W
          //  W
          //  WW
          ClearPiece(nPiece); //{i,i,i},{0,0,i}
          nPiece[0,0] := i;
          nPiece[0,1] := i;
          nPiece[0,2] := i;
          nPiece[1,2] := i;
          nMaxCols := 2;
          nMaxRows := 3;
       end;
    4: begin
          //   W
          //   W
          //  WW
          ClearPiece(nPiece); //{0,0,i},{i,i,i}
          nPiece[0,2] := i;
          nPiece[1,0] := i;
          nPiece[1,1] := i;
          nPiece[1,2] := i;
          nMaxCols := 2;
          nMaxRows := 3;
       end;
    5: begin
          //  W
          //  WW
          //   W
          ClearPiece(nPiece); //{i,i,0},{0,i,i}
          nPiece[0,0] := i;
          nPiece[0,1] := i;
          nPiece[1,1] := i;
          nPiece[1,2] := i;
          nMaxCols := 2;
          nMaxRows := 3;
       end;
    6: begin
          //   W
          //  WW
          //  W
          ClearPiece(nPiece); //{0,i,i},{i,i,0}
          nPiece[1,0] := i;
          nPiece[0,1] := i;
          nPiece[1,1] := i;
          nPiece[0,2] := i;
          nMaxCols := 2;
          nMaxRows := 3;
       end;
    else begin
          //   W
          //  WW
          //   W
          ClearPiece(nPiece); //{0,i,0},{i,i,i}
          nPiece[1,0] := i;
          nPiece[0,1] := i;
          nPiece[1,1] := i;
          nPiece[1,2] := i;
          nMaxCols := 2;
          nMaxRows := 3;
       end;
  end; { case }
end;

procedure TGamePiece.Rotate(clockwise: Boolean);
VAR c,r: Integer;
    xPiece: TPiece;
begin
  ClearPiece(xPiece);

  if (clockwise) then
  begin
    for c := 0 to Pred(cMaxCols) do
      for r := 0 to Pred(cMaxRows) do
        xPiece[cMaxRows-1-r,c] := cPiece[c,r];
  end
  else begin
    for c := 0 to Pred(cMaxCols) do
      for r := 0 to Pred(cMaxRows) do
        xPiece[r,cMaxCols-1-c] := cPiece[c,r];
  end;

  if (NOT Overlap(xPiece, cMaxRows, cMaxCols)) then
  begin
    for c := 0 to MAX_PIECE do
      for r := 0 to MAX_PIECE do
        cPiece[c,r] := xPiece[c,r];
    c := cMaxRows;
    cMaxRows := cMaxCols;
    cMaxCols := c;
    FOwner.Invalidate;
  end;
end;

function TGamePiece.Overlap(piece: TPiece; MaxCols, MaxRows: Integer): Boolean;
VAR c,i,j: Integer;
begin
  Result := true;

  if ((col < 0) OR (row < 0)) then Exit;
  if (col + MaxCols > FOwner.FieldWidth) then Exit;

  for i := 0 to Pred(MaxCols) do
    for j := 0 to Pred(MaxRows) do
      if (row + j < FOwner.FieldHeight) then
      begin
        c := piece[i,j];
        if ((c>0) AND (FOwner.pfmatrix[i+col,j+row]>0)) then Exit;
      end;
  Result := false;
end;

procedure TGamePiece.DropDown;
begin
  repeat
    Dec(row)
  until Overlap(cPiece, cMaxCols, cMaxRows);
  Inc(row);
  ConsolidatePiece();
  FOwner.Invalidate();
end;

procedure TGamePiece.StepDown;
begin
  Dec(row);
  if Overlap(cPiece, cMaxCols, cMaxRows) then
  begin
    Inc(row);
    ConsolidatePiece();
  end;
  FOwner.Invalidate();
end;

procedure TGamePiece.StepLeft;
begin
  Dec(col);
  if Overlap(cPiece, cMaxCols, cMaxRows) then
    Inc(col)
  else
    FOwner.Invalidate()
end;

procedure TGamePiece.StepRight;
begin
  Inc(col);
  if Overlap(cPiece, cMaxCols, cMaxRows) then
    Dec(col)
  else
    FOwner.Invalidate()
end;

procedure TGamePiece.ConsolidatePiece;
begin
  if FOwner.ConsolidatePiece(Self) then InitPiece()
end;

end.
