← Back to branch summary

~ubuntu-branches/ubuntu/utopic/castle-game-engine/utopic

« back to all changes in this revision

Viewing changes to examples/isometric_game/sandbox.lpr

  • Committer: Package Import Robot
  • Author(s): Abou Al Montacir
  • Date: 2013-04-27 18:06:40 UTC
  • Revision ID: package-import@ubuntu.com-20130427180640-eink4nmwzuivez1c
Tags: upstream-4.0.1
Import upstream version 4.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/isometric_game/sandbox.lpr
 
1
program SandBox;
 
2
 
 
3
{$apptype GUI}
 
4
 
 
5
uses SysUtils, GL, GLU, GLExt, CastleWindow, SandBoxMap, CastleFilesUtils,
 
6
  CastleWindowModes, SandBoxPlayer, CastleStringUtils, Math, CastleUtils,
 
7
  CastleGLUtils, SandBoxGame, CastleKeysMouse, CastleMessages, CastleGLImages;
 
8
 
 
9
var
 
10
  Window: TCastleWindowDemo;
 
11
  Player: TPlayer;
 
12
  Quit: boolean;
 
13
  ViewMoveX, ViewMoveY: Single;
 
14
  ViewFollowsPlayer: boolean = true;
 
15
 
 
16
procedure LoadMap;
 
17
begin
 
18
  Map := TMap.CreateFromFile(ProgramDataPath + 'maps' + PathDelim + '1.map');
 
19
  Player := TPlayer.Create;
 
20
  Player.Teleport(Map.PlayerStartX, Map.PlayerStartY, dirSouth);
 
21
end;
 
22
 
 
23
procedure Draw(Window: TCastleWindowBase);
 
24
var
 
25
  RealViewMoveX, RealViewMoveY: Integer;
 
26
 
 
27
  procedure DrawImageOnTile(X, Y: Cardinal; GLImage: TGLImage;
 
28
    const SpecialMoveX: Integer = 0;
 
29
    const SpecialMoveY: Integer = 0);
 
30
  var
 
31
    PosX, PosY: Integer;
 
32
  begin
 
33
    PosX := X * BaseWidth;
 
34
    if Odd(Y) then
 
35
      PosX += BaseWidth div 2;
 
36
    PosX += RealViewMoveX + SpecialMoveX;
 
37
    PosY := Y * (BaseHeight div 2);
 
38
    PosY += RealViewMoveY + SpecialMoveY;
 
39
 
 
40
    if (PosX >= 0) and (PosY >= 0) then
 
41
    begin
 
42
      glRasterPos2i(PosX, PosY);
 
43
    end else
 
44
    begin
 
