source: tags/1.4.0/ClientGUI.pas

Last change on this file was 409, checked in by chronos, 11 months ago

Merged revision(s) 403-408 from trunk:

  • Added: Cover image.
  • Fixed: Crash on cyclic map new move creation.
  • Modified: TView class moved into separate unit.
  • Added: French translation.
  • Fixed: Do not stop running game on Quit action.
  • Fixed: Cell cities were not correctly stored the saved game.
  • Fixed: ItemList references were loaded by item index instead of item id.
  • Fixed: Wrong default map image path initialization.
File size: 16.6 KB
Line 
1unit ClientGUI;
2
3interface
4
5uses
6 Types, Classes, SysUtils, Graphics, GameClient, Player, Map, Game, Geometry,
7 Math, View;
8
9type
10 { TClientGUI }
11
12 TClientGUI = class(TClient)
13 protected
14 procedure SetGame(AValue: TGame); override;
15 public
16 View: TView;
17 CellGridVisible: Boolean;
18 UnitShapeVisible: Boolean;
19 procedure DrawArrow(Canvas: TCanvas; Pos: TPoint; Angle: Double;
20 Text: string; View: TView);
21 procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
22 Cell: TPlayerCell);
23 procedure PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
24 Cell: TCell);
25 procedure DrawArrows(Canvas: TCanvas; View: TView);
26 procedure DrawCells(Canvas: TCanvas; View: TView);
27 procedure DrawCellLinks(Canvas: TCanvas; View: TView);
28 procedure DrawNeighborLinks(Canvas: TCanvas; View: TView);
29 procedure DrawCities(Canvas: TCanvas; View: TView);
30 procedure DrawSelection(Canvas: TCanvas; View: TView);
31 procedure Paint(Canvas: TCanvas; View: TView);
32 constructor Create; override;
33 destructor Destroy; override;
34 end;
35
36
37implementation
38
39uses
40 Building;
41
42resourcestring
43 SWrongArrowAngle = 'Wrong arrow angle %s';
44
45{ TClientGUI }
46
47procedure TClientGUI.Paint(Canvas: TCanvas; View: TView);
48begin
49 DrawCellLinks(Canvas, View);
50 DrawCells(Canvas, View);
51 DrawCities(Canvas, View);
52 DrawSelection(Canvas, View);
53 DrawArrows(Canvas, View);
54 if TGame(Game).DevelMode then DrawNeighborLinks(Canvas, View);
55end;
56
57constructor TClientGUI.Create;
58begin
59 inherited;
60 View := TView.Create;
61end;
62
63destructor TClientGUI.Destroy;
64begin
65 FreeAndNil(View);
66 inherited;
67end;
68
69procedure TClientGUI.SetGame(AValue: TGame);
70begin
71 inherited;
72 View.Game := AValue;
73end;
74
75procedure TClientGUI.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string;
76 View: TView; Cell: TPlayerCell);
77var
78 I: Integer;
79 TextPos: TPoint;
80 Points: array of Classes.TPoint;
81 TextSize: TSize;
82 R: Integer;
83begin
84 if Cell.MapCell.Extra = etObjectiveTarget then begin
85 Text := Text + '!';
86 end;
87 with Canvas do begin
88 // Cannot set clear border as it will display shifted on gtk2
89 //Pen.Style := psClear;
90 Pen.Style := psSolid;
91 if CellGridVisible then begin
92 Pen.Color := clBlack;
93 Pen.Width := Round(2 * View.Zoom);
94 end else begin
95 Pen.Color := Brush.Color;
96 Pen.Width := 0;
97 end;
98
99 // Transform view
100 SetLength(Points, Length(Cell.MapCell.Polygon.Points));
101 for I := 0 to Length(Points) - 1 do
102 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
103 Brush.Style := bsSolid;
104 TCanvasEx.PolygonEx(Canvas, Points, False);
105
106 // Show cell text
107 if (Cell.GetAvialPower <> 0) or (Cell.MapCell.Extra = etObjectiveTarget) then begin
108 Pen.Style := psSolid;
109 Font.Color := clWhite;
110 Brush.Style := bsClear;
111 Font.Size := Trunc(42 * View.Zoom);
112 TextPos := View.CellToCanvasPos(Pos);
113 TextSize := TextExtent(Text);
114 TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
115 Round(TextPos.Y) - TextSize.cy div 2, Text, False);
116 end;
117 if UnitShapeVisible and Assigned(Cell.MapCell.OneUnit) then begin
118 TextPos := View.CellToCanvasPos(Pos);
119 R := Trunc(70 * View.Zoom);
120 Pen.Color := clWhite;
121 Pen.Style := psSolid;
122 Pen.Width := Round(10 * View.Zoom);
123 Brush.Style := bsClear;
124 TCanvasEx.EllipseEx(Canvas, TRect.Create(
125 TPoint.Create(TextPos.X - R, TextPos.Y - R),
126 TPoint.Create(TextPos.X + R, TextPos.Y + R)
127 ));
128 end;
129 end;
130end;
131
132procedure TClientGUI.PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string;
133 View: TView; Cell: TCell);
134var
135 I: Integer;
136 TextPos: TPoint;
137 Points: array of Classes.TPoint;
138 TextSize: TSize;
139 R: Integer;
140begin
141 if Cell.Extra = etObjectiveTarget then begin
142 Text := Text + '!';
143 end;
144 with Canvas do begin
145 if Assigned(View.FocusedCell) and (View.FocusedCell.MapCell = Cell) then begin
146 Pen.Color := clYellow;
147 Pen.Style := psSolid;
148 Pen.Width := 1;
149 end else
150 if Assigned(Cell.Building) and Assigned(Cell.Building.Kind) and
151 (Cell.Building.Kind.SpecialType = stCity) then begin
152 // Cannot set clear border as it will display shifted on gtk2
153 //Pen.Style := psClear;
154 Pen.Color := clBlack;
155 Pen.Style := psSolid;
156 Pen.Width := Trunc(5 * View.Zoom);
157 end else begin
158 // Cannot set clear border as it will display shifted on gtk2
159 //Pen.Style := psClear;
160 Pen.Color := Brush.Color;
161 Pen.Style := psSolid;
162 Pen.Width := 0;
163 end;
164
165 // Cannot set clear border as it will display shifted on gtk2
166 //Pen.Style := psClear;
167 Pen.Style := psSolid;
168 if CellGridVisible then begin
169 Pen.Color := clBlack;
170 Pen.Width := Round(2 * View.Zoom);
171 end else begin
172 Pen.Color := Brush.Color;
173 Pen.Width := 0;
174 end;
175
176 // Transform view
177 SetLength(Points, Length(Cell.Polygon.Points));
178 for I := 0 to Length(Points) - 1 do
179 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.Polygon.Points[I]));
180 Brush.Style := bsSolid;
181 //Polygon(Points, False, 0, Length(Points));
182 TCanvasEx.PolygonEx(Canvas, Points, False);
183 //MoveTo(Points[0].X, Points[0].Y);
184 //LineTo(Points[1].X, Points[1].Y);
185
186 // Show cell text
187 if Assigned(Cell.OneUnit) and (Cell.OneUnit.Power <> 0) or
188 (Cell.Extra = etObjectiveTarget) then begin
189 Pen.Style := psSolid;
190 Font.Color := clWhite;
191 Brush.Style := bsClear;
192 Font.Size := Trunc(42 * View.Zoom);
193 TextPos := View.CellToCanvasPos(Pos);
194 TextSize := TextExtent(Text);
195 TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
196 Round(TextPos.Y) - TextSize.cy div 2, Text, False);
197 end;
198 if UnitShapeVisible and Assigned(Cell.OneUnit) then begin
199 TextPos := View.CellToCanvasPos(Pos);
200 R := Trunc(70 * View.Zoom);
201 Pen.Color := clWhite;
202 Pen.Style := psSolid;
203 Pen.Width := Round(10 * View.Zoom);
204 Brush.Style := bsClear;
205 TCanvasEx.EllipseEx(Canvas, TRect.Create(
206 TPoint.Create(TextPos.X - R, TextPos.Y - R),
207 TPoint.Create(TextPos.X + R, TextPos.Y + R)
208 ));
209 end;
210 end;
211end;
212
213procedure TClientGUI.DrawArrows(Canvas: TCanvas; View: TView);
214var
215 PosFrom, PosTo: TPoint;
216 Angle: Double;
217 ArrowCenter: TPoint;
218 Move: TUnitMove;
219 P: TPoint;
220begin
221 with Canvas, View do begin
222 Pen.Color := clCream;
223 if Assigned(ControlPlayer) then
224 for Move in ControlPlayer.Moves do begin
225 PosFrom := TGame(Game).Map.CellToPos(Move.CellFrom.MapCell);
226 PosTo := TGame(Game).Map.CellToPos(Move.CellTo.MapCell);
227 if TGame(Game).Map.Cyclic then begin
228 P := TPoint.Create(PosTo.X + TGame(Game).Map.PixelRect.Size.X,
229 PosTo.Y);
230 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
231 PosTo := TPoint.Create(P.X, PosTo.Y);
232 P := TPoint.Create(PosTo.X, PosTo.Y + TGame(Game).Map.PixelRect.Size.Y);
233 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
234 PosTo := TPoint.Create(PosTo.X, P.Y);
235 P := TPoint.Create(PosTo.X - TGame(Game).Map.PixelRect.Size.X,
236 PosTo.Y);
237 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
238 PosTo := TPoint.Create(P.X, PosTo.Y);
239 P := TPoint.Create(PosTo.X, PosTo.Y - TGame(Game).Map.PixelRect.Size.Y);
240 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
241 PosTo := TPoint.Create(PosTo.X, P.Y);
242 end;
243 // In Fog of war mode show only
244 if TGame(Game).FogOfWar and not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellFrom.MapCell).InVisibleRange and
245 not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then
246 Continue;
247 if Move.CountRepeat > 0 then Pen.Width := Round(2 * View.Zoom)
248 else Pen.Width := Round(1 * View.Zoom);
249 Angle := ArcTan2(PosTo.Y - PosFrom.Y, PosTo.X - PosFrom.X);
250 if (Angle > +Pi) or (Angle < -Pi) then
251 raise Exception.Create(Format(SWrongArrowAngle, [FloatToStr(Angle)]));
252
253 ArrowCenter := View.CellToCanvasPos(TPoint.Create(
254 Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
255 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)
256 ));
257 DrawArrow(Canvas, ArrowCenter,
258 Angle, IntToStr(Move.CountOnce), View);
259 end;
260 end;
261end;
262
263procedure TClientGUI.DrawArrow(Canvas: TCanvas; Pos: TPoint;
264 Angle: Double; Text: string; View: TView);
265var
266 Points: array of Classes.TPoint;
267 Arrow: TPolygonF;
268 I: Integer;
269 ArrowSize: TPoint;
270 RectPolygon: TRectF;
271begin
272 SetLength(Arrow.Points, 8);
273 ArrowSize := TPoint.Create(Trunc(TGame(Game).Map.DefaultCellSize.X / 3 * View.Zoom),
274 Trunc(TGame(Game).Map.DefaultCellSize.Y / 3 * View.Zoom));
275 Arrow.Points[0] := TPointF.Create(+0.5 * ArrowSize.X, +0 * ArrowSize.Y);
276 Arrow.Points[1] := TPointF.Create(+0 * ArrowSize.X, +0.5 * ArrowSize.Y);
277 Arrow.Points[2] := TPointF.Create(+0 * ArrowSize.X, +0.25 * ArrowSize.Y);
278 Arrow.Points[3] := TPointF.Create(-0.5 * ArrowSize.X, +0.25 * ArrowSize.Y);
279 Arrow.Points[4] := TPointF.Create(-0.5 * ArrowSize.X, -0.25 * ArrowSize.Y);
280 Arrow.Points[5] := TPointF.Create(+0 * ArrowSize.X, -0.25 * ArrowSize.Y);
281 Arrow.Points[6] := TPointF.Create(+0 * ArrowSize.X, -0.5 * ArrowSize.Y);
282 Arrow.Points[7] := TPointF.Create(+0.5 * ArrowSize.X, 0 * ArrowSize.Y);
283 // Rotate
284 for I := 0 to Length(Arrow.Points) - 1 do begin
285 Arrow.Points[I] := TPointF.Create(
286 Arrow.Points[I].X * Cos(Angle) - Arrow.Points[I].Y * Sin(Angle),
287 Arrow.Points[I].X * Sin(Angle) + Arrow.Points[I].Y * Cos(Angle)
288 );
289 Arrow.Points[I] := Arrow.Points[I] + TPointF.Create(Pos.X, Pos.Y);
290 end;
291
292 RectPolygon := Arrow.GetRect;
293 if (RectPolygon.P1.X < View.DestRect.Size.X) and
294 (RectPolygon.P2.X > 0) and
295 (RectPolygon.P1.Y < View.DestRect.Size.Y) and
296 (RectPolygon.P2.Y > 0) then begin
297
298 // Convert to standard points
299 SetLength(Points, 8);
300 for I := 0 to Length(Points) - 1 do
301 Points[I] := Point(Trunc(Arrow[I].X), Trunc(Arrow[I].Y));
302 with Canvas do begin
303 Pen.Color := clBlack;
304 Brush.Color := clWhite;
305 Brush.Style := bsSolid;
306 Polygon(Points);
307 Brush.Style := bsClear;
308 Font.Color := clBlack;
309 Font.Size := Trunc(18 * View.Zoom);
310 TextOut(Pos.X - TextWidth(Text) div 2, Pos.Y - TextHeight(Text) div 2, Text);
311 Pen.Width := 1;
312 end;
313 end;
314end;
315
316procedure TClientGUI.DrawCells(Canvas: TCanvas; View: TView);
317var
318 Cell: TPlayerCell;
319 MapCell: TCell;
320 CellText: string;
321begin
322 with Canvas, View do begin
323 if Assigned(ControlPlayer) then begin
324 for Cell in ControlPlayer.PlayerMap.Cells do begin
325 if View.IsCellVisible(Cell.MapCell) and (Cell.MapCell.Terrain <> ttVoid) then begin
326 if Cell.MapCell.Player = ControlPlayer then
327 CellText := IntToStr(Cell.GetAvialPower)
328 else begin
329 if Assigned(Cell.MapCell.OneUnit) then
330 CellText := IntToStr(Cell.MapCell.OneUnit.Power)
331 else CellText := '';
332 end;
333 if Assigned(SelectedCell) and (SelectedCell = Cell) then
334 Brush.Color := clGreen
335 else if Assigned(SelectedCell) and ControlPlayer.IsAllowedMoveTarget(SelectedCell, Cell) then
336 Brush.Color := clPurple
337 else if TGame(Game).FogOfWar then begin
338 if Cell.InVisibleRange then begin
339 Brush.Color := Cell.MapCell.GetColor;
340 end else begin
341 if Cell.Explored then begin
342 Brush.Color := $404040;
343 CellText := '';
344 end else begin
345 Brush.Color := clBlack;
346 CellText := '';
347 end;
348 end;
349 end else Brush.Color := Cell.MapCell.GetColor;
350 PaintCell(Canvas, Cell.MapCell.PosPx, CellText, View, Cell);
351 end else
352 if TGame(Game).FogOfWar and (Cell.MapCell.Terrain = ttVoid) then begin
353 Brush.Color := clBlack;
354 PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell);
355 end;
356 end;
357 end else begin
358 // Draw cells
359 for MapCell in TGame(Game).Map.Cells do begin
360 if (MapCell.Terrain <> ttVoid) and View.IsCellVisible(MapCell) then begin
361 Brush.Color := MapCell.GetColor;
362 if Assigned(MapCell.OneUnit) then
363 CellText := IntToStr(MapCell.OneUnit.Power)
364 else CellText := '';
365 PaintMapCell(Canvas, MapCell.PosPx, CellText, View, MapCell);
366 end;
367 end;
368 end;
369 end;
370end;
371
372procedure TClientGUI.DrawCellLinks(Canvas: TCanvas; View: TView);
373var
374 I: Integer;
375 CellLink: TCellLink;
376begin
377 with Canvas, View do begin
378 Pen.Color := clBlack;
379 Pen.Style := psSolid;
380 Pen.Width := 3;
381 for CellLink in TGame(Game).Map.CellLinks do
382 with CellLink do begin
383 if Length(Points) >= 2 then begin
384 MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
385 for I := 1 to Length(Points) - 1 do
386 LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
387 end;
388 end;
389 end;
390end;
391
392procedure TClientGUI.DrawNeighborLinks(Canvas: TCanvas; View: TView);
393var
394 Cell: TPlayerCell;
395 C: TCell;
396begin
397 with Canvas, View do begin
398 for Cell in ControlPlayer.PlayerMap.Cells do begin
399 for C in Cell.MapCell.Neighbors do begin
400 Pen.Color := clYellow;
401 MoveTo(PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.PosPx)));
402 LineTo(PointToStdPoint(View.CellToCanvasPos(C.PosPx)));
403 end;
404
405 Font.Color := clRed;
406 Brush.Style := bsClear;
407 TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X,
408 View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id));
409 end;
410 end;
411end;
412
413procedure TClientGUI.DrawCities(Canvas: TCanvas; View: TView);
414var
415 Cell: TPlayerCell;
416 MapCell: TCell;
417 Points: array of Classes.TPoint;
418 I: Integer;
419begin
420 with Canvas, View do begin
421 if Assigned(ControlPlayer) then begin
422 for Cell in ControlPlayer.PlayerMap.Cells do begin
423 if (Cell.MapCell.Terrain <> ttVoid) and View.IsCellVisible(Cell.MapCell) then begin
424 if Assigned(Cell.MapCell.Building) and Assigned(Cell.MapCell.Building.Kind) and
425 (Cell.MapCell.Building.Kind.SpecialType = stCity) then begin
426 // Cannot set clear border as it will display shifted on gtk2
427 //Pen.Style := psClear;
428 Pen.Color := clBlack;
429 Pen.Style := psSolid;
430 Pen.Width := Round(6 * View.Zoom);
431
432 // Transform view
433 SetLength(Points, Length(Cell.MapCell.Polygon.Points) + 1);
434 for I := 0 to Length(Cell.MapCell.Polygon.Points) - 1 do
435 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
436 Points[Length(Points) - 1] := Points[0];
437 TCanvasEx.PolyLineEx(Canvas, Points);
438 end;
439 end;
440 end;
441 end else begin
442 for MapCell in TGame(Game).Map.Cells do begin
443 if (MapCell.Terrain <> ttVoid) and View.IsCellVisible(MapCell) then begin
444 if View.IsCellVisible(MapCell) and (MapCell.Terrain <> ttVoid) then begin
445 if Assigned(MapCell.Building) and Assigned(MapCell.Building.Kind) and
446 (MapCell.Building.Kind.SpecialType = stCity) then begin
447 // Cannot set clear border as it will display shifted on gtk2
448 //Pen.Style := psClear;
449 Pen.Color := clBlack;
450 Pen.Style := psSolid;
451 Pen.Width := Round(6 * View.Zoom);
452
453 // Transform view
454 SetLength(Points, Length(MapCell.Polygon.Points) + 1);
455 for I := 0 to Length(MapCell.Polygon.Points) - 1 do
456 Points[I] := PointToStdPoint(View.CellToCanvasPos(MapCell.Polygon.Points[I]));
457 Points[Length(Points) - 1] := Points[0];
458 TCanvasEx.PolyLineEx(Canvas, Points);
459 end;
460 end;
461 end;
462 end;
463 end;
464 end;
465end;
466
467procedure TClientGUI.DrawSelection(Canvas: TCanvas; View: TView);
468var
469 Points: array of Classes.TPoint;
470 I: Integer;
471begin
472 with Canvas, View do begin
473 if Assigned(ControlPlayer) then begin
474 if Assigned(View.FocusedCell) then begin
475 Pen.Color := clYellow;
476 Pen.Style := psSolid;
477 Pen.Width := Round(2 * View.Zoom);
478
479 // Transform view
480 SetLength(Points, Length(View.FocusedCell.MapCell.Polygon.Points) + 1);
481 for I := 0 to Length(View.FocusedCell.MapCell.Polygon.Points) - 1 do
482 Points[I] := PointToStdPoint(View.CellToCanvasPos(View.FocusedCell.MapCell.Polygon.Points[I]));
483 Points[Length(Points) - 1] := Points[0];
484 TCanvasEx.PolyLineEx(Canvas, Points);
485 end;
486 end;
487 end;
488end;
489
490end.
491
Note: See TracBrowser for help on using the repository browser.