unit a3_u;

interface

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

const quaderSize=20; //Größe vorgeben
type
  {$Z4}
  TField=(qfCheese,qfAir,qfWater); //Nögliche Felder
  TQuader=array[0..quaderSize,0..quaderSize,0..quaderSize] of TField; //Ein statischer Quader
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Edit2: TEdit;
    AnzeigenCheck: TCheckBox;
    PaintBox1: TPaintBox;
    Label3: TLabel;
    Label4: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    ProgressBar1: TProgressBar;
    statistikCheck: TCheckBox;
    Label5: TLabel;
    Edit5: TEdit;
    Button2: TButton;
    Label6: TLabel;
    Edit6: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
    procedure DrawQuader(const quad:TQuader); //Zeichnet den Quader
  end;

var
  Form1: TForm1;

implementation

uses a3_u2;

{$R *.DFM}
procedure InitializeQuader(out quad:TQuader; const p:double);
var x,y,z:integer;
begin
  for x:=0 to quaderSize-1 do
    for y:=0 to quaderSize-1 do
      for z:=0 to quaderSize-1 do
        if Random<p then quad[x,y,z]:=qfCheese //Jedem Feld einen zufälligen
        else quad[x,y,z]:=qfAir;               //Startwert geben
end;


function calculateWaterWay(var quad:TQuader):boolean;
type TPosition=record //Die Position eines Feldes im Würfel
       x,y,z:integer;
     end;

     //Der Stack in den die Positionen gefüllt werden
var stack:array[0..quaderSize*quaderSize*quaderSize-1] of TPosition;
    stackPos:integer;

   //Testen, ob das Feld ein Luftfeld ist und einfügen in den Stack
   procedure AddInToStack(const nx,ny,nz:integer);
   begin
     if quad[nx,ny,nz]=qfAir then begin
       quad[nx,ny,nz]:=qfWater;

       inc(stackpos);
       with stack[stackpos] do begin
         x:=nx;
         y:=ny;
         z:=nz;
       end;
     end;
   end;

var xi,yi:integer;
    pos:TPosition;
begin
  //Oberste Schicht einfügen
  stackPos:=-1;
  for xi:=0 to quaderSize-1 do
    for yi:=0 to quaderSize-1 do
      AddInToStack(xi,yi,0);

  //Jetzt den gesamten Stack durchlaufen
  Result:=true;
  while (stackPos>0)  do begin
    //Oberste Position rausholen
    pos:=stack[stackpos];
    dec(stackPos);
    with pos do begin
      //Wenn nicht am Rand versuchen, di Nachbarfelder einzufügen
      if (z>1) then AddInToStack(x,y,z-1); //nach oben am seltesten gehen

      if (x>0) then AddInToStack(x-1,y,z);
      if (x<quaderSize-1) then AddInToStack(x+1,y,z);

      if (y>0) then AddInToStack(x,y-1,z);
      if (y<quaderSize-1) then AddInToStack(x,y+1,z);

      //bevorzugt runter gehen
      if (z<>quaderSize-1) then AddInToStack(x,y,z+1) //Das aktuelle Feld ist
      else exit;  //Würfel ist nicht wasserdicht      ||nicht am unteren Rand
    end;
  end;
  Result:=false;
end;

//Zeichnet einen Quader, indem die unter und nebeneinander die Schichten
//ausgegeben werden
procedure TForm1.DrawQuader(const quad:TQuader);
var x,y,z:integer;
    px, py:integer;
    can:TCanvas;
begin
  can:=PaintBox1.canvas;
  can.pen.color:=clblack;
  for z:=0 to quaderSize-1 do begin
    //Oberste Ecken der Schicht berechnen
    px:=(z div 4)*145;
    py:=(z mod 4)*145;
    //Schicht durchlaufen
    for x:=0 to quaderSize-1 do
      for y:=0 to quaderSize-1 do begin
        case quad[x,y,z] of
          qfWater: can.brush.Color:=clAqua;    //Wasser blau
          qfCheese: can.brush.Color:=$0000C1CC;//Käse gelb
          else can.brush.Color:=clBtnFace;     //Luft unsichtbar
        end;
        can.Rectangle(px+x*7+2,py+y*7,px+x*7+7+2,py+y*7+7); //ein Feld ausgeben
      end;
  end;
