Subversion Repositories jumper

Compare Revisions

Regard whitespace Rev 10 → Rev 11

/trunk/LevelFunctions.pas
3,10 → 3,10
interface
 
uses
SysUtils, Dialogs, Functions, ExtCtrls, Graphics;
SysUtils, Dialogs, Functions, ExtCtrls, Graphics, Classes, Math;
 
type
TFieldType = (ftLocked, ftLockedWithTab, ftEmpty, ftGreen, ftYellow, ftRed);
TFieldType = (ftFullSpace, ftHalfSpace, ftEmpty, ftRed, ftYellow, ftGreen);
 
TFieldProperties = record
Typ: TFieldType;
13,71 → 13,57
Goal: Boolean;
end;
 
TLevelType = (ltStandard, ltDiagonal, ltError);
TGameMode = (gmUndefined, gmNormal, gmDiagonal);
 
TLevelArray = array of array of TFieldProperties;
 
TLevelError = (leNone, leInvalidElement, leNoIndicator, leMultipleIndicator,
leLevelIncomplete, leHeaderError, leInvalidGoal);
TLevelError = (leNone, leInvalidElement, leEmptyBoard, leRowInvalidLength,
leUnsupportedVersion, leUnsupportedMode);
 
procedure DrawLevelPreview(LevelString: string; Image: TImage; BackgroundColor: TColor);
function GetLevelType(LevelString: string): TLevelType;
function CheckLevelIntegrity(LevelString: string; ShowErrors: boolean): TLevelError; overload;
function CheckLevelIntegrity(LevelString: string): TLevelError; overload;
function LevelStringToLevelArray(LevelString: string; ShowErrors: boolean): TLevelArray;
TLevel = class(TObject)
private
FStringList: TStringList;
procedure Load(ABoardFile: string);
public
constructor Create(ABoardFile: string);
destructor Destroy; override;
function LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
function CheckLevelIntegrity: TLevelError; overload;
function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload;
function GetGameMode: TGameMode;
end;
 
procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
function FieldTypeWorth(t: TFieldType): integer;
 
var
AllowDiagonalMoves: boolean;
 
implementation
 
const
PREVIEW_BLOCK_SIZE = 10; // Enthält Field und Abstand
PREVIEW_TAB_SIZE = PREVIEW_BLOCK_SIZE div 2; // 5
HEADER_SIZE = 3;
ERED = '3';
EYEL = '2';
EGRE = '1';
ELOC = 'X';
EEMP = 'E';
EIND = '!';
ETAR = '>';
ESPE = '*';
TY_DIA = 'D';
TY_NOR = 'N';
 
resourcestring
LNG_LVL_INVALID_ELEMENT = 'Level invalid: There are invalid elements in the file.'+#13#10#13#10+'Valid elements are "1", "2", "3", "X", "*", "E" and ">" as goal prefix.';
LNG_LVL_INVALID_WIDTH = 'Level invalid: No width indicator ("!") found.';
LNG_LVL_INVALID_HEIGHT_MUTLIPLE = 'Level invalid: The level''s actual length is not a multiple of the width.';
LNG_LVL_INVALID_MULTIPLE_WIND = 'Level invalid: There are multiple width indicators ("!").';
LNG_LVL_INVALID_HEADER = 'Level invalid: The header is invalid. It does not match the structure "1(D|N)~".';
LNG_INVALID_GOAL = 'Level invalid: A goal does not point to a valid accessable element ("3", "2", "1" or "E").';
 
procedure DrawLevelPreview(LevelString: string; Image: TImage; BackgroundColor: TColor);
procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
var
LevelArray: TLevelArray;
i, j: integer;
y, x: integer;
t: TFieldType;
halftabs: integer;
const
PREVIEW_BLOCK_SIZE = 10; // Enthält Field und Abstand
PREVIEW_TAB_SIZE = PREVIEW_BLOCK_SIZE div 2; // 5
begin
LevelArray := nil;
 
ClearImage(Image, BackgroundColor);
 
LevelArray := LevelStringToLevelArray(LevelString, false);
LevelArray := Level.LevelStringToLevelArray(false);
 
for i := Low(LevelArray) to High(LevelArray) do
for y := Low(LevelArray) to High(LevelArray) do
begin
halftabs := 0;
for j := Low(LevelArray[i]) to High(LevelArray[i]) do
for x := Low(LevelArray[y]) to High(LevelArray[y]) do
begin
t := LevelArray[i][j].Typ;
t := LevelArray[y][x].Typ;
 
case t of
ftLocked: Image.Canvas.Brush.Color := BackgroundColor;
ftLockedWithTab: begin
ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;
ftHalfSpace: begin
Image.Canvas.Brush.Color := BackgroundColor;
inc(halftabs);
end;
87,231 → 73,215
ftRed: Image.Canvas.Brush.Color := clRed;
end;
 
