unit uAppMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls;

type
  // Record für EIN Muster
  TMuster = record
    pattern : string;
  end;

  // Formular-Komponenten
  TAppMain = class(TForm)
    Shape1:  TShape; Shape2:  TShape; Shape3:  TShape; Shape4:  TShape; Shape5:  TShape;
    Shape6:  TShape; Shape7:  TShape; Shape8:  TShape; Shape9:  TShape; Shape10: TShape;
    Shape11: TShape; Shape12: TShape; Shape13: TShape; Shape14: TShape; Shape15: TShape;
    Shape16: TShape; Shape17: TShape; Shape18: TShape; Shape19: TShape; Shape20: TShape;
    Shape21: TShape; Shape22: TShape; Shape23: TShape; Shape24: TShape; Shape25: TShape;
    Shape26: TShape; Shape27: TShape; Shape28: TShape; Shape29: TShape; Shape30: TShape;
    Shape31: TShape; Shape32: TShape; Shape33: TShape; Shape34: TShape; Shape35: TShape;
    Shape36: TShape; Shape37: TShape; Shape38: TShape; Shape39: TShape; Shape40: TShape;
    ButtonEinsetzen: TSpeedButton;
    ButtonLinksSchieben: TSpeedButton;
    ButtonRechtsSchieben: TSpeedButton;
    ButtonRunter: TSpeedButton;
    ButtonRechtsDreh: TSpeedButton;
    ButtonNaechster: TSpeedButton;
    ButtonLinksDreh: TSpeedButton;
    Bevel1: TBevel; Bevel2: TBevel;
    ButtonReset: TBitBtn;
    Timer1: TTimer;
    // Button-Events
    procedure FormShow(Sender: TObject);
    procedure ButtonEinsetzenClick(Sender: TObject);
    procedure ButtonRechtsDrehClick(Sender: TObject);
    procedure ButtonRechtsSchiebenClick(Sender: TObject);
    procedure ButtonLinksSchiebenClick(Sender: TObject);
    procedure ButtonRunterClick(Sender: TObject);
    procedure ButtonNaechsterClick(Sender: TObject);
    procedure ButtonLinksDrehClick(Sender: TObject);
    procedure ButtonResetClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    // Private Variablen
    muster  : array [0..5] of TMuster;
    ausgabe : array [0..9,0..8] of byte;
    offset  : smallint;
    spalte  : byte;
    zeile   : byte;
    stein   : byte;
    modus   : byte;
    unten   : boolean;
    // Private Funktionen
    function  Simulation(): boolean;
    procedure SteinLoeschen();
    procedure SteinSetzen();
    procedure ZeigeFeld();
    procedure CreateMuster();
    function  PruefeZeileVoll( z: byte ): boolean;
    procedure PruefeAlle();
  end;

var
  // Init Form-Class
  AppMain: TAppMain;

implementation

{$R *.dfm}


// Alle Muster erzeugen ........................................................
procedure TAppMain.CreateMuster();
begin
  // Alle Pattern definieren
  muster[0].pattern := '010111000010011010000111010010110010';
  muster[1].pattern := '200200220000222200220020020000002222';
  muster[2].pattern := '330330000330330000330330000330330000';
  muster[3].pattern := '440044000040440400440044000040440400';
  muster[4].pattern := '050050050000555000050050050000555000';
  muster[5].pattern := '660600000660060000600660000060660000';
end;


// Automatismus beim Start .....................................................
procedure TAppMain.FormShow(Sender: TObject);
var
  z, s : byte;

begin
  // Muster initialiseren
  CreateMuster();

  // Ausgabe 1: Feld komplett = 9 für "Rand"
  for z := 0 to 9 do
      for s := 0 to 8 do
          Ausgabe[z,s] := 9;

  // Ausgabe 2: Das reine Spielfeld = 0
  for z := 0 to 7 do
      for s := 2 to 6 do
          Ausgabe[z,s] := 0;

  // Sonstige Inits
  offset := 0;
  spalte := 3;
  zeile  := 0;
  stein  := 0;
  modus  := 0;

  // Zeigen
  ZeigeFeld();
end;


// Stein abrufen und oben einsetzen ............................................
procedure TAppMain.ButtonEinsetzenClick(Sender: TObject);
begin
  // Modus Reset
  unten := FALSE;
  modus := 0;
  Timer1.Enabled := TRUE;
  // Geht überhaupt noch irgend etwas?
  if Simulation() = TRUE then
     begin
       SteinSetzen();
       ZeigeFeld();
     end
  else
     begin
       Timer1.Enabled := FALSE;
       ShowMessage( 'Game over' );
     end;