end;

//Algorithmus aufrufen
procedure TForm1.Button1Click(Sender: TObject);
  //Die Rollen LED auf der Tastatur setzen
  procedure SetKeyBoardLED(const bool:boolean);
  var keyboard:TKeyboardState;
  begin
    GetKeyboardState(keyboard);
    keyboard[VK_SCROLL]:=byte(bool);
    SetKeyboardState(keyboard);
  end;
var quad:TQuader;                    //Der jeweilige Quader
    waterOpen,waterClose:integer;    //wieviele sind (un-)durchlässig
    i:integer;                       //for-Schleifenvariable
    quader:integer;                  //Anzahl von Würfel
    ok:boolean;                      //Würfel durchlässig
    p:double;                        //Wahrscheinlichkeit
    statistik,draw: boolean;         //Statistik erzeugen, Würfel zeichnen
    statAdd,statMax:double;          //p bis zu statMax um statAdd vergrößen
begin
  SetKeyBoardLED(false);                  //Licht aus
  draw:=AnzeigenCheck.Checked;                //Ausgeben?
  quader:=StrToInt(edit2.text);           //Würfelanzahl auslesen
  p:=StrToFloat(edit1.text);              //Wahrscheinlichkeit merken
  Randomize;                              //Zufallsgenerator initialisieren

  statistik:=statistikCheck.Checked;           //Statistik?
  if statistik then begin                 //Wenn Statistik:
    statAdd:= StrToFloat(edit5.text);       //Variablen setzen
    statMax:= StrToFloat(edit6.text);
  end else begin
    statAdd:= 1;
    statMax:= p;
  end;

  ProgressBar1.max:=quader*trunc((statMax-p)/statadd+1); //Fortschrittbalkenmaximum setzen
  ProgressBar1.Position:=0;

  while (p<=statMax) do begin        //Solange p nicht das Maximum erreicht hat
    waterOpen:=0;
    waterClose:=0;
    for i:=1 to quader do begin //edit2.text viele Würfel testen
      InitializeQuader(quad, p);     //Würfel initialisieren
      ok:=calculateWaterWay(quad);   //und auf Dichtheit testen

      if ok then inc(waterOpen)      //durchlässig
      else inc(waterClose);          //undurchlässig
      if draw then begin             //Wenn der Würfel gezeichnet werden soll
        if ok then begin             //Panel blau färben, wenn ok
          Panel1.Color:=clAqua;
          Panel2.Color:=clAqua;
        end else begin
          Panel1.Color:=clBtnFace;
          Panel2.Color:=clBtnFace;
        end;
        DrawQuader(quad);            //Würfel zeichnen
      end;
      if i and 127 = 0 then          //Nach jeweils 128 Würfel
        //Fortschritt ausgeben (!PATENT VERLETZUNG!)
        ProgressBar1.Position:=ProgressBar1.Position+128;
    end;
    ProgressBar1.Position:=ProgressBar1.Position+quader mod 128;

    //In das Log schreiben
    form2.memo1.Lines.add('p: '+FloatToStr(p)+ '  Wasserdurchlässige: '+
                                IntToStr(waterOpen)+ '  Wasserundurchlässige: '+
                                IntToStr(waterClose));

    //Noch mal das ganze mit um statAdd vergrößertem p
    p:=p+statAdd;
  end;
  edit3.text:=IntTOStr(waterOpen); //ausgeben wieviele dicht
  edit4.text:=IntTOStr(waterClose);//und undicht waren
  ProgressBar1.Position:=ProgressBar1.max; //Fortschrittbalken auf Maximum
  SetKeyBoardLED(true); //Fertig, jetzt kann die Erleuchtung folgen
end;

procedure TForm1.FormCreate(Sender: TObject);
var s:string;
begin
  s:=Edit1.text;    //Entweder .   oder ,  in die Zahl setzen
  s[2]:=DecimalSeparator;
  Edit1.text:=s;

  s:=Edit5.text;    //dito
  s[2]:=DecimalSeparator;
  Edit5.text:=s;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  form2.show; //log Form anzeigen
end;

end.
