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

     Y: integer;
   end;
   TFieldType = (ftUndefined, ftFullSpace, ftEmpty, ftRed, ftYellow, ftGreen);
-  TFieldProperties = record
-    Typ: TFieldType;
-    Goal: Boolean;
-  end;
   TGameMode = (gmUndefined, gmNormal, gmDiagonal);
-  TRow = record
-    Indent: integer;
-    Fields: array of TFieldProperties;
-  end;
-  TLevelArray = array of TRow;
   TLevelError = (leUndefined, leNone, leInvalidElement, leEmptyBoard, leRowInvalidLength,
                  leUnsupportedVersion, leUnsupportedMode);
-  TLevel = class(TObject)
-  private
-    FStringList: TStringList;
-    procedure Load(ABoardFile: string);
-    function GetGameMode: TGameMode;
-  public
-    constructor Create(ABoardFile: string);
-    destructor Destroy; override;
-    function LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
-    function CheckLevelIntegrity: TLevelError; overload;
-    function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload;
-    property GameMode: TGameMode read GetGameMode;
-  end;
   TField = record
+    Indent: integer;
     FieldType: TFieldType;
     Goal: Boolean;
     Panel: TPanel;
     Stone: TImage;
   end;
   TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal);
-  TFieldState = (fsUndefined, fsError, fsLocked, fsAvailable, fsStone);
+  TFieldState = (fsUndefined, fsLocked, fsAvailable, fsOccupied);
   TPlayGroundMatrix = record
     Fields: array of array of TField;
   public
     procedure InitFieldArray(width, height: integer);
     function CloneMatrix: TPlayGroundMatrix;
     class function FieldState(t: TFieldType): TFieldState; overload; static;
     function FieldState(f: TField): TFieldState; overload;
     function FieldState(x, y: integer): TFieldState; overload;
     function CanJump(SourceX, SourceY, DestX, DestY: integer; DiagonalOK: boolean): boolean; overload;
+    function CanJump(Source, Dest: TCoord; DiagonalOK: boolean): boolean; overload;
     function CanJump(SourceX, SourceY: integer; DiagonalOK: boolean): boolean; overload;
+    function CanJump(Source: TCoord; DiagonalOK: boolean): boolean; overload;
     function CanJump(DiagonalOK: boolean): boolean; overload;
     function IndexToCoord(index: integer): TCoord;
     function CoordToIndex(coord: TCoord): integer; overload;
     function CoordToIndex(x, y: integer): integer; overload;
     function Width: integer;
     function Height: integer;
   end;
+  TLevel = class(TObject)
+  private
+    FStringList: TStringList;
+    procedure Load(ABoardFile: string);
+    function GetGameMode: TGameMode;
+  public
+    constructor Create(ABoardFile: string);
+    destructor Destroy; override;
+    procedure FillPlaygroundMatrix(var matrix: TPlayGroundMatrix; ShowErrors: boolean);
+    function CheckLevelIntegrity: TLevelError; overload;
+    function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload;
+    property GameMode: TGameMode read GetGameMode;
+  end;
 function FieldTypeWorth(t: TFieldType): integer;
 implementation
 function FieldTypeWorth(t: TFieldType): integer;
   SetLength(Fields, width, height);
   for x := Low(Fields) to High(Fields) do
   begin
     for y := Low(Fields[x]) to High(Fields[x]) do
     begin
-      Fields[x,y].FieldType := ftUndefined;
+      Fields[x,y].FieldType := ftUndefined
     end;
   end;
 end;
 function TPlayGroundMatrix.MatrixWorth: integer;
 function TPlayGroundMatrix.Width: integer;
 begin
   result := Length(Fields);
 end;
+function TPlayGroundMatrix.CanJump(Source: TCoord;
+  DiagonalOK: boolean): boolean;
+begin
+  result := CanJump(Source.X, Source.Y, DiagonalOK);
+end;
+function TPlayGroundMatrix.CanJump(Source, Dest: TCoord;
+  DiagonalOK: boolean): boolean;
+begin
+  result := CanJump(Source.X, Source.Y, Dest.X, Dest.Y, DiagonalOK);
+end;
 procedure TPlayGroundMatrix.ClearMatrix(FreeVCL: boolean);
 var
   x, y: integer;
 begin
+  if FreeVCL then
+  begin
-  for x := Low(Fields) to High(Fields) do
+    for x := Low(Fields) to High(Fields) do
-  begin
+    begin
-    for y := Low(Fields[x]) to High(Fields[x]) do
+      for y := Low(Fields[x]) to High(Fields[x]) do
-    begin
+      begin
-      if FreeVCL then
-      begin
         if Assigned(Fields[x,y].Stone) then Fields[x,y].Stone.Free;
         if Assigned(Fields[x,y].Panel) then Fields[x,y].Panel.Free;
       end;
     end;
   end;
     end;
   end;
 end;
 function TPlayGroundMatrix.CoordToIndex(x, y: integer): integer;
-var
-  c: TCoord;
 begin
-  c.X := x;
-  c.Y := y;
-  result := CoordToIndex(c);
+  result := x + y * Width;
 end;
 function TPlayGroundMatrix.CoordToIndex(coord: TCoord): integer;
 begin
-  result := coord.X + coord.Y * Width;
+  result := CoordToIndex(coord.X, coord.Y);
 end;
 class function TPlayGroundMatrix.FieldState(t: TFieldType): TFieldState;
 begin
-  result := fsError;
+  result := fsUndefined;
   case t of
     ftFullSpace: result := fsLocked;
     ftEmpty:     result := fsAvailable;