end;


// Stein nach links drehen ....................................................
procedure TAppMain.ButtonLinksDrehClick(Sender: TObject);
var
  tmpOff : byte;

begin
  // Aktuellen Offset sichern
  tmpOff := offset;

  // Für Simulation aktuelles Stein-Muster herausnehmen
  SteinLoeschen();

  // Offset zurückschalten
  offset := offset -1;
  if offset < 0 then offset := 3;

  // Neues Bild prüfen
  if Simulation() = FALSE then
     // Alles ohne Änderung auf Anfang
     offset := tmpOff;

  // Bild zeichnen, egal ob mit oder ohne Änderung
  SteinSetzen();
  ZeigeFeld();
end;


// Stein nach rechts drehen ....................................................
procedure TAppMain.ButtonRechtsDrehClick(Sender: TObject);
var
  tmpOff : byte;

begin
  // Aktuellen Offset sichern
  tmpOff := offset;

  // Für Simulation aktuelles Stein-Muster herausnehmen
  SteinLoeschen();

  // Offset weiterschalten
  offset := offset +1;
  if offset = 4 then offset := 0;

  // Neues Bild prüfen
  if Simulation() = FALSE then
     // Alles ohne Änderung auf Anfang
     offset := tmpOff;

  // Bild zeichnen, egal ob mit oder ohne Änderung
  SteinSetzen();
  ZeigeFeld();
end;


// Stein nach links schieben ...................................................
procedure TAppMain.ButtonLinksSchiebenClick(Sender: TObject);
var
  tmpSpalte : byte;

begin
  // Aktuelle Spalte sichern
  tmpSpalte := spalte;

  // Für Simulation aktuelles Stein-Muster herausnehmen
  SteinLoeschen();

  // Neue Spalte berechnen
  if spalte > 0 then spalte := spalte -1;

  // Neues Bild prüfen
  if Simulation() = FALSE then
     // Alles ohne Änderung auf Anfang
     spalte := tmpSpalte;

  // Bild zeichnen, egal ob mit oder ohne Änderung
  SteinSetzen();
  ZeigeFeld();
end;


// Nach rechts schieben ........................................................
procedure TAppMain.ButtonRechtsSchiebenClick(Sender: TObject);
var
  tmpSpalte : byte;

begin
  // Aktuelle Spalte sichern
  tmpSpalte := spalte;

  // Für Simulation aktuelles Stein-Muster herausnehmen
  SteinLoeschen();

  // Neue Spalte berechnen
  if spalte < 6 then spalte := spalte +1;

  // Neues Bild prüfen
  if Simulation() = FALSE then
     // Alles ohne Änderung auf Anfang
     spalte := tmpSpalte;

  // Bild zeichnen, egal ob mit oder ohne Änderung
  SteinSetzen();
  ZeigeFeld();
end;


// Stein eine Zeile tiefer ... (Button unsichtbar) .............................
procedure TAppMain.ButtonRunterClick(Sender: TObject);
var
  tmpZeile : byte;

begin
  // Aktuelle Zeile sichern
  tmpZeile := zeile;

  // Für Simulation aktuelles Stein-Muster herausnehmen
  SteinLoeschen();

  // Neue Zeile berechnen
  if zeile < 7 then zeile := zeile +1;

  // Neues Bild prüfen
  if Simulation() = FALSE then
     begin
       // Alles ohne Änderung auf Anfang
       zeile := tmpZeile;
       SteinSetzen();
       ZeigeFeld();
       Sleep(125);
       PruefeAlle();
       Sleep(125);
       ButtonNaechsterClick(Sender);
       ButtonEinsetzenClick(Sender);
     end
  else
     begin
       // Bild zeichnen, egal ob mit oder ohne Änderung
       SteinSetzen();
       ZeigeFeld();
     end;
end;


// Nächster Stein, alles wieder auf Anfang ... (Button unsichtbar) .............
procedure TAppMain.ButtonNaechsterClick(Sender: TObject);
begin
  stein  := stein +1;
  if stein = 6 then stein := 0;
  offset := 0;
  zeile  := 0;
  spalte := 3;
end;


// Stein einsetzen und Feld neu zeichnen .......................................
procedure TAppMain.SteinSetzen();
var
  z : byte;
  s : byte;
  i : byte;