if LevelArray[i][j].Goal then
if LevelArray[y][x].Goal then
Image.Canvas.Pen.Color := clBlack
else
Image.Canvas.Pen.Color := BackgroundColor;
 
Image.Canvas.Rectangle(j*PREVIEW_BLOCK_SIZE - halftabs*PREVIEW_TAB_SIZE, i*PREVIEW_BLOCK_SIZE, j*PREVIEW_BLOCK_SIZE - halftabs*PREVIEW_TAB_SIZE+PREVIEW_BLOCK_SIZE, i*PREVIEW_BLOCK_SIZE+PREVIEW_BLOCK_SIZE);
Image.Canvas.Rectangle((x-halftabs)*PREVIEW_BLOCK_SIZE + halftabs*PREVIEW_TAB_SIZE,
y*PREVIEW_BLOCK_SIZE,
(x-halftabs)*PREVIEW_BLOCK_SIZE + halftabs*PREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,
y*PREVIEW_BLOCK_SIZE + PREVIEW_BLOCK_SIZE);
end;
end;
end;
 
function GetLevelType(LevelString: string): TLevelType;
function FieldTypeWorth(t: TFieldType): integer;
begin
if CheckLevelIntegrity(LevelString) = leNone then
begin
if Copy(LevelString, 2, 1) = TY_DIA then
begin
result := ltDiagonal;
end
else // if Copy(LevelString, 2, 1) = TY_NOR
begin
result := ltStandard;
if t = ftGreen then result := 10
else if t = ftYellow then result := 20
else if t = ftRed then result := 30
else result := 0;
end;
end
else
 
{ TLevel }
 
const NUM_HEADERS = 2;
 
constructor TLevel.Create(ABoardFile: string);
begin
result := ltError;
inherited Create;
FStringList := TStringList.Create;
Load(ABoardFile);
end;
end;
 
procedure ShowErrorMessage(error: TLevelError);
destructor TLevel.Destroy;
begin
case error of
leNone: ;
leInvalidElement: MessageDlg(LNG_LVL_INVALID_ELEMENT, mtError, [mbOk], 0);
leNoIndicator: MessageDlg(LNG_LVL_INVALID_WIDTH, mtError, [mbOk], 0);
leMultipleIndicator: MessageDlg(LNG_LVL_INVALID_MULTIPLE_WIND, mtError, [mbOk], 0);
leLevelIncomplete: MessageDlg(LNG_LVL_INVALID_HEIGHT_MUTLIPLE, mtError, [mbOk], 0);
leHeaderError: MessageDlg(LNG_LVL_INVALID_HEADER, mtError, [mbOk], 0);
leInvalidGoal: MessageDlg(LNG_INVALID_GOAL, mtError, [mbOk], 0);
FreeAndNil(FStringList);
 
inherited;
end;
end;
 
function CheckLevelIntegrity(LevelString: string; ShowErrors: boolean): TLevelError;
function TLevel.GetGameMode: TGameMode;
begin
result := CheckLevelIntegrity(LevelString);
if ShowErrors then ShowErrorMessage(result);
if LowerCase(FStringList.Strings[1]) = 'mode: normal' then
result := gmNormal
else if LowerCase(FStringList.Strings[1]) = 'mode: diagonal' then
result := gmDiagonal
else
result := gmUndefined;
end;
 
function CheckLevelIntegrity(LevelString: string): TLevelError;
procedure TLevel.Load(ABoardFile: string);
var
W: integer;
H: extended;
header, h_ver, h_dia, h_del, tmp: string;
p: integer;
i: Integer;
begin
result := leNone;
FStringList.Clear;
FStringList.LoadFromFile(ABoardFile);
 
// Entfernt die Zeilenumbrüche
 
LevelString := RemoveLineBreaks(LevelString);
 
// Check 1: Ist der Header OK?
 
header := copy(LevelString, 1, HEADER_SIZE);
 
h_ver := copy(header, 1, 1);
if h_ver <> '1' then
// Remove whitespaces and empty lines
for i := FStringList.Count-1 downto NUM_HEADERS do
begin
result := leHeaderError;
Exit;
FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]);
if FStringList.Strings[i] = '' then FStringList.Delete(i);
end;
end;
 
h_dia := copy(header, 2, 1);
if (h_dia <> TY_DIA) and (h_dia <> TY_NOR) then
function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
var
i: integer;
t: TFieldType;
err: TLevelError;
longestLine: Integer;
thisLine: Integer;
y: Integer;
x: Integer;
Line: string;
lch, uch: char;
ch: char;
begin
result := leHeaderError;
Exit;
end;
// Zuerst nach Fehlern suchen
err := CheckLevelIntegrity(ShowErrors);
if err <> leNone then exit;
 
