Subversion Repositories jumper

unit LevelFunctions;

interface

uses

  SysUtils, Dialogs, Functions, ExtCtrls, Graphics, Classes, Math;

type

  TFieldType = (ftFullSpace, ftHalfSpace, ftEmpty, ftRed, ftYellow, ftGreen);

  TFieldProperties = record

    Typ: TFieldType;

    Goal: Boolean;

  end;

  TGameMode = (gmUndefined, gmNormal, gmDiagonal);

  TLevelArray = array of array of TFieldProperties;

  TLevelError = (leNone, leInvalidElement, leEmptyBoard, leRowInvalidLength,

                 leUnsupportedVersion, leUnsupportedMode);

  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;

implementation

procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);

var

  LevelArray: TLevelArray;

  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 := Level.LevelStringToLevelArray(false);

  for y := Low(LevelArray) to High(LevelArray) do

  begin

    halftabs := 0;

    for x := Low(LevelArray[y]) to High(LevelArray[y]) do

    begin

      t := LevelArray[y][x].Typ;

      case t of

        ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;

        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[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,

                             (x-halftabs)*PREVIEW_BLOCK_SIZE + halftabs*PREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,

                             y*PREVIEW_BLOCK_SIZE                                        + PREVIEW_BLOCK_SIZE);

    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;

end;

{ TLevel }

const NUM_HEADERS = 2;

constructor TLevel.Create(ABoardFile: string);

begin

  inherited Create;

  FStringList := TStringList.Create;

  Load(ABoardFile);

end;

destructor TLevel.Destroy;

begin

  FreeAndNil(FStringList);

  inherited;

end;

function TLevel.GetGameMode: TGameMode;

begin

  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;

procedure TLevel.Load(ABoardFile: string);

var

  i: Integer;

begin

  FStringList.Clear;

  FStringList.LoadFromFile(ABoardFile);

  // Remove whitespaces and empty lines

  for i := FStringList.Count-1 downto NUM_HEADERS do

  begin

    FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]);

    if FStringList.Strings[i] = '' then FStringList.Delete(i);

  end;

end;

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

  // Zuerst nach Fehlern suchen

  err := CheckLevelIntegrity(ShowErrors);

  if err <> leNone then exit;

  // Längste Zeile finden

  longestLine := 0;

  for i := NUM_HEADERS to FStringList.Count-1 do

  begin

    longestLine := Max(longestLine, Length(FStringList.Strings[i]));

  end;

  // Nun Matrix aufbauen

  SetLength(result, 0);

  for i := NUM_HEADERS to FStringList.Count-1 do

  begin

    y := i - NUM_HEADERS;

    SetLength(result, Length(result)+1); // add line to matrix

    SetLength(result[y], longestLine);

    Line := FStringList.Strings[i];

    for x := 0 to LongestLine-1 do

    begin

      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;

      result[y][x].Typ := t;

      result[y][x].Goal := (ch = uch) and (ch <> lch);

    end;

  end;

end;

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;

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;

  // Check 1: Ist der Header OK?

  if LowerCase(FStringList.Strings[0]) <> 'version 2' then

  begin

    result := leUnsupportedVersion;

    exit;

  end;

  if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then

  begin

    result := leUnsupportedMode;

    exit;

  end;

  // Check 2: Ist das Brett leer?

  if FStringList.Count - NUM_HEADERS = 0 then

  begin

    result := leEmptyBoard;

    exit;

  end;

  // Check 3: Geht das Level nicht in einem Quadrat oder Rechteck auf?

  for i := NUM_HEADERS to FStringList.Count-1 do

  begin

    if Length(FStringList.Strings[i]) <> Length(FStringList.Strings[NUM_HEADERS]) then

    begin

      result := leRowInvalidLength; // at row y-NUM_HEADERS

      exit;

    end;

  end;

  // Check 4: Gibt es ungültige Elemente in den Zeilen?

  for i := NUM_HEADERS to FStringList.Count-1 do

  begin

    Line := FStringList.Strings[i];

    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]);

    if Length(Line) > 0 then

    begin

      result := leInvalidElement; // at row y-NUM_HEADERS

      Exit;

    end;

  end;

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