begin
  i := 1;
  for z := zeile to zeile +2 do
      for s := spalte to spalte +2 do
          begin
            // Felder im aktuellen Block dürfen bestehende nicht überschreiben
            if muster[stein].pattern[offset *9 + i] <> '0' then
               ausgabe[z,s] := StrToInt( muster[stein].pattern[offset *9 + i] );
            i := i + 1;
          end;
end;


// Stein löschen ...............................................................
procedure TAppMain.SteinLoeschen();
var
  z : byte;
  s : byte;
  i : byte;

begin
  i := 1;
  for z := zeile to zeile +2 do
      for s := spalte to spalte +2 do
          begin
            // Fremde Pattern dürfen nicht gelöscht werden
            if muster[stein].pattern[offset *9 + i] <> '0' then
               ausgabe[z,s] := 0;
            i := i + 1;
          end;
end;


// Das Ausgabefeld darstellen, Steine und ihre Farben zeigen ...................
procedure TAppMain.ZeigeFeld();
var
  j          : byte;
  n          : byte;
  farbe      : TColor;
  feldIndex  : byte;

begin
  feldIndex := 0;
  for n := 0 to 7 do
      for j := 2 to 6 do
          begin
            // Farbe je "Pixel" feststellen
            case ausgabe[n,j] of
               1 : farbe := clAqua;
               2 : farbe := clLime;
               3 : farbe := clFuchsia;
               4 : farbe := clYellow;
               5 : farbe := clRed;
               6 : farbe := clSilver;
            else
               farbe := clWhite;
            end;
            // Shapes färben
            feldIndex := feldIndex +1;
            TShape( FindComponent( 'Shape' + IntToStr(feldIndex) ) ).Brush.Color := farbe;
          end;
end;


// Simulation "setzen/drehen/schieben/fallen" ob überhaupt möglich .............
function TAppMain.Simulation(): boolean;
var
  z, n, s  : byte;
  chkFigur : string;
  zielFeld : string;

begin
  // Erst mal generell "TRUE"
  RESULT := TRUE;

  // Muster nehmen
  chkFigur := '';
  for n := 1 to 9 do
      chkFigur := chkFigur + muster[stein].pattern[offset *9 +n];

  // Zielfeld lesen
  zielFeld := '';
  for z := zeile to zeile +2 do
      for s := spalte to spalte +2 do
          zielFeld := zielFeld + IntToStr(ausgabe[z,s]);

  // Ziel und Muster vergleichen; Falls Ziel NICHT frei dann meckern
  for n := 1 to 9 do
      if (chkFigur[n] <> '0') and (zielFeld[n] <> '0') then
         RESULT := FALSE;
end;


// Prüfe alle Zeilen von unten noch oben ob voll ...............................
procedure TAppMain.PruefeAlle();
var
  z : byte;

begin
  for z := 7 downto 0 do
      begin
        repeat
        until PruefeZeileVoll(z) = FALSE;
      end;
end;


// Prüft eine Zeile ob "voll" und entfernt ggf. diese Zeile ....................
function TAppMain.PruefeZeileVoll( z: byte ): boolean;
var
  s  : byte;
  zl : byte;

begin
  // Generell erst mal TRUE
  RESULT := TRUE;

  // Falls gewählte Zeile nicht entfernbar
  for s := 2 to 6 do
      if ausgabe[z,s] = 0 then
         // Hier nix möglich
         RESULT := FALSE;

  // Falls löschen möglich
  if RESULT = TRUE then
     begin
       // Kurz noch altuellen Stand zeigen
       ZeigeFeld();
       Application.Processmessages;
       Sleep(125);

       // Feld nach unten schieben
       for zl := z downto 1 do
           for s := 2 to 6 do
               ausgabe[zl,s] := ausgabe[zl-1,s];

       // Obere Zeile leer schreiben
       for s := 2 to 6 do
           ausgabe[0,s] := 0;

       // Neues Feld darstellen
       ZeigeFeld();
     end;
end;


// "Reset" nach "Game Over" ausführen ..........................................
procedure TAppMain.ButtonResetClick(Sender: TObject);
begin
  FormShow(Sender);
end;


// Timer-Ticker (auf 1,234 Sek. gestellt) ......................................
procedure TAppMain.Timer1Timer(Sender: TObject);
begin
  ButtonRunterClick(Sender);
end;

end.