h_del := copy(header, 3, 1);
if h_del <> '~' then
// Längste Zeile finden
longestLine := 0;
for i := NUM_HEADERS to FStringList.Count-1 do
begin
result := leHeaderError;
Exit;
longestLine := Max(longestLine, Length(FStringList.Strings[i]));
end;
 
LevelString := copy(LevelString, HEADER_SIZE+1, Length(LevelString)-HEADER_SIZE);
// Nun Matrix aufbauen
SetLength(result, 0);
for i := NUM_HEADERS to FStringList.Count-1 do
begin
y := i - NUM_HEADERS;
 
// Check 2: Steht das ggf. vorhandenen ">" vor einem gültigen Feld 1, 2, 3, E?
SetLength(result, Length(result)+1); // add line to matrix
SetLength(result[y], longestLine);
 
p := Position(LevelString, ETAR);
Line := FStringList.Strings[i];
 
while (p <> -1) do
for x := 0 to LongestLine-1 do
begin
tmp := copy(LevelString, p+1, 1);
ch := Copy(Line,x+1,1)[1];
lch := LowerCase(ch)[1];
uch := UpperCase(ch)[1];
case lch of
'*': t := ftFullSpace;
'.': t := ftHalfSpace;
'e': t := ftEmpty;
'r': t := ftRed;
'y': t := ftYellow;
'g': t := ftGreen;
end;
 
if (tmp <> EEMP) and (tmp <> EGRE) and (tmp <> EYEL) and (tmp <> ERED) then
begin
result := leInvalidGoal;
Exit;
result[y][x].Typ := t;
result[y][x].Goal := (ch = uch) and (ch <> lch);
end;
end;
end;
 
LevelString := StringReplace(LevelString, ETAR, '', []); // Dieses Ziel entfernen
 
p := Position(LevelString, ETAR);
function TLevel.CheckLevelIntegrity(ShowErrors: boolean): TLevelError;
resourcestring
LNG_LVL_INVALID_ELEMENT = 'Level invalid: There are invalid elements in the file.'+#13#10#13#10+'Valid elements are r/R, y/Y, g/G, e/E, . and *.';
LNG_LVL_UNSUPPORTED_VERSION = 'Level format invalid: Version not supported.';
LNG_LVL_UNSUPPORTED_MODE = 'Level format invalid: Mode not supported.';
LNG_LVL_EMPTY_BOARD = 'Level invalid: Board is empty.';
LNG_LVL_INVALID_LENGTH = 'Level invalid: Lines don''t have an equal amount of elements.';
begin
result := CheckLevelIntegrity;
if ShowErrors then
begin
case result of
leNone: ;
leInvalidElement: MessageDlg(LNG_LVL_INVALID_ELEMENT, mtError, [mbOk], 0);
leUnsupportedVersion: MessageDlg(LNG_LVL_UNSUPPORTED_VERSION, mtError, [mbOk], 0);
leUnsupportedMode: MessageDlg(LNG_LVL_UNSUPPORTED_MODE, mtError, [mbOk], 0);
leEmptyBoard: MessageDlg(LNG_LVL_EMPTY_BOARD, mtError, [mbOk], 0);
leRowInvalidLength: MessageDlg(LNG_LVL_INVALID_LENGTH, mtError, [mbOk], 0);
end;
end;
end;
 
// Check 3: Kommt überhaupt ein "!" vor?
function TLevel.CheckLevelIntegrity: TLevelError;
var
W: integer;
H: extended;
header, h_ver, h_dia, h_del, tmp: string;
p: integer;
i: Integer;
Line: string;
begin
result := leNone;
 
W := Position(LevelString, EIND);
// Check 1: Ist der Header OK?
 
if W = -1 then
if LowerCase(FStringList.Strings[0]) <> 'version 2' then
begin
result := leNoIndicator;
Exit;
result := leUnsupportedVersion;
exit;
end;
 
// Check 4: Kam das "!" mehrmals vor?
 
LevelString := StringReplace(LevelString, EIND, '', []); // Das Erste entfernen
 
if Position(LevelString, EIND) <> -1 then // gibt es ein Zweites?
if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then
begin
result := leMultipleIndicator;
Exit;
result := leUnsupportedMode;
exit;
end;
 
// Check 5: Geht das Level nicht in einem Quadrat oder Rechteck auf?
// Check 2: Ist das Brett leer?
 
H := (Length(LevelString) - 1) / W;
 
if not Ganzzahlig(H) then
if FStringList.Count - NUM_HEADERS = 0 then
begin
result := leLevelIncomplete;
Exit;
result := leEmptyBoard;
exit;
end;
 