-    ftGreen:     result := fsStone;
+    ftGreen:     result := fsOccupied;
-    ftYellow:    result := fsStone;
+    ftYellow:    result := fsOccupied;
-    ftRed:       result := fsStone;
+    ftRed:       result := fsOccupied;
   end;
 end;
 function TPlayGroundMatrix.FieldState(f: TField): TFieldState;
 begin
   result := FieldState(f.FieldType);
 end;
 function TPlayGroundMatrix.FieldState(x, y: integer): TFieldState;
 begin
-  result := fsError;
+  result := fsUndefined;
   if (x < Low(Fields)) or (x > High(Fields)) then exit;
   if (y < Low(Fields[x])) or (y > High(Fields[x])) then exit;
   result := FieldState(Fields[x,y]);
 end;
   if FieldState(DestX, DestY) <> fsAvailable then exit;
   // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2?
   if DiagonalOK then
   begin
-    if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsStone) then result := true;
+    if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsOccupied) then result := true;
-    if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsStone) then result := true;
+    if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsOccupied) then result := true;
-    if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsStone) then result := true;
+    if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsOccupied) then result := true;
-    if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true;
+    if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsOccupied) then result := true;
   end;
-  if (SourceX+2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX+1, SourceY  ) = fsStone) then result := true;
+  if (SourceX+2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX+1, SourceY  ) = fsOccupied) then result := true;
-  if (SourceX-2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX-1, SourceY  ) = fsStone) then result := true;
+  if (SourceX-2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX-1, SourceY  ) = fsOccupied) then result := true;
-  if (SourceX   = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX  , SourceY+1) = fsStone) then result := true;
+  if (SourceX   = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX  , SourceY+1) = fsOccupied) then result := true;
-  if (SourceX   = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX  , SourceY-1) = fsStone) then result := true;
+  if (SourceX   = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX  , SourceY-1) = fsOccupied) then result := true;
 end;
 function TPlayGroundMatrix.CanJump(SourceX, SourceY: integer; DiagonalOK: boolean): boolean;
 begin
-  if FieldState(SourceX, SourceY) <> fsStone then
+  if FieldState(SourceX, SourceY) <> fsOccupied then
   begin
     result := false;
     exit;
   end;
     FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]);
     if FStringList.Strings[i] = '' then FStringList.Delete(i);
   end;
 end;
-function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
+procedure TLevel.FillPlaygroundMatrix(var matrix: TPlayGroundMatrix; ShowErrors: boolean);
 var
   i: integer;
   t: TFieldType;
   err: TLevelError;
   y: Integer;
   x: Integer;
   Line: string;
   lch, uch: char;
   ch: char;
+  width: Integer;
+  height: Integer;
+  lineIndent: Integer;
 begin
   // Zuerst nach Fehlern suchen
   err := CheckLevelIntegrity(ShowErrors);
   if err <> leNone then exit;
+  // Breite feststellen
+  if FStringList.Count > NUM_HEADERS then
+  begin
+    Line := FStringList.Strings[NUM_HEADERS];
+    Line := StringReplace(Line, '.', '', [rfReplaceAll]);
+    width := Length(Line);
+  end
+  else width := 0;
+  // Höhe feststellen
+  height := FStringList.Count - NUM_HEADERS;
   // Nun Matrix aufbauen
-  SetLength(result, 0);
+  matrix.ClearMatrix(true);
+  matrix.InitFieldArray(width, height);
   for i := NUM_HEADERS to FStringList.Count-1 do
   begin
     y := i - NUM_HEADERS;
-    SetLength(result, Length(result)+1); // add line to matrix
     Line := FStringList.Strings[i];
-    result[y].Indent := DotsAtBeginning(Line) - DotsAtEnd(Line);
+    lineIndent := DotsAtBeginning(Line) - DotsAtEnd(Line);
     Line := StringReplace(Line, '.', '', [rfReplaceAll]);
-    SetLength(result[y].Fields, Length(Line));
     for x := 0 to Length(Line)-1 do
     begin
       ch := Line[x+1];
       lch := LowerCase(ch)[1];
         'r': t := ftRed;
         'y': t := ftYellow;
         'g': t := ftGreen;
       end;
+      matrix.Fields[x,y].Indent := lineIndent;
-      result[y].Fields[x].Typ := t;
+      matrix.Fields[x,y].FieldType := t;
-      result[y].Fields[x].Goal := (ch = uch) and (ch <> lch);
+      matrix.Fields[x,y].Goal := (ch = uch) and (ch <> lch);
     end;
   end;
 end;
 function TLevel.CheckLevelIntegrity(ShowErrors: boolean): TLevelError;
   begin
     result := leUnsupportedVersion;
     exit;
   end;
+  if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and
-  if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then
+      (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then
   begin
     result := leUnsupportedMode;
     exit;
   end;
   for i := NUM_HEADERS to FStringList.Count-1 do
   begin
     thisLine := StringReplace(FStringList.Strings[i], '.', '', [rfReplaceAll]);
     if Length(thisLine) <> Length(firstLine) then
     begin
-      result := leRowInvalidLength; // at row y-NUM_HEADERS
+      result := leRowInvalidLength; // at row y = i-NUM_HEADERS
       exit;
     end;
   end;
   // Check 4: Gibt es ungültige Elemente in den Zeilen?
     Line := StringReplace(Line, 'g', '', [rfReplaceAll, rfIgnoreCase]);
     Line := StringReplace(Line, 'e', '', [rfReplaceAll, rfIgnoreCase]);
     if Length(Line) > 0 then
     begin
-      result := leInvalidElement; // at row y-NUM_HEADERS
+      result := leInvalidElement; // at row y = i-NUM_HEADERS
       Exit;
     end;
   end;
   // Check 5: Kann im Level gesprungen werden?

Subversion Repositories jumper

jumper/trunk/LevelFunctions.pas – Rev 23 → 24