source: tags/1.3.0/UGameProtocol.pas

Last change on this file was 220, checked in by chronos, 7 years ago
  • Added: Allow to toggle Fog of war in debug mode from Debug menu.
File size: 6.0 KB
Line 
1unit UGameProtocol;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, UGame, UVarBlockSerializer, UCommPin, SpecializedList;
9
10type
11 TCommand = (cmdTextMessage, cmdTurnStart, cmdTurnEnd, cmdGameStart, cmdGameEnd,
12 cmdSurrender, cmdNextPlayer, cmdParametersChanged);
13 TCommandEvent = procedure (Command: TCommand; DataIn, DataOut: TStream);
14
15 TCommandTextMessage = record
16 Text: string;
17 end;
18
19 { TGameProtocolClient }
20
21 TGameProtocolClient = class
22 private
23 FOnGameEnd: TNotifyEvent;
24 FOnGameStart: TNotifyEvent;
25 FOnNextPlayer: TNotifyEvent;
26 FOnParametersChanged: TNotifyEvent;
27 FOnTurnStart: TNotifyEvent;
28 procedure Receive(Sender: TCommPin; Stream: TListByte);
29 procedure SendCmd(Command: TCommand);
30 public
31 Pin: TCommPin;
32 procedure TurnEnd;
33 procedure Surrender;
34 procedure SendMessage(Text: string);
35 constructor Create;
36 destructor Destroy; override;
37 property OnGameStart: TNotifyEvent read FOnGameStart write FOnGameStart;
38 property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
39 property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart;
40 property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer;
41 property OnParametersChanged: TNotifyEvent read FOnParametersChanged
42 write FOnParametersChanged;
43 end;
44
45 TSendMessageEvent = procedure (Text: string) of object;
46
47 { TGameProtocolServer }
48
49 TGameProtocolServer = class
50 private
51 FOnSendMessage: TSendMessageEvent;
52 FOnSurrender: TNotifyEvent;
53 FOnTurnEnd: TNotifyEvent;
54 procedure Receive(Sender: TCommPin; Stream: TListByte);
55 procedure SendCmd(Command: TCommand);
56 public
57 Pin: TCommPin;
58 constructor Create;
59 destructor Destroy; override;
60 procedure GameStart;
61 procedure GameEnd;
62 procedure TurnStart;
63 procedure ParametersChanged;
64 procedure NextPlayer;
65 property OnSendMessage: TSendMessageEvent read FOnSendMessage
66 write FOnSendMessage;
67 property OnTurnEnd: TNotifyEvent read FOnTurnEnd write FOnTurnEnd;
68 property OnSurrender: TNotifyEvent read FOnSurrender write FOnSurrender;
69 end;
70
71
72implementation
73
74{ TGameProtocolServer }
75
76procedure TGameProtocolServer.Receive(Sender: TCommPin; Stream: TListByte);
77var
78 Data: TVarBlockSerializer;
79 Command: Integer;
80begin
81 Data := TVarBlockSerializer.Create;
82 Data.WriteVarList(Stream);
83 Data.Stream.Position := 0;
84 Command := Data.ReadVarUInt;
85 try
86 if Command = Integer(cmdTextMessage) then begin
87 if Assigned(FOnSendMessage) then FOnSendMessage(Data.ReadVarString);
88 end else
89 if Command = Integer(cmdTurnEnd) then begin
90 if Assigned(FOnTurnEnd) then FOnTurnEnd(Self);
91 end else
92 if Command = Integer(cmdSurrender) then begin
93 if Assigned(FOnSurrender) then FOnSurrender(Self);
94 end;
95 finally
96 Data.Free;
97 end;
98end;
99
100procedure TGameProtocolServer.SendCmd(Command: TCommand);
101var
102 Data: TVarBlockSerializer;
103 Data2: TListByte;
104begin
105 Data := TVarBlockSerializer.Create;
106 Data2 := TListByte.Create;
107 try
108 Data.WriteVarUInt(Integer(Command));
109 Data.Stream.Position := 0;
110 Data.ReadVarList(Data2);
111 Pin.Send(Data2);
112 finally
113 Data2.Free;
114 Data.Free;
115 end;
116end;
117
118constructor TGameProtocolServer.Create;
119begin
120 Pin := TCommPin.Create;
121 Pin.OnReceive := Receive;
122end;
123
124destructor TGameProtocolServer.Destroy;
125begin
126 Pin.Free;
127 inherited Destroy;
128end;
129
130procedure TGameProtocolServer.GameStart;
131begin
132 SendCmd(cmdGameStart);
133end;
134
135procedure TGameProtocolServer.GameEnd;
136begin
137 SendCmd(cmdGameEnd);
138end;
139
140procedure TGameProtocolServer.TurnStart;
141begin
142 SendCmd(cmdTurnStart);
143end;
144
145procedure TGameProtocolServer.ParametersChanged;
146begin
147 SendCmd(cmdParametersChanged);
148end;
149
150procedure TGameProtocolServer.NextPlayer;
151begin
152 SendCmd(cmdNextPlayer);
153end;
154
155{ TGameProtocol }
156
157procedure TGameProtocolClient.Receive(Sender: TCommPin; Stream: TListByte);
158var
159 Data: TVarBlockSerializer;
160 Command: Integer;
161begin
162 Data := TVarBlockSerializer.Create;
163 Data.WriteVarList(Stream);
164 Data.Stream.Position := 0;
165 Command := Data.ReadVarUInt;
166 try
167 if Command = Integer(cmdGameStart) then begin
168 if Assigned(FOnGameStart) then FOnGameStart(Self);
169 end else
170 if Command = Integer(cmdGameEnd) then begin
171 if Assigned(FOnGameEnd) then FOnGameEnd(Self);
172 end else
173 if Command = Integer(cmdTurnStart) then begin
174 if Assigned(FOnTurnStart) then FOnTurnStart(Self);
175 end else
176 if Command = Integer(cmdNextPlayer) then begin
177 if Assigned(FOnNextPlayer) then FOnNextPlayer(Self);
178 end else
179 if Command = Integer(cmdParametersChanged) then begin
180 if Assigned(FOnParametersChanged) then FOnParametersChanged(Self);
181 end;
182 finally
183 Data.Free;
184 end;
185end;
186
187procedure TGameProtocolClient.SendCmd(Command: TCommand);
188var
189 Data: TVarBlockSerializer;
190 Data2: TListByte;
191begin
192 Data := TVarBlockSerializer.Create;
193 Data2 := TListByte.Create;
194 try
195 Data.WriteVarUInt(Integer(Command));
196 Data.Stream.Position := 0;
197 Data.ReadVarList(Data2);
198 Pin.Send(Data2);
199 finally
200 Data2.Free;
201 Data.Free;
202 end;
203end;
204
205procedure TGameProtocolClient.TurnEnd;
206begin
207 SendCmd(cmdTurnEnd);
208end;
209
210procedure TGameProtocolClient.Surrender;
211begin
212 SendCmd(cmdSurrender);
213end;
214
215procedure TGameProtocolClient.SendMessage(Text: string);
216var
217 Data: TVarBlockSerializer;
218 Data2: TListByte;
219begin
220 Data := TVarBlockSerializer.Create;
221 Data2 := TListByte.Create;
222 try
223 Data.WriteVarUInt(Integer(cmdTextMessage));
224 Data.WriteVarString(Text);
225 Data.Stream.Position := 0;
226 Data.ReadVarList(Data2);
227 Pin.Send(Data2);
228 finally
229 Data2.Free;
230 Data.Free;
231 end;
232end;
233
234constructor TGameProtocolClient.Create;
235begin
236 Pin := TCommPin.Create;
237 Pin.OnReceive := Receive;
238end;
239
240destructor TGameProtocolClient.Destroy;
241begin
242 Pin.Free;
243 inherited Destroy;
244end;
245
246end.
247
Note: See TracBrowser for help on using the repository browser.