Subversion Repositories jumper

Rev

Rev 19 | Rev 22 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 19 Rev 21
Line 1... Line 1...
1 
unit LevelFunctions;
 1 
unit LevelFunctions;
2 
 
 2 
 
3 
interface
 3 
interface
4 
 
 4 
 
5 
uses
 5 
uses
6 
  SysUtils, Dialogs, Functions, ExtCtrls, Graphics, Classes, Math;
 6 
  SysUtils, Dialogs, Functions, ExtCtrls, Classes, Math;
7 
 
 7 
 
8 
type
 8 
type
9 
  TFieldType = (ftUndefined, ftFullSpace, ftEmpty, ftRed, ftYellow, ftGreen);
 9 
  TFieldType = (ftUndefined, ftFullSpace, ftEmpty, ftRed, ftYellow, ftGreen);
10 
 
 10 
 
11 
  TFieldProperties = record
 11 
  TFieldProperties = record
Line 35... Line 35...
35 
    function CheckLevelIntegrity: TLevelError; overload;
 35 
    function CheckLevelIntegrity: TLevelError; overload;
36 
    function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload;
 36 
    function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload;
37 
    function GetGameMode: TGameMode;
 37 
    function GetGameMode: TGameMode;
38 
  end;
 38 
  end;
39 
 
 39 
 
- 
 
 40 
  TField = record
- 
 
 41 
    FieldType: TFieldType;
- 
 
 42 
    Goal: Boolean;
- 
 
 43 
    Panel: TPanel;
- 
 
 44 
    Stone: TImage;
- 
 
 45 
  end;
- 
 
 46 
 
- 
 
 47 
  TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal);
- 
 
 48 
 
- 
 
 49 
  TFieldState = (fsUndefined, fsError, fsLocked, fsAvailable, fsStone);
- 
 
 50 
 
- 
 
 51 
  TPlayGroundMatrix = record
- 
 
 52 
    Fields: array of array of TField;
- 
 
 53 
  public
- 
 
 54 
    function MatrixHasGoal: boolean;
- 
 
 55 
    function GoalFieldType: TFieldType;
- 
 
 56 
    function MatrixWorth: integer;
- 
 
 57 
    procedure ClearMatrix(FreeVCL: boolean);
- 
 
 58 
    function CloneMatrix: TPlayGroundMatrix;
40 
procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
 59 
    function FieldState(t: TFieldType): TFieldState; overload;
- 
 
 60 
    function FieldState(f: TField): TFieldState; overload;
- 
 
 61 
    function FieldState(x, y: integer): TFieldState; overload;
- 
 
 62 
  end;
- 
 
 63 
 
41 
function FieldTypeWorth(t: TFieldType): integer;
 64 
function FieldTypeWorth(t: TFieldType): integer;
42 
 
 65 
 
43 
implementation
 66 
implementation
44 
 
 67 
 
45 
procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
 - 
 
46 
var
 - 
 
47 
  LevelArray: TLevelArray;
 - 
 
48 
  y, x: integer;
 - 
 
49 
  t: TFieldType;
 - 
 
50 
  indent: Integer;
 - 
 
51 
const
 - 
 
52 
  PREVIEW_BLOCK_SIZE = 10; // Enthält Field und Abstand
 68 
function FieldTypeWorth(t: TFieldType): integer;
53 
  PREVIEW_TAB_SIZE = PREVIEW_BLOCK_SIZE div 2; // 5
 - 
 
54 
begin
 69 
begin
- 
 
 70 
  if t = ftGreen then result := 10
- 
 
 71 
  else if t = ftYellow then result := 20
- 
 
 72 
  else if t = ftRed then result := 30
55 
  LevelArray := nil;
 73 
  else result := 0;
- 
 
 74 
end;
56 
 
 75 
 
57 
  ClearImage(Image, BackgroundColor);
 76 
{ TPlayGroundMatrix }
58 
 
 77 
 
- 
 
 78 
function TPlayGroundMatrix.MatrixHasGoal: boolean;
- 
 
 79 
var
- 
 
 80 
  i, j: integer;
- 
 
 81 
begin
- 
 
 82 
  result := false;
