WebSVN – jumper – Diff – /trunk/LevelFunctions.pas

 unit LevelFunctions;
 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;
     Goal: Boolean;
   end;
-  TLevelType = (ltStandard, ltDiagonal, ltError);
+  TGameMode = (gmUndefined, gmNormal, gmDiagonal);
   TLevelArray = array of array of TFieldProperties;
-  TLevelError = (leNone, leInvalidElement, leNoIndicator, leMultipleIndicator,
+  TLevelError = (leNone, leInvalidElement, leEmptyBoard, leRowInvalidLength,
-                 leLevelIncomplete, leHeaderError, leInvalidGoal);
+                 leUnsupportedVersion, leUnsupportedMode);
+  TLevel = class(TObject)
+  private
+    FStringList: TStringList;
-procedure DrawLevelPreview(LevelString: string; Image: TImage; BackgroundColor: TColor);
+    procedure Load(ABoardFile: string);
+  public
-function GetLevelType(LevelString: string): TLevelType;
+    constructor Create(ABoardFile: string);
+    destructor Destroy; override;
-function CheckLevelIntegrity(LevelString: string; ShowErrors: boolean): TLevelError; overload;
+    function LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
-function CheckLevelIntegrity(LevelString: string): TLevelError; overload;
+    function CheckLevelIntegrity: TLevelError; overload;
-function LevelStringToLevelArray(LevelString: string; ShowErrors: boolean): TLevelArray;
+    function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload;
-function FieldTypeWorth(t: TFieldType): integer;
+    function GetGameMode: TGameMode;
+  end;
-var
+procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
-  AllowDiagonalMoves: boolean;
+function FieldTypeWorth(t: TFieldType): integer;
 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;
+        ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;
-        ftLockedWithTab: begin
+        ftHalfSpace: begin
           Image.Canvas.Brush.Color := BackgroundColor;
           inc(halftabs);
         end;
         ftEmpty: Image.Canvas.Brush.Color := clWhite;
         ftGreen: Image.Canvas.Brush.Color := clLime;
         ftYellow: Image.Canvas.Brush.Color := clYellow;
         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((x-halftabs)*PREVIEW_BLOCK_SIZE + halftabs*PREVIEW_TAB_SIZE,
+                             y*PREVIEW_BLOCK_SIZE,
-      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);
+                             (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
+begin
+  if t = ftGreen then result := 10
+  else if t = ftYellow then result := 20
+  else if t = ftRed then result := 30
-      result := ltStandard;
+  else result := 0;
-    end;
+end;
-  end
-  else
+{ TLevel }
+const NUM_HEADERS = 2;
+constructor TLevel.Create(ABoardFile: string);
-  begin
+begin
-    result := ltError;
+  inherited Create;
+  FStringList := TStringList.Create;
-  end;
+  Load(ABoardFile);
 end;
-procedure ShowErrorMessage(error: TLevelError);
+destructor TLevel.Destroy;
 begin
-  case error of
+  FreeAndNil(FStringList);
-    leNone: ;
+  inherited;
-    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);
-  end;
 end;
-function CheckLevelIntegrity(LevelString: string; ShowErrors: boolean): TLevelError;
+function TLevel.GetGameMode: TGameMode;
 begin
+  if LowerCase(FStringList.Strings[1]) = 'mode: normal' then
-  result := CheckLevelIntegrity(LevelString);
+    result := gmNormal
-  if ShowErrors then ShowErrorMessage(result);
+  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;
+  i: Integer;
-  H: extended;
-  header, h_ver, h_dia, h_del, tmp: string;
-  p: integer;
 begin
-  result := leNone;
+  FStringList.Clear;
-  // Entfernt die Zeilenumbrüche
+  FStringList.LoadFromFile(ABoardFile);
-  LevelString := RemoveLineBreaks(LevelString);
-  // Check 1: Ist der Header OK?
+  // Remove whitespaces and empty lines
-  header := copy(LevelString, 1, HEADER_SIZE);
+  for i := FStringList.Count-1 downto NUM_HEADERS do
-  h_ver := copy(header, 1, 1);
-  if h_ver <> '1' then
   begin
+    FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]);
-    result := leHeaderError;
+    if FStringList.Strings[i] = '' then FStringList.Delete(i);
-    Exit;
+  end;
-  end;
+end;
+function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
+var
+  i: integer;
+  t: TFieldType;
+  err: TLevelError;
+  longestLine: Integer;
-  h_dia := copy(header, 2, 1);
+  thisLine: Integer;
+  y: Integer;
+  x: Integer;
+  Line: string;
-  if (h_dia <> TY_DIA) and (h_dia <> TY_NOR) then
+  lch, uch: char;
+  ch: char;
-  begin
+begin
-    result := leHeaderError;
+  // Zuerst nach Fehlern suchen
-    Exit;
+  err := CheckLevelIntegrity(ShowErrors);
-  end;
+  if err <> leNone then exit;
-  h_del := copy(header, 3, 1);
+  // Längste Zeile finden
-  if h_del <> '~' then
+  longestLine := 0;
+  for i := NUM_HEADERS to FStringList.Count-1 do
   begin
-    result := leHeaderError;
+    longestLine := Max(longestLine, Length(FStringList.Strings[i]));
-    Exit;
   end;
