Registriert seit: 9. Dez 2022
1 Beiträge
|
Wassersimulation 2D array
15. Dez 2022, 21:34
Moin Leute, ich hab für die Uni folgenden Quellcode geschrieben:
(Die SetConsolePosition hat mich komplett verrückt gemacht...in den TODO's steht auch was der Fehler im Programm ist. Aber ansonsten funktioniert das Programm Vielleicht kann mir ja jemand dabei helfen.)
// TODO: Ungültige Eingabe muss direkt zu der Fehlermeldung führen, nicht erst nach einem zweiten Enter.
// TODO: Nach ungültiger Eingabe muss die Position wieder auf die Position der
// ursprünglichen Eingabe gesetzt werden, alte Eingaben sollen verschwinden.
Delphi-Quellcode:
program Übung7;
// imca 105243
// Das Programm visualisiert eine einfache Wassersimulation
// mit der Möglichkeit Steine zu legen
uses
System.SysUtils,
Windows;
{$APPTYPE CONSOLE}
{$R+,Q+,X-}
const
// Konstante der Feldgröße
FIELDSIZE = 6;
type
// Teilbereichstyp für Breite und Höhe
TSize = 1 .. FIELDSIZE;
// Aufzählungstyp für die Zustände der Zellen
TState = (stLeer, stStein, stNeuesWasser, stWasser);
// 2D Array entsprechend dem Aufzählungstyp
TField = array [TSize, TSize] of TState;
// Setzt die Textfarbe der Konsole.
// @param
// color - zu setzender Farbwert
procedure setTextColor(color: word);
begin
if SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), color) then;
end;
// Setzt die Ausgabeposition der Konsole auf die angegebene Koordinate.
// @param
// x,y - zu setzende Position in der Konsole ab 0/0 = oben links
procedure setConsolePosition(x, y: byte);
var
coord: _COORD;
begin
coord.x := x;
coord.y := y;
if SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), coord) then;
end;
// Prozedur zum löschen der Ausgegenen Zeilen
// @ param zu löschende Zahl geht rein
procedure deleteZeilen(Zeile: integer);
var
x, y: integer;
begin
for y := 1 to Zeile do
for x := 1 to 80 do
write(' ');
end;
// initialisiert das Feld leer
// @param field geht rein wird verarbeitet
procedure initField(var field: TField);
var
x, y: TSize;
begin
// durchläuft alle Zellen des Feldes
for x := 1 to FIELDSIZE do
for y := 1 to FIELDSIZE do
// setzt das Feld auf leer
field[x, y] := stLeer;
end;
// Gibt das Feld in der Konsole aus
// @ field geht rein wird verarbeitet
procedure printField(field: TField);
var
x, y: TSize;
begin
setConsolePosition(0, 0);
// Durchlaufe alle Zellen des Feldes
for x := 1 to FIELDSIZE do
begin
for y := 1 to FIELDSIZE do
begin
// Gib das Symbol für den Zustand der aktuellen Zelle aus
case field[x, y] of
stLeer:
setTextColor(7);
stStein:
setTextColor(8);
stNeuesWasser:
setTextColor(9);
stWasser:
setTextColor(9);
end;
Write('▓');
end;
Writeln;
end;
setTextColor(7);
end;
// Prüft ob die Kooordinaten im gültigen Bereich liegen
// @ param Werte gehen rein
// // x,y - Koordinaten des Feldes
// @ return boolean wird wird ausgegeben
function isValidCoord(x, y: integer): boolean;
begin
// Prüfe, ob die Koordinaten innerhalb des Feldes liegen
if ((x >= 1) and (x <= FIELDSIZE)) and ((y >= 1) and (y <= FIELDSIZE)) then
isValidCoord := true
else
isValidCoord := false;
end;
// Prüft ob Feld frei ist
// @ param Werte gehen rein
// x,y - Koordinaten des Feldes und field
// @ return Boolean wert wird ausgegeben
function freeField(x, y: integer; field: TField): boolean;
begin
if field[x, y] = stLeer then
freeField := true
else
freeField := false;
end;
// Liest vom Benutzer Spalte und Zeile ein und validiert diese Eingaben.
// @param
// x,y - Koordinaten des Feldes
// cancel - beenden
// @return
// true, bei gültiger Eingabe
function readPos(var x, y: TSize; var cancel: boolean): boolean;
var
eingabe: string;
check: integer; // entweder 0 wenn nicht umwandelbar oder die Zahl
begin
Writeln('Bitte eine Spalte von 1 bis ', FIELDSIZE,
' eingeben oder ''x'' für Abbruch');
repeat
repeat // Prüft die X _Koordinate
cancel := false;
readln(eingabe);
val(eingabe, y, check);
if uppercase(eingabe) = 'X' then
cancel := true
else if not isValidCoord(y, FIELDSIZE) and (check <> 0) then
begin
setConsolePosition(0, FIELDSIZE + 5);
Writeln('Ungültige Eingabe');
setConsolePosition(0, FIELDSIZE + 1);
deleteZeilen(1);
setConsolePosition(0, FIELDSIZE + 1);
end
else
setConsolePosition(0, FIELDSIZE + 5);
deleteZeilen(1);
setConsolePosition(0, FIELDSIZE+ 2 );
until cancel or isValidCoord(y, FIELDSIZE);
// Prüft die Y Koordinate
if not cancel then
begin
Writeln('Bitte eine Zeile von 1 bis ', FIELDSIZE,
' eingeben oder ''x'' für Abbruch');
readln(eingabe);
setConsolePosition(0, FIELDSIZE + 1);
deleteZeilen(1);
val(eingabe, x, check);
if uppercase(eingabe) = 'X' then
cancel := true
else if not isValidCoord(x, FIELDSIZE) then
begin
setConsolePosition(0, FIELDSIZE + 5);
Writeln('Ungültige Eingabe');
setConsolePosition(0, FIELDSIZE + 1);
deleteZeilen(1);
setConsolePosition(0, FIELDSIZE + 2);
deleteZeilen(2);
end;
setConsolePosition(0, FIELDSIZE + 2);
deleteZeilen(4);
setConsolePosition(0, FIELDSIZE + 1);
end;
until cancel or isValidCoord(x, y);
readPos := isValidCoord(x, y);
setConsolePosition(0, FIELDSIZE+1 );
deleteZeilen(3);
end;
// Setzt die steine auf dem Feld
// @ param x,y Koordinaten gehen rein und field
//koordinaten werden auf Stein gesetzt
procedure setStone(x, y: TSize; var field: TField);
begin
// Setze den Stein für die entsprechende koordinate
field[x, y] := stStein;
end;
// Prüft, ob das gesamte Spielfeld voll ist
// @param
// field - Spielfeld
// @return
// true, wenn das Feld voll ist
function isFieldFull( field: TField): boolean;
var
x, y: byte;
fertig: boolean;
begin
fertig := true;
for x := low(TSize) to high(TSize) do
for y := low(TSize) to high(TSize) do
if (field[x, y] = stNeuesWasser) then
fertig := false;
isFieldFull := fertig;
end;
// setzt das erste Wasser auf das Spielfeld
//@ param x,y und field gehen rein
procedure setWater(x, y: TSize; var field: TField);
begin
field[x, y] := stWasser;
end;
// Wandelt das neue Wasser in ,,altes Wasser'' um
// @ param field geht rein
// das neue Wasser wird auf altes Wasser gesetzt
procedure convertWater(var field: TField);
var
x, y: TSize;
begin
// Durchlaufe alle Zellen des Feldes
for x := low(TSize) to high(TSize) do
for y := low(TSize) to high(TSize) do
if field[x, y] = stNeuesWasser then
field[x, y] := stWasser;
end;
// Flutet das Spielfeld mit Wasser
//@param field geht rein
// freie stellen werden geprüft und auf neuesWasser gesetzt
procedure floodField(var field: TField);
var
x, y: TSize;
begin
Sleep(1000);
repeat
// Durchlaufe alle Zellen des Feldes
convertWater(field);
for x := low(TSize) to high(TSize) do
for y := low(TSize) to high(TSize) do
// wenn field Wasser dann prüf ob leer ist
if field[x, y] = stWasser then
begin
if isValidCoord(x - 1, y) and (field[x - 1, y] = stLeer) then
field[x - 1, y] := stNeuesWasser;
if isValidCoord(x + 1, y) and (field[x + 1, y] = stLeer) then
field[x + 1, y] := stNeuesWasser;
if isValidCoord(x, y - 1) and (field[x, y - 1] = stLeer) then
field[x, y - 1] := stNeuesWasser;
if isValidCoord(x, y + 1) and (field[x, y + 1] = stLeer) then
field[x, y + 1] := stNeuesWasser;
end;
// Gib das Feld aus
printField(field);
// Pausiere das Programm für 1 Sekunde
Sleep(1000);
until isFieldFull(field);
end;
// -----------------------------Hauptprogramm------------------------------------
var
field: TField; // Variable vom array
x, y: TSize; // Variablen vom Teilbereichstyp
cancel : boolean;
begin
cancel := false;
initField(field);
printField(field);
repeat
if readPos(x, y, cancel) and freeField(x, y, field) then
begin
setStone(x, y, field);
printField(field);
end
else if not cancel then
Writeln('Positon belegt');
setConsolePosition(0, FIELDSIZE);
deleteZeilen(4);
setConsolePosition(0, FIELDSIZE);
until cancel;
repeat
cancel := false;
setConsolePosition(0, FIELDSIZE );
write('Wassereingabe. ');
if readPos(x, y, cancel) and freeField(x, y, field) then
begin
setWater(x, y, field);
printField(field);
cancel := true;
end
else if not cancel then
Writeln('Positon belegt');
setConsolePosition(0, FIELDSIZE+1);
deleteZeilen(4);
setConsolePosition(0, FIELDSIZE);
until cancel ;
floodField(field);
setConsolePosition(0, FIELDSIZE + 5);
setTextColor(7);
Writeln('Fertig!');
readln;
end.
Die SetConsolePosition hat mich komplett verrückt gemacht...in den TODO's steht auch was der Fehler im Programm ist. Aber ansonsten funktioniert das Programm Vielleicht kann mir ja jemand dabei helfen.
Geändert von Student2022 (16. Dez 2022 um 00:04 Uhr)
|