unit CheesyDice;
interface
uses
SysUtils, Classes, Dialogs;
type
TFillMaterial = (fmCheese, fmAir);
TDiceFilling =
record
material: TFillMaterial;
waterfilled: boolean;
end;
TCellCoords =
record
x: integer;
y: integer;
z: integer;
end;
TCheesyDice =
class
cells:
array of array of array of TDiceFilling;
p: double;
cheese_count: integer;
air_count: integer;
public
constructor Create(p: double);
function isWaterproof(): boolean;
private
function checkWay(i,j,k: integer): boolean;
end;
implementation
//-------------------------------------
// procedure TCheesyDice.Create();
// --
// Parameter:
// p: double = Wahrscheinlichkeit für Käse in x/100
// --
// Aufruf:
// Beim Erzeugen es Objekts von TCheesyDice
// --
// Zweck:
// Füllt ein 3D Array mit TFillMaterial
//-------------------------------------
constructor TCheesyDice.Create(p: double);
var
i,j,k: integer;
//Zählvariablen
zufall: double;
range: integer;
begin
self.p := p;
//Startwerte setzen
cheese_count := 0;
air_count := 0;
//Zufallsgenerator aktivieren
Randomize;
//Käsewürfel füllen
setLength(cells,20);
for i := 0
to 19
do
begin
setLength(cells[i],20);
for j := 0
to 19
do
begin
setLength(cells[i][j],20);
for k := 0
to 19
do
begin
cells[i][j][k].waterfilled := false;
//Noch kein Wasser
//Füllmaterial auswürfeln
zufall := random(999)+1;
if zufall <= p*1000
then
//Mit Käse füllen
begin
cells[i][j][k].material := fmCheese;
inc(cheese_count);
end
else
//Mit Luft füllen
begin
cells[i][j][k].material := fmAir;
inc(air_count);
end;
end;
end;
end;
end;
//-------------------------------------
// function TCheesyDice.checkWay(i,j,k: integer): boolean;
// --
// Parameter:
// i,j,k: Koordinaten der Ausgangszelle
// --
// Aufruf:
// Rekursiv
// --
// Zweck:
// Durchsucht einen Ast nach Durchgängen bis zum Boden
//-------------------------------------
function TCheesyDice.checkWay(i,j,k: integer): boolean;
var ergebnis: boolean;
begin
Result := false;
cells[i][j][k].waterfilled := true;
//Koordinaten beschreiben Ausgang?
//Ja
if (cells[i][j][k].material = fmAir)
// Material = Luft
AND (i = 19)
// UND Würfelunterseite
then
begin
Result := true;
//ShowMessage('Ausgang gefunden! Bei: ('+IntToStr(i)+'|'+IntToStr(j)+'|'+IntToStr(k)+')');
Exit;
end
//Nein -> Äste verfolgen
else
begin
// i-1
if i-1 >= 0
then
begin
if (cells[i-1][j][k].material = fmAir)
AND
(cells[i-1][j][k].waterfilled = false)
then
if checkWay(i-1,j,k) = true
then
begin
Result := true;
Exit;
end;
end;
// i+1
if i+1 <= 19
then
begin
if (cells[i+1][j][k].material = fmAir)
AND
(cells[i+1][j][k].waterfilled = false)
then
if checkWay(i+1,j,k) = true
then
begin
Result := true;
Exit;
end;
end;
// j-1
if j-1 >= 0
then
begin
if (cells[i][j-1][k].material = fmAir)
AND
(cells[i][j-1][k].waterfilled = false)
then
if checkWay(i,j-1,k) = true
then
begin
Result := true;
Exit;
end;
end;
// j+1
if j+1 <= 19
then
begin
if (cells[i][j+1][k].material = fmAir)
AND
(cells[i][j+1][k].waterfilled = false)
then
if checkWay(i,j+1,k) = true
then
begin
Result := true;
Exit;
end;
end;
// k-1
if k-1 >= 0
then
begin
if (cells[i][j][k-1].material = fmAir)
AND
(cells[i][j][k-1].waterfilled = false)
then
if checkWay(i,j,k-1) = true
then
begin
Result := true;
Exit;
end;
end;
// k+1
if k+1 <= 19
then
begin
if (cells[i][j][k+1].material = fmAir)
AND
(cells[i][j][k+1].waterfilled = false)
then
if checkWay(i,j,k+1) = true
then
begin
Result := true;
Exit;
end;
end;
end;
end;
//-------------------------------------
// function TCheesyDice.isWaterproof(): boolean;
// --
// Parameter:
// -keine-
// --
// Aufruf:
// Wenn überprüft werden soll ob der Würfel wasserdicht ist
// --
// Zweck:
// Startet checkWay von "jedem Loch" an der Würfeloberfläche
//-------------------------------------
function TCheesyDice.isWaterproof(): boolean;
var
i: integer;
begin
result := true;
for i := 0
to High(cells)
do
begin
if cells[i][0][0].material = fmAir
then
begin
if CheckWay(i,0,0) = true
then
begin
Result := false;
//Dann nicht wasserdicht
Exit;
end;
end;
end;
end;
end.