+  // Nun Matrix aufbauen
+  SetLength(result, 0);
-  LevelString := copy(LevelString, HEADER_SIZE+1, Length(LevelString)-HEADER_SIZE);
+  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
+    begin
-    tmp := copy(LevelString, p+1, 1);
+      ch := Copy(Line,x+1,1)[1];
+      lch := LowerCase(ch)[1];
-    if (tmp <> EEMP) and (tmp <> EGRE) and (tmp <> EYEL) and (tmp <> ERED) then
+      uch := UpperCase(ch)[1];
-    begin
+      case lch of
+        '*': t := ftFullSpace;
-      result := leInvalidGoal;
+        '.': t := ftHalfSpace;
+        'e': t := ftEmpty;
-      Exit;
+        'r': t := ftRed;
+        'y': t := ftYellow;
+        'g': t := ftGreen;
-    end;
+      end;
+      result[y][x].Typ := t;
-    LevelString := StringReplace(LevelString, ETAR, '', []); // Dieses Ziel entfernen
+      result[y][x].Goal := (ch = uch) and (ch <> lch);
+    end;
-    p := Position(LevelString, ETAR);
+  end;
-  end;
+end;
-  // Check 3: Kommt überhaupt ein "!" vor?
+function TLevel.CheckLevelIntegrity(ShowErrors: boolean): TLevelError;
-  W := Position(LevelString, EIND);
+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.';
-  if W = -1 then
+  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
+begin
-    result := leNoIndicator;
+  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);
-    Exit;
+    end;
+  end;
-  end;
+end;
+function TLevel.CheckLevelIntegrity: TLevelError;
+var
+  W: integer;
+  H: extended;
-  // Check 4: Kam das "!" mehrmals vor?
+  header, h_ver, h_dia, h_del, tmp: string;
+  p: integer;
+  i: Integer;
+  Line: string;
+begin
+  result := leNone;
-  LevelString := StringReplace(LevelString, EIND, '', []); // Das Erste entfernen
+  // Check 1: Ist der Header OK?
-  if Position(LevelString, EIND) <> -1 then // gibt es ein Zweites?
+  if LowerCase(FStringList.Strings[0]) <> 'version 2' then
   begin
-    result := leMultipleIndicator;
+    result := leUnsupportedVersion;
-    Exit;
+    exit;
   end;
-  // Check 5: Geht das Level nicht in einem Quadrat oder Rechteck auf?
+  if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then
-  H := (Length(LevelString) - 1) / W;
-  if not Ganzzahlig(H) then
   begin
-    result := leLevelIncomplete;
+    result := leUnsupportedMode;
-    Exit;
+    exit;
   end;
-  // Check 6: Gibt es ungültige Elemente im LevelString?
+  // Check 2: Ist das Brett leer?
-  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
+  if FStringList.Count - NUM_HEADERS = 0 then
   begin
-    result := leInvalidElement;
+    result := leEmptyBoard;
-    Exit;
+    exit;
   end;
-  // Check 7: Kann im Level gesprungen werden
+  // Check 3: Geht das Level nicht in einem Quadrat oder Rechteck auf?
-  { 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;
+  for i := NUM_HEADERS to FStringList.Count-1 do
-  m: string;
-  t: TFieldType;
-  W, H: integer;
-  err: TLevelError;
-  NextIsGoal: boolean;
-begin
+  begin
+    if Length(FStringList.Strings[i]) <> Length(FStringList.Strings[NUM_HEADERS]) then
-  // Zuerst nach Fehlern suchen
+    begin
-  err := CheckLevelIntegrity(LevelString, ShowErrors);
+      result := leRowInvalidLength; // at row y-NUM_HEADERS
-  if err <> leNone then exit;
+      exit;
-  // Headerinformationen auslesen
+    end;
-  AllowDiagonalMoves := copy(LevelString, 2, 1) = TY_DIA;
-  // Header entfernen
+  end;
-  LevelString := copy(LevelString, HEADER_SIZE+1, Length(LevelString)-HEADER_SIZE);
-  // Entfernt die Zeilenumbrüche
-  LevelString := RemoveLineBreaks(LevelString);
+  // Check 4: Gibt es ungültige Elemente in den Zeilen?
-  // Dimensionen abmessen
-  W := Position(StringReplace(LevelString, ETAR, '', [rfReplaceAll]), EIND) - 1;
-  LevelString := StringReplace(LevelString, EIND, '', [rfReplaceAll]);
+  for i := NUM_HEADERS to FStringList.Count-1 do
+  begin
-  H := Length(LevelString) div W;
+    Line := FStringList.Strings[i];
-  c := 1;
+    Line := StringReplace(Line, '.', '', [rfReplaceAll]);
-  NextIsGoal := false;
+    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]);
-  SetLength(result, round(H));
-  for i := Low(result) to High(result) do
-  begin
-    j_dec := 0;
-    SetLength(result[i], round(W));
+    if Length(Line) > 0 then
-    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
+    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
+      result := leInvalidElement; // at row y-NUM_HEADERS
-        else t := ftLocked;
-        result[i][j-j_dec].Typ := t;
-        result[i][j-j_dec].Goal := NextIsGoal;
-        if NextIsGoal then NextIsGoal := false;
-      end;
+      Exit;
-      inc(c);
-    end;
-  end;
+    end;
-end;
+  end;
-function FieldTypeWorth(t: TFieldType): integer;
+  // Check 5: Kann im Level gesprungen werden
-begin
-  if t = ftGreen then result := 10
-  else if t = ftYellow then result := 20
+  { Wird hier nicht abgeprüft, da dafür zuerst der PlayGround gebaut sein muss.
-  else if t = ftRed then result := 30
+    Es ist außerdem eher ein logischer Fehler, kein Fehler in der Levelstruktur! }
-  else result := 0;
 end;
 end.

Subversion Repositories jumper

jumper/trunk/LevelFunctions.pas – Rev 9 → 11