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. |