// Check 6: Gibt es ungültige Elemente im LevelString?
// Check 3: Geht das Level nicht in einem Quadrat oder Rechteck auf?
 
LevelString := StringReplace(LevelString, ESPE, '', [rfReplaceAll]);
LevelString := StringReplace(LevelString, ELOC, '', [rfReplaceAll]);
LevelString := StringReplace(LevelString, EEMP, '', [rfReplaceAll]);
LevelString := StringReplace(LevelString, EGRE, '', [rfReplaceAll]);
LevelString := StringReplace(LevelString, EYEL, '', [rfReplaceAll]);
LevelString := StringReplace(LevelString, ERED, '', [rfReplaceAll]);
 
if Length(LevelString) > 0 then
for i := NUM_HEADERS to FStringList.Count-1 do
begin
result := leInvalidElement;
Exit;
if Length(FStringList.Strings[i]) <> Length(FStringList.Strings[NUM_HEADERS]) then
begin
result := leRowInvalidLength; // at row y-NUM_HEADERS
exit;
end;
end;
 
// Check 7: Kann im Level gesprungen werden
// Check 4: Gibt es ungültige Elemente in den Zeilen?
 
{ Wird hier nicht abgeprüft, da dafür zuerst der PlayGround gebaut sein muss.
Es ist außerdem eher ein logischer Fehler, kein Fehler in der Levelstruktur! }
end;
 
function LevelStringToLevelArray(LevelString: string; ShowErrors: boolean): TLevelArray;
var
i, j, j_dec, c: integer;
m: string;
t: TFieldType;
W, H: integer;
err: TLevelError;
NextIsGoal: boolean;
for i := NUM_HEADERS to FStringList.Count-1 do
begin
// Zuerst nach Fehlern suchen
err := CheckLevelIntegrity(LevelString, ShowErrors);
if err <> leNone then exit;
Line := FStringList.Strings[i];
 
// Headerinformationen auslesen
AllowDiagonalMoves := copy(LevelString, 2, 1) = TY_DIA;
Line := StringReplace(Line, '.', '', [rfReplaceAll]);
Line := StringReplace(Line, '*', '', [rfReplaceAll]);
Line := StringReplace(Line, 'r', '', [rfReplaceAll, rfIgnoreCase]);
Line := StringReplace(Line, 'y', '', [rfReplaceAll, rfIgnoreCase]);
Line := StringReplace(Line, 'g', '', [rfReplaceAll, rfIgnoreCase]);
Line := StringReplace(Line, 'e', '', [rfReplaceAll, rfIgnoreCase]);
 
// Header entfernen
LevelString := copy(LevelString, HEADER_SIZE+1, Length(LevelString)-HEADER_SIZE);
 
// Entfernt die Zeilenumbrüche
LevelString := RemoveLineBreaks(LevelString);
 
// Dimensionen abmessen
W := Position(StringReplace(LevelString, ETAR, '', [rfReplaceAll]), EIND) - 1;
LevelString := StringReplace(LevelString, EIND, '', [rfReplaceAll]);
H := Length(LevelString) div W;
 
c := 1;
NextIsGoal := false;
 
SetLength(result, round(H));
for i := Low(result) to High(result) do
if Length(Line) > 0 then
begin
j_dec := 0;
SetLength(result[i], round(W));
for j := Low(result[i]) to High(result[i])+1 do // +1 wegen dem möglichen zusätzlichem ">"
begin
if (j = High(result[i])+1) and (j_dec = 0) then break;
m := Copy(LevelString, c, 1);
if m = ETAR then
begin
NextIsGoal := true;
inc(j_dec);
end
else
begin
if m = EEMP then t := ftEmpty
else if m = EGRE then t := ftGreen
else if m = EYEL then t := ftYellow
else if m = ERED then t := ftRed
else if m = ESPE then t := ftLockedWithTab
else t := ftLocked;
result[i][j-j_dec].Typ := t;
result[i][j-j_dec].Goal := NextIsGoal;
if NextIsGoal then NextIsGoal := false;
result := leInvalidElement; // at row y-NUM_HEADERS
Exit;
end;
inc(c);
end;
end;
end;
 
function FieldTypeWorth(t: TFieldType): integer;
begin
if t = ftGreen then result := 10
else if t = ftYellow then result := 20
else if t = ftRed then result := 30
else result := 0;
// Check 5: Kann im Level gesprungen werden
 
{ Wird hier nicht abgeprüft, da dafür zuerst der PlayGround gebaut sein muss.
Es ist außerdem eher ein logischer Fehler, kein Fehler in der Levelstruktur! }
end;
 
end.