45
      { Instead of glRasterPos2i(PosX, PosY) we use following trick from
 
46
        [http://www.opengl.org/resources/features/KilgardTechniques/oglpitfall/].
 
47
        We don't use this trick always --- possibly normal glRasterPos2i may
 
48
        be a little faster when it's enough. }
 
49
      glRasterPos2i(0, 0);
 
50
      glBitmap(0, 0, 0, 0, PosX, PosY, nil);
 
51
    end;
 
52
 
 
53
    GLImage.Draw;
 
54
  end;
 
55
 
 
56
var
 
57
  X, Y: Cardinal;
 
58
  MapTile: TMapTile;
 
59
  BaseFitX, BaseFitY: Cardinal;
 
60
  X1, X2, Y1, Y2: Integer;
 
61
begin
 
62
  glClear(GL_COLOR_BUFFER_BIT);
 
63
  glEnable(GL_ALPHA_TEST);
 
64
  glAlphaFunc(GL_GREATER, 0.5);
 
65
 
 
66
  BaseFitX := Ceil(ScreenWidth / BaseWidth) + 1;
 
67
  BaseFitY := Ceil(2 * ScreenHeight / BaseHeight) + 1;
 
68
 
 
69
  if ViewFollowsPlayer then
 
70
  begin
 
71
    { Ignore ViewMoveX/Y, calculate RealView such that the player
 
72
      is in the middle. }
 
73
    RealViewMoveX := Player.XPixel;
 
74
    RealViewMoveY := Player.YPixel;
 
75
    if Player.Moving then
 
76
    begin
 
77
      RealViewMoveX -= Round(Player.MovingSmallMoveX);
 
78
      RealViewMoveY -= Round(Player.MovingSmallMoveY);
 
79
    end;
 
80
  end else
 
81
  begin
 
82
    RealViewMoveX := Round(ViewMoveX);
 
83
    RealViewMoveY := Round(ViewMoveY);
 
84
  end;
 
85
 
 
86
  { First: this is what would be seen if RealViewMoveX/Y is zero. }
 
87
  X1 := -1;
 
88
  X2 := Integer(BaseFitX) - 2;
 
89
  Y1 := -1;
 
90
  Y2 := Integer(BaseFitY) - 2;
 
91
  { Now translate taking RealViewMoveX/Y into account. }
 
92
  X1 -= Ceil(RealViewMoveX / BaseWidth);
 
93
  X2 -= Floor(RealViewMoveX / BaseWidth);
 
94
  Y1 -= Ceil(2 * RealViewMoveY / BaseHeight);
 
95
  Y2 -= Floor(2 * RealViewMoveY / BaseHeight);
 
96
  { Eventually correct to be inside 0..Map.Width/Height - 1 range }
 
97
  Clamp(X1, 0, Map.Width - 1);
 
98
  Clamp(X2, 0, Map.Width - 1);
 
99
  Clamp(Y1, 0, Map.Height - 1);
 
100
  Clamp(Y2, 0, Map.Height - 1);
 
101
 
 
102
  for X := X1 to X2 do
 
103
    for Y := Y1 to Y2 do
 
104
    begin
 
105
      MapTile := Map.Items[X, Y];
 
106
      DrawImageOnTile(X, Y, MapTile.BaseTile.GLImage);
 
107
    end;
 
108
 
 
109
  { TODO: shitty code, should draw only the part that fits within the window.
 
110
    We should auto-check width/height of bonus tile, to know when to draw it.
 
111
    Even better, we should record this on the map --- which tile is visible
 
112
    where. }
 
113
  for Y := Map.Height - 1 downto 0 do
 
114
  begin
 
115
    { The order of drawing is important. Player must be drawn
 
116
      on top of some objects and below some others. }
 
117
    if Y = Player.Y then
 
118
    begin
 
119
      if Player.Moving then
 
120
        DrawImageOnTile(Player.X, Player.Y, Player.GLImage[Player.Direction],
 
121
          Round(Player.MovingSmallMoveX),
 
122
          Round(Player.MovingSmallMoveY)) else
 
123
        DrawImageOnTile(Player.X, Player.Y, Player.GLImage[Player.Direction]);
 
124
    end;
 
125
 
 
126
    for X := 0 to Map.Width - 1 do
 
127
    begin
 
128
      MapTile := Map.Items[X, Y];
 
129
      if MapTile.BonusTile <> nil then
 
130
        DrawImageOnTile(X, Y, MapTile.BonusTile.GLImage);
 
131
    end;
 
132
  end;
 
133
 
 
134
  glDisable(GL_ALPHA_TEST);
 
135
 
 
136
  { Tests: middle lines:
 
137
  GLVerticalLine(Window.Width / 2, 0, Window.Height);
 
138
  GLHorizontalLine(0, Window.Width, Window.Height / 2); }
 
139
end;
 
140
 
 
141
procedure Press(Window: TCastleWindowBase; const Event: TInputPressRelease);
 
142
var
 
143
  NewViewMoveX, NewViewMoveY: Integer;
 
144
 
 
145
  procedure EditBaseTile;
 
146
  var
 
147
    BaseTile: TBaseTile;
 
148
    C: Char;
 
149
  begin
 
150
    C := MessageChar(Window, 'Enter the character code of new base tile, ' +
 
151
      'or Escape to cancel', AllChars - [#0], '', taMiddle);
 
152
    if C <> CharEscape then
 
153
    begin
 
154
      BaseTile := Map.BaseTiles[C];
 
155
      if BaseTile = nil then
 
156
        MessageOK(Window, Format('The character "%s" is not a code ' +
 
157
          'for any base tile', [C]), taMiddle) else
 
158
      Map.Items[Player.X, Player.Y].BaseTile := BaseTile;
 
159
    end;
 
160
  end;
 
161
 
 
162
  procedure EditBonusTile;
 
163
  var
 
164
    BonusTile: TBonusTile;
 
165
    C: Char;
 
166
  begin
 
167
    C := MessageChar(Window, 'Enter the character code of new bonus tile, ' +
 
168
      'or "_" to clear or Escape to cancel', AllChars - [#0], '', taMiddle);
 
169
    if C <> CharEscape then
 
170
    begin
 
171
      if C = '_' then
 
172
        Map.Items[Player.X, Player.Y].BonusTile := nil else
 
173
      begin
 
174
        BonusTile := Map.BonusTiles[C];
 
175
        if BonusTile = nil then
 
176
          MessageOK(Window, Format('The character "%s" is not a code ' +
 
177
            'for any bonus tile', [C]), taMiddle) else
 
178
        Map.Items[Player.X, Player.Y].BonusTile := BonusTile;
 
179
      end;
 
180
    end;
 
181
  end;
 
182
 
 
183
  procedure ShowFieldInfo;
 
184
 
 
185
    function TileDescr(Tile: TTile): string;
 
186
    begin
 
187
      if Tile = nil then
 
188
        Result := '<none>' else
 
189
        Result := Format('"%s" (filename "%s")',
 
190
          [Tile.CharCode, Tile.RelativeFileName]);
 
191
    end;
 
192
 
 
193
  begin
 
194
    MessageOK(Window, Format(
 
195
      'Position: %d, %d' +nl+
 
196
      'Base tile: %s' +nl+
 
197
      'Bonus tile: %s',
 
198
      [ Player.X, Player.Y,
 
199
        TileDescr(Map.Items[Player.X, Player.Y].BaseTile),
 
200
        TileDescr(Map.Items[Player.X, Player.Y].BonusTile) ]), taLeft);
 
201
  end;
 
202
 
 
203
var
 
204
  FileName: string;
 
205
begin
 
206
  if Event.EventType = itKey then
 
207
  begin
 
208
    case Event.KeyCharacter of
 
209
      'f': begin
 
210
             ViewFollowsPlayer := not ViewFollowsPlayer;
 
211
             if not ViewFollowsPlayer then
 
212
             begin
 
213
               { Set ViewMoveX/Y initial values such that the player is still
 
214
                 in the middle. This is less confusing for user. }
 
215
               ViewMoveToCenterPosition(Player.X, Player.Y,
 
216
                 NewViewMoveX, NewViewMoveY);
 
217
               ViewMoveX := NewViewMoveX;
 
218
               ViewMoveY := NewViewMoveY;
 
219
             end;
 
220
           end;
 
221
      'e': EditBaseTile;
 
222
      'E': EditBonusTile;
 
223
      's': begin
 
224
             FileName := 'new';
 
225
             if MessageInputQuery(Window, 'Save map as name' +
 
226
               ' (don''t specify here initial path and .map extension)',
 
227
               FileName, taLeft) then
 
228
             Map.SaveToFile(ProgramDataPath + 'maps' + PathDelim +
 
229
               FileName + '.map');
 
230
           end;
 
231
      'i': ShowFieldInfo;
 
232
      CharEscape: Quit := true;
 
233
    end;
 
234
  end;
 
235
end;
 
236
 
 
237
procedure Idle(Window: TCastleWindowBase);
 
238
const
 
239
  ViewMoveChangeSpeed = 10.0 * 50.0;
 
240
begin
 
241
  if not ViewFollowsPlayer then
 
242
  begin
 
243
    if Window.Pressed[K_Up]    then ViewMoveY -= ViewMoveChangeSpeed * Window.Fps.IdleSpeed;
 
244
    if Window.Pressed[K_Down]  then ViewMoveY += ViewMoveChangeSpeed * Window.Fps.IdleSpeed;
 
245
    if Window.Pressed[K_Right] then ViewMoveX -= ViewMoveChangeSpeed * Window.Fps.IdleSpeed;
 
246
    if Window.Pressed[K_Left]  then ViewMoveX += ViewMoveChangeSpeed * Window.Fps.IdleSpeed;
 
247
  end else
 
248
  begin
 
249
    { At first I placed the commands below in KeyDown, as they work
 
250
      like KeyDown: non-continuously. However, thanks to smooth scrolling
 
251
      of the screen, user is easily fooled and thinks that they work
 
252
      continuously. So he keeps pressing them. So we should check them
 
253
      here. }
 
254
    if Window.Pressed[K_Up]    then Player.Move(dirNorth);
 
255
    if Window.Pressed[K_Down]  then Player.Move(dirSouth);
 
256
    if Window.Pressed[K_Left]  then Player.Move(dirWest);
 
257
    if Window.Pressed[K_Right] then Player.Move(dirEast);
 
258
 
 
259
    if Window.Pressed[K_Numpad_7] then Player.Move(dirNorthWest);
 
260
    if Window.Pressed[K_Numpad_9] then Player.Move(dirNorthEast);
 
261
    if Window.Pressed[K_Numpad_1] then Player.Move(dirSouthWest);
 
262
    if Window.Pressed[K_Numpad_3] then Player.Move(dirSouthEast);
 
263
    if Window.Pressed[K_Numpad_4] then Player.Move(dirWest);
 
264
    if Window.Pressed[K_Numpad_6] then Player.Move(dirEast);
 
265
    if Window.Pressed[K_Numpad_2] then Player.Move(dirSouth);
 
266
    if Window.Pressed[K_Numpad_8] then Player.Move(dirNorth);
 
267
  end;
 
268
 
 
269
  GameTime += Window.Fps.IdleSpeed;
 
270
 
 
271
  Player.Idle;
 
272
end;
 
273
 
 
274
procedure Game;
 
275
var
 
276
  SavedMode: TGLMode;
 
277
begin
 
278
  SavedMode := TGLMode.CreateReset(Window, 0, true, @Draw, @Resize2D, nil);
 
279
  try
 
280
    Window.AutoRedisplay := true;
 
281
    Window.OnPress := @Press;
 
282
    Window.OnIdle := @Idle;
 
283
 
 
284
    Quit := false;
 
285
    repeat
 
286
      if not Application.ProcessMessage(true, true) then Quit := true;
 
287
    until Quit;
 
288
 
 
289
  finally FreeAndNil(SavedMode); end;
 
290
end;
 
291
 
 
292
begin
 
293
  Window := TCastleWindowDemo.Create(Application);
 
294
 
 
295
  Window.Caption := 'The Sandbox';
 
296
  Window.ResizeAllowed := raOnlyAtOpen;
 
297
  Window.OnResize := @Resize2D;
 
298
  Window.SetDemoOptions(K_F11, CharEscape, true);
 
299
 
 
300
  Window.Open;
 
301
  ScreenWidth := Window.Width;
 
302
  ScreenHeight := Window.Height;
 
303
 
 
304
  LoadMap;
 
305
  Game;
 
306
 
 
307
  FreeAndNil(Player);
 
308
  FreeAndNil(Map);
 
309
end.