source: tags/1.3.0/UGameClient.pas

Last change on this file was 233, checked in by chronos, 6 years ago
  • Fixed: Map type Image wasn't using loaded image from file on repeated new game creation.
File size: 6.5 KB
Line 
1unit UGameClient;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread,
9 UThreading, UCommFrame, UPlayer;
10
11type
12 TClientConnectType = (ctLocal, ctNetwork);
13
14 { TClient }
15
16 TClient = class
17 private
18 FActive: Boolean;
19 FForm: TForm;
20 FGame: TGame;
21 FControlPlayer: TPlayer;
22 FOnChange: TNotifyEvent;
23 FOnDestroy: TNotifyEvent;
24 FOnGameEnd: TNotifyEvent;
25 FOnNextPlayer: TNotifyEvent;
26 FOnReceive: TCommandEvent;
27 FOnMove: TMoveEvent;
28 FOnTurnStart: TNotifyEvent;
29 CommThread: TCommThread;
30 CommFrame: TCommFrame;
31 procedure SetActive(AValue: Boolean);
32 procedure SetControlPlayer(AValue: TPlayer);
33 procedure SetForm(AValue: TForm);
34 procedure PlayerMove(CellFrom, CellTo: TPlayerCell; var CountOnce, CountRepeat: Integer;
35 Update: Boolean; var Confirm: Boolean);
36 procedure SetOnMove(AValue: TMoveEvent);
37 protected
38 procedure SetGame(AValue: TGame); virtual;
39 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual;
40 procedure DoTurnStartHandler(Sender: TObject); virtual;
41 procedure DoTurnStart; virtual;
42 procedure DoGameEndHandler(Sender: TObject);
43 procedure DoGameEnd;
44 procedure DoNextPlayerHandler(Sender: TObject);
45 procedure DoNextPlayer;
46 procedure DoParametersChangedHandler(Sender: TObject);
47 public
48 Name: string;
49 LocalServer: TServer;
50 RemoteAddress: string;
51 RemotePort: Word;
52 ConnectType: TClientConnectType;
53 Protocol: TGameProtocolClient;
54 procedure DoChange;
55 constructor Create; virtual;
56 destructor Destroy; override;
57 property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer;
58 property Game: TGame read FGame write SetGame;
59 property Form: TForm read FForm write SetForm;
60 property Active: Boolean read FActive write SetActive;
61 property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
62 property OnMove: TMoveEvent read FOnMove write SetOnMove;
63 property OnReceive: TCommandEvent read FOnReceive write FOnReceive;
64 property OnChange: TNotifyEvent read FOnChange write FOnChange;
65 property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart;
66 property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
67 property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer;
68 end;
69
70 { TClients }
71
72 TClients = class(TFPGObjectList<TClient>)
73 Game: TGame;
74 function New(Name: string): TClient;
75 function SearchPlayer(Player: TPlayer): TClient;
76 constructor Create(FreeObjects: Boolean = True);
77 end;
78
79
80implementation
81
82uses
83 UClientGUI;
84
85{ TClients }
86
87function TClients.New(Name: string): TClient;
88begin
89 Result := TClientGUI.Create;
90 Result.Game := Game;
91 Result.Name := Name;
92 Add(Result);
93end;
94
95function TClients.SearchPlayer(Player: TPlayer): TClient;
96var
97 Client: TClient;
98begin
99 Result := nil;
100 for Client in Self do
101 if Client.ControlPlayer = Player then begin
102 Result := Client;
103 Break;
104 end;
105end;
106
107constructor TClients.Create(FreeObjects: Boolean = True);
108begin
109 Game := nil;
110 inherited;
111end;
112
113{ TClient }
114
115procedure TClient.SetGame(AValue: TGame);
116begin
117 if FGame = AValue then Exit;
118 FGame := AValue;
119end;
120
121procedure TClient.DoChange;
122begin
123 if Assigned(FOnChange) then
124 FOnChange(Self);
125end;
126
127procedure TClient.PlayerMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
128 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
129begin
130 if Assigned(FOnMove) then
131 FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, Update, Confirm);
132end;
133
134procedure TClient.SetOnMove(AValue: TMoveEvent);
135begin
136 //if FOnMove = AValue then Exit;
137 FOnMove := AValue;
138end;
139
140procedure TClient.ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
141begin
142
143end;
144
145procedure TClient.DoTurnStartHandler(Sender: TObject);
146begin
147 Synchronize(DoTurnStart);
148end;
149
150procedure TClient.DoTurnStart;
151begin
152 if Assigned(FOnTurnStart) then
153 FOnTurnStart(Self);
154end;
155
156procedure TClient.DoGameEndHandler(Sender: TObject);
157begin
158 Synchronize(DoGameEnd);
159end;
160
161procedure TClient.DoGameEnd;
162begin
163 if Assigned(FOnGameEnd) then FOnGameEnd(Self);
164end;
165
166procedure TClient.DoNextPlayerHandler(Sender: TObject);
167begin
168 Synchronize(DoNextPlayer);
169end;
170
171procedure TClient.DoNextPlayer;
172begin
173 if Assigned(FOnNextPlayer) then FOnNextPlayer(Self);
174end;
175
176procedure TClient.DoParametersChangedHandler(Sender: TObject);
177begin
178 Synchronize(DoChange);
179end;
180
181procedure TClient.SetControlPlayer(AValue: TPlayer);
182begin
183 if FControlPlayer = AValue then Exit;
184 if Assigned(FControlPlayer) then
185 FControlPlayer.OnMove := nil;
186 FControlPlayer := AValue;
187 if Assigned(FControlPlayer) then begin
188 FControlPlayer.OnMove := PlayerMove;
189 end;
190end;
191
192procedure TClient.SetActive(AValue: Boolean);
193var
194 ServerClient: TServerClient;
195begin
196 if FActive = AValue then Exit;
197 if FActive then begin
198 case ConnectType of
199 ctLocal: begin
200 CommThread.Active := False;
201 CommThread.Ext.Disconnect;
202 CommThread.Pin.Disconnect;
203 end;
204 end;
205 end;
206 FActive := AValue;
207 if FActive then begin
208 case ConnectType of
209 ctLocal: if LocalServer.Active then begin
210 CommFrame.FrameDataPin.Connect(Protocol.Pin);
211 CommFrame.RawDataPin.Connect(CommThread.Pin);
212 CommThread.Active := True;
213 CommFrame.Active := True;
214 ServerClient := LocalServer.GetNewServerClient;
215 ServerClient.Player := ControlPlayer;
216 ServerClient.CommFrame.RawDataPin.Connect(CommThread.Ext);
217 end else raise Exception.Create('Local server is not active');
218 //ctNetwork: ;
219 end;
220 end else begin
221 Protocol.Pin.Disconnect;
222 end;
223end;
224
225procedure TClient.SetForm(AValue: TForm);
226begin
227 if FForm = AValue then Exit;
228 FForm := AValue;
229end;
230
231constructor TClient.Create;
232begin
233 CommThread := TCommThread.Create(nil);
234 CommFrame := TCommFrame.Create(nil);
235 FControlPlayer := nil;
236 Protocol := TGameProtocolClient.Create;
237 Protocol.OnTurnStart := DoTurnStartHandler;
238 Protocol.OnGameEnd := DoGameEndHandler;
239 Protocol.OnNextPlayer := DoNextPlayerHandler;
240 Protocol.OnParametersChanged := DoParametersChangedHandler;
241end;
242
243destructor TClient.Destroy;
244begin
245 Form := nil;
246 ControlPlayer := nil;
247 FreeAndNil(Protocol);
248 FreeAndNil(CommThread);
249 FreeAndNil(CommFrame);
250 inherited Destroy;
251end;
252
253
254end.
255
Note: See TracBrowser for help on using the repository browser.