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