- 
 
 83 
  for i := Low(Fields) to High(Fields) do
- 
 
 84 
  begin
59 
  LevelArray := Level.LevelStringToLevelArray(false);
 85 
    for j := Low(Fields[i]) to High(Fields[i]) do
- 
 
 86 
    begin
- 
 
 87 
      result := result or Fields[i][j].Goal;
- 
 
 88 
    end;
- 
 
 89 
  end;
- 
 
 90 
end;
60 
 
 91 
 
61 
  for y := Low(LevelArray) to High(LevelArray) do
 92 
function TPlayGroundMatrix.GoalFieldType: TFieldType;
- 
 
 93 
var
- 
 
 94 
  i, j: integer;
62 
  begin
 95 
begin
- 
 
 96 
  result := ftEmpty; // Damit der Compiler nicht meckert
63 
    for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
 97 
  for i := Low(Fields) to High(Fields) do
64 
    begin
 98 
  begin
65 
      t      := LevelArray[y].Fields[x].Typ;
 99 
    for j := Low(Fields[i]) to High(Fields[i]) do
- 
 
 100 
    begin
66 
      indent := LevelArray[y].Indent;
 101 
      if Fields[i][j].Goal then result := Fields[i][j].FieldType
- 
 
 102 
    end;
- 
 
 103 
  end;
- 
 
 104 
end;
67 
 
 105 
 
- 
 
 106 
function TPlayGroundMatrix.MatrixWorth: integer;
- 
 
 107 
var
68 
      case t of
 108 
  i, j: integer;
- 
 
 109 
begin
69 
        ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;
 110 
  result := 0;
70 
        ftEmpty:     Image.Canvas.Brush.Color := clWhite;
 111 
  for i := Low(Fields) to High(Fields) do
- 
 
 112 
  begin
71 
        ftGreen:     Image.Canvas.Brush.Color := clLime;
 113 
    for j := Low(Fields[i]) to High(Fields[i]) do
- 
 
 114 
    begin
72 
        ftYellow:    Image.Canvas.Brush.Color := clYellow;
 115 
      Inc(result, FieldTypeWorth(Fields[i][j].FieldType));
73 
        ftRed:       Image.Canvas.Brush.Color := clRed;
 116 
    end;
- 
 
 117 
  end;
74 
      end;
 118 
end;
75 
 
 119 
 
- 
 
 120 
procedure TPlayGroundMatrix.ClearMatrix(FreeVCL: boolean);
- 
 
 121 
var
- 
 
 122 
  i, j: integer;
- 
 
 123 
begin
76 
      if LevelArray[y].Fields[x].Goal then
 124 
  for i := Low(Fields) to High(Fields) do
- 
 
 125 
  begin
77 
        Image.Canvas.Pen.Color := clBlack
 126 
    for j := Low(Fields[i]) to High(Fields[i]) do
- 
 
 127 
    begin
- 
 
 128 
      if FreeVCL then
78 
      else
 129 
      begin
- 
 
 130 
        if Assigned(Fields[i][j].Stone) then Fields[i][j].Stone.Free;
79 
        Image.Canvas.Pen.Color := BackgroundColor;
 131 
        if Assigned(Fields[i][j].Panel) then Fields[i][j].Panel.Free;
- 
 
 132 
      end;
- 
 
 133 
    end;
- 
 
 134 
    SetLength(Fields[i], 0);
- 
 
 135 
  end;
- 
 
 136 
  SetLength(Fields, 0);
- 
 
 137 
end;
80 
 
 138 
 
- 
 
 139 
function TPlayGroundMatrix.CloneMatrix: TPlayGroundMatrix;
- 
 
 140 
var
- 
 
 141 
  i, j: integer;
- 
 
 142 
begin
- 
 
 143 
  SetLength(result.Fields, Length(Fields));
- 
 
 144 
  for i := Low(Fields) to High(Fields) do
- 
 
 145 
  begin
- 
 
 146 
    SetLength(result.Fields[i], Length(Fields[i]));
- 
 
 147 
    for j := Low(Fields[i]) to High(Fields[i]) do
- 
 
 148 
    begin
81 
      Image.Canvas.Rectangle(x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE,
 149 
      result.Fields[i][j].FieldType := Fields[i][j].FieldType;
82 
                             y*PREVIEW_BLOCK_SIZE,
 150 
      result.Fields[i][j].Goal      := Fields[i][j].Goal;
83 
                             x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,
 151 
      result.Fields[i][j].Panel     := Fields[i][j].Panel;
84 
                             y*PREVIEW_BLOCK_SIZE                           + PREVIEW_BLOCK_SIZE);
 152 
      result.Fields[i][j].Stone     := Fields[i][j].Stone;
85 
    end;
 153 
    end;
86 
  end;
 154 
  end;
87 
end;
 155 
end;
88 
 
 156 
 
89 
function FieldTypeWorth(t: TFieldType): integer;
 157 
function TPlayGroundMatrix.FieldState(t: TFieldType): TFieldState;
90 
begin
 158 
begin
- 
 
 159 
  result := fsError;
- 
 
 160 
  case t of
- 
 
 161 
    ftFullSpace: result := fsLocked;
- 
 
 162 
    ftEmpty:     result := fsAvailable;
91 
  if t = ftGreen then result := 10
 163 
    ftGreen:     result := fsStone;
92 
  else if t = ftYellow then result := 20
 164 
    ftYellow:    result := fsStone;
93 
  else if t = ftRed then result := 30
 165 
    ftRed:       result := fsStone;
- 
 
 166 
  end;
- 
 
 167 
end;
- 
 
 168 
 
- 
 
 169 
function TPlayGroundMatrix.FieldState(f: TField): TFieldState;
- 
 
 170 
begin
- 
 
 171 
  result := FieldState(f.FieldType);
- 
 
 172 
end;
- 
 
 173 
 
- 
 
 174 
function TPlayGroundMatrix.FieldState(x, y: integer): TFieldState;
- 
 
 175 
begin
94 
  else result := 0;
 176 
  result := fsError;
- 
 
 177 
  if (x < Low(Fields)) or (x > High(Fields)) then exit;
- 
 
 178 
  if (y < Low(Fields[x])) or (y > High(Fields[x])) then exit;
- 
 
 179 
 
- 
 
 180 
  result := FieldState(Fields[x][y]);
95 
end;
 181 
end;
96 
 
 182 
 
97 
{ TLevel }
 183 
{ TLevel }
98 
 
 184 
 
99 
const NUM_HEADERS = 2;
 185 
const NUM_HEADERS = 2;
Line 135... Line 221...
135 
    FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]);
 221 
    FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]);
136 
    if FStringList.Strings[i] = '' then FStringList.Delete(i);
 222 
    if FStringList.Strings[i] = '' then FStringList.Delete(i);
137 
  end;
 223 
  end;
138 
end;
 224 
end;
139 
 
 225 
 
140 
function DotsAtBeginning(s: string): integer;
 - 
 
141 
var
 - 
 
142 
  i: integer;
 - 
 
143 
begin
 - 
 
144 
  result := 0;
 - 
 
145 
  for i := 1 to Length(s) do
 - 
 
146 
  begin
 - 
 
147 
    if s[i] = '.' then
 - 
 
148 
      Inc(result)
 - 
 
149 
    else
 - 
 
150 
      Exit;
 - 
 
151 
  end;
 - 
 
152 
end;
 - 
 
153 
 
 - 
 
154 
function DotsAtEnd(s: string): integer;
 - 
 
155 
var
 - 
 
156 
  i: integer;
 - 
 
157 
begin
 - 
 
158 
  result := 0;
 - 
 
159 
  for i := Length(s) downto 1 do
 - 
 
160 
  begin
 - 
 
161 
    if s[i] = '.' then
 - 
 
162 
      Inc(result)
 - 
 
163 
    else
 - 
 
164 
      Exit;
 - 
 
165 
  end;
 - 
 
166 
end;
 - 
 
167 
 
 - 
 
168 
function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
 226 
function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
169 
var
 227 
var
170 
  i: integer;
 228 
  i: integer;
171 
  t: TFieldType;
 229 
  t: TFieldType;
172 
  err: TLevelError;
 230 
  err: TLevelError;