author | unc0rr |
Sat, 26 Dec 2015 22:29:57 +0300 | |
branch | qmlfrontend |
changeset 11462 | 33a0e3a14ddc |
parent 11458 | 8318e841648f |
child 11480 | b0c34402038c |
permissions | -rw-r--r-- |
10406 | 1 |
unit uFLGameConfig; |
2 |
interface |
|
10428
7c25297720f1
More refactoring: move PoC preview getting code into flib
unc0rr
parents:
10426
diff
changeset
|
3 |
uses uFLTypes; |
10406 | 4 |
|
10430 | 5 |
procedure resetGameConfig; cdecl; |
6 |
procedure runQuickGame; cdecl; |
|
10448 | 7 |
procedure runLocalGame; cdecl; |
10430 | 8 |
procedure getPreview; cdecl; |
10406 | 9 |
|
10430 | 10 |
procedure setSeed(seed: PChar); cdecl; |
11 |
function getSeed: PChar; cdecl; |
|
10456 | 12 |
procedure setTheme(themeName: PChar); cdecl; |
10612 | 13 |
procedure setScript(scriptName: PChar); cdecl; |
10819
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
14 |
procedure setScheme(schemeName: PChar); cdecl; |
10888 | 15 |
procedure setAmmo(ammoName: PChar); cdecl; |
10428
7c25297720f1
More refactoring: move PoC preview getting code into flib
unc0rr
parents:
10426
diff
changeset
|
16 |
|
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
17 |
procedure tryAddTeam(teamName: PChar); cdecl; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
18 |
procedure tryRemoveTeam(teamName: PChar); cdecl; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
19 |
procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl; |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
20 |
|
11431 | 21 |
procedure netSetSeed(seed: shortstring); |
22 |
procedure netSetTheme(themeName: shortstring); |
|
23 |
procedure netSetScript(scriptName: shortstring); |
|
11433 | 24 |
procedure netSetFeatureSize(fsize: LongInt); |
25 |
procedure netSetMapGen(mapgen: LongInt); |
|
26 |
procedure netSetMap(map: shortstring); |
|
27 |
procedure netSetMazeSize(mazesize: LongInt); |
|
28 |
procedure netSetTemplate(template: LongInt); |
|
11437 | 29 |
procedure netSetAmmo(name: shortstring; definition: ansistring); |
11440 | 30 |
procedure netSetScheme(scheme: TScheme); |
11442 | 31 |
procedure netAddTeam(team: TTeam); |
11444 | 32 |
procedure netAcceptedTeam(teamName: shortstring); |
11442 | 33 |
procedure netSetTeamColor(team: shortstring; color: Longword); |
11443 | 34 |
procedure netSetHedgehogsNumber(team: shortstring; hogsNumber: Longword); |
35 |
procedure netRemoveTeam(teamName: shortstring); |
|
11462 | 36 |
procedure netDrawnData(data: ansistring); |
11443 | 37 |
procedure netResetTeams(); |
11433 | 38 |
procedure updatePreviewIfNeeded; |
11431 | 39 |
|
11434 | 40 |
procedure sendConfig(config: PGameConfig); |
11451 | 41 |
procedure runNetGame(); |
10426 | 42 |
|
11434 | 43 |
implementation |
11462 | 44 |
uses uFLIPC, uFLUtils, uFLTeams, uFLThemes, uFLSChemes, uFLAmmo |
45 |
, uFLUICallback, uFLRunQueue, uFLNet, uUtils; |
|
10426 | 46 |
|
10432 | 47 |
var |
48 |
currentConfig: TGameConfig; |
|
11433 | 49 |
previewNeedsUpdate: boolean; |
10432 | 50 |
|
11431 | 51 |
function getScriptPath(scriptName: shortstring): shortstring; |
52 |
begin |
|
53 |
getScriptPath:= '/Scripts/Multiplayer/' + scriptName + '.lua' |
|
54 |
end; |
|
10430 | 55 |
|
11462 | 56 |
procedure sendDrawnMap(config: PGameConfig); |
57 |
var i: Longword; |
|
58 |
s: shortstring; |
|
59 |
begin |
|
60 |
i:= 1; |
|
61 |
||
62 |
while i < config^.drawnDataSize do |
|
63 |
begin |
|
64 |
if config^.drawnDataSize - i > 240 then |
|
65 |
s:= copy(config^.drawnData, i, 240) |
|
66 |
else |
|
67 |
s:= copy(config^.drawnData, i, config^.drawnDataSize - i); |
|
68 |
system.writeln('[DRAWN MAP] ', s); |
|
69 |
ipcToEngine('edraw ' + DecodeBase64(s)); |
|
70 |
inc(i, 240) |
|
71 |
end; |
|
72 |
end; |
|
73 |
||
10432 | 74 |
procedure sendConfig(config: PGameConfig); |
75 |
var i: Longword; |
|
76 |
begin |
|
77 |
with config^ do |
|
10430 | 78 |
begin |
10432 | 79 |
case gameType of |
80 |
gtPreview: begin |
|
11431 | 81 |
if script <> 'Normal' then |
82 |
ipcToEngine('escript ' + getScriptPath(script)); |
|
10432 | 83 |
ipcToEngine('eseed ' + seed); |
84 |
ipcToEngine('e$mapgen ' + intToStr(mapgen)); |
|
11447
2572afe532af
Don't send maze_size parameter when not needed, as it overwrites template_filter
unc0rr
parents:
11446
diff
changeset
|
85 |
if (mapgen = 1) or (mapgen = 2) then |
11450
0c75fa9ce340
- Use queues instead of single buffer to communicate between threads
unc0rr
parents:
11447
diff
changeset
|
86 |
ipcToEngine('e$maze_size ' + intToStr(mazeSize)) |
11447
2572afe532af
Don't send maze_size parameter when not needed, as it overwrites template_filter
unc0rr
parents:
11446
diff
changeset
|
87 |
else |
2572afe532af
Don't send maze_size parameter when not needed, as it overwrites template_filter
unc0rr
parents:
11446
diff
changeset
|
88 |
ipcToEngine('e$template_filter ' + intToStr(template)); |
11434 | 89 |
ipcToEngine('e$feature_size ' + intToStr(featureSize)); |
11462 | 90 |
if mapgen = 3 then |
91 |
sendDrawnMap(config); |
|
10432 | 92 |
end; |
11454 | 93 |
gtLocal, gtNet: begin |
94 |
if gameType = gtNet then |
|
95 |
ipcToEngine('TN'); |
|
11431 | 96 |
if script <> 'Normal' then |
97 |
ipcToEngine('escript ' + getScriptPath(script)); |
|
10432 | 98 |
ipcToEngine('eseed ' + seed); |
99 |
ipcToEngine('e$mapgen ' + intToStr(mapgen)); |
|
11447
2572afe532af
Don't send maze_size parameter when not needed, as it overwrites template_filter
unc0rr
parents:
11446
diff
changeset
|
100 |
if (mapgen = 1) or (mapgen = 2) then |
11450
0c75fa9ce340
- Use queues instead of single buffer to communicate between threads
unc0rr
parents:
11447
diff
changeset
|
101 |
ipcToEngine('e$maze_size ' + intToStr(mazeSize)) |
11447
2572afe532af
Don't send maze_size parameter when not needed, as it overwrites template_filter
unc0rr
parents:
11446
diff
changeset
|
102 |
else |
2572afe532af
Don't send maze_size parameter when not needed, as it overwrites template_filter
unc0rr
parents:
11446
diff
changeset
|
103 |
ipcToEngine('e$template_filter ' + intToStr(template)); |
11434 | 104 |
ipcToEngine('e$feature_size ' + intToStr(featureSize)); |
10456 | 105 |
ipcToEngine('e$theme ' + theme); |
11462 | 106 |
if mapgen = 3 then |
107 |
sendDrawnMap(config); |
|
10612 | 108 |
|
10819
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
109 |
sendSchemeConfig(scheme); |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
110 |
|
10432 | 111 |
i:= 0; |
112 |
while (i < 8) and (teams[i].hogsNumber > 0) do |
|
113 |
begin |
|
11458 | 114 |
sendTeamConfig(config^.scheme.health, teams[i]); |
10892 | 115 |
sendAmmoConfig(config^.ammo); |
10432 | 116 |
inc(i) |
117 |
end; |
|
118 |
end; |
|
119 |
end; |
|
120 |
||
121 |
ipcToEngine('!'); |
|
122 |
end; |
|
123 |
end; |
|
10426 | 124 |
|
125 |
procedure resetGameConfig; cdecl; |
|
10450 | 126 |
var i: Longword; |
10406 | 127 |
begin |
10450 | 128 |
with currentConfig do |
129 |
begin |
|
11431 | 130 |
script:= 'Normal'; |
131 |
||
10450 | 132 |
for i:= 0 to 7 do |
133 |
teams[i].hogsNumber:= 0 |
|
134 |
end |
|
10406 | 135 |
end; |
136 |
||
10430 | 137 |
procedure setSeed(seed: PChar); cdecl; |
138 |
begin |
|
11431 | 139 |
sendUI(mtSeed, @seed[1], length(seed)); |
10430 | 140 |
currentConfig.seed:= seed |
141 |
end; |
|
142 |
||
143 |
function getSeed: PChar; cdecl; |
|
144 |
begin |
|
145 |
getSeed:= str2PChar(currentConfig.seed) |
|
146 |
end; |
|
147 |
||
10450 | 148 |
function getUnusedColor: Longword; |
10448 | 149 |
var i, c: Longword; |
150 |
fColorMatched: boolean; |
|
151 |
begin |
|
152 |
c:= 0; |
|
153 |
i:= 0; |
|
154 |
repeat |
|
155 |
repeat |
|
10450 | 156 |
fColorMatched:= (currentConfig.teams[i].hogsNumber > 0) and (currentConfig.teams[i].color = c); |
10448 | 157 |
inc(i) |
158 |
until (i >= 8) or (currentConfig.teams[i].hogsNumber = 0) or fColorMatched; |
|
159 |
||
160 |
if fColorMatched then |
|
161 |
begin |
|
162 |
i:= 0; |
|
163 |
inc(c) |
|
164 |
end; |
|
165 |
until not fColorMatched; |
|
166 |
||
10450 | 167 |
getUnusedColor:= c |
10448 | 168 |
end; |
169 |
||
10430 | 170 |
procedure runQuickGame; cdecl; |
10426 | 171 |
begin |
10432 | 172 |
with currentConfig do |
173 |
begin |
|
174 |
gameType:= gtLocal; |
|
175 |
arguments[0]:= ''; |
|
176 |
arguments[1]:= '--internal'; |
|
10448 | 177 |
arguments[2]:= '--nomusic'; |
10432 | 178 |
argumentsNumber:= 3; |
10426 | 179 |
|
10432 | 180 |
teams[0]:= createRandomTeam; |
10450 | 181 |
teams[0].color:= 0; |
10432 | 182 |
teams[1]:= createRandomTeam; |
10450 | 183 |
teams[1].color:= 1; |
11424 | 184 |
teams[1].botLevel:= 3; |
10432 | 185 |
|
11434 | 186 |
queueExecution(currentConfig); |
10432 | 187 |
end; |
10426 | 188 |
end; |
189 |
||
10448 | 190 |
|
10430 | 191 |
procedure getPreview; cdecl; |
10426 | 192 |
begin |
11433 | 193 |
previewNeedsUpdate:= false; |
194 |
||
10426 | 195 |
with currentConfig do |
196 |
begin |
|
197 |
gameType:= gtPreview; |
|
198 |
arguments[0]:= ''; |
|
199 |
arguments[1]:= '--internal'; |
|
200 |
arguments[2]:= '--landpreview'; |
|
201 |
argumentsNumber:= 3; |
|
10428
7c25297720f1
More refactoring: move PoC preview getting code into flib
unc0rr
parents:
10426
diff
changeset
|
202 |
|
11434 | 203 |
queueExecution(currentConfig); |
10426 | 204 |
end; |
10428
7c25297720f1
More refactoring: move PoC preview getting code into flib
unc0rr
parents:
10426
diff
changeset
|
205 |
end; |
10426 | 206 |
|
10448 | 207 |
procedure runLocalGame; cdecl; |
208 |
begin |
|
209 |
with currentConfig do |
|
210 |
begin |
|
211 |
gameType:= gtLocal; |
|
212 |
arguments[0]:= ''; |
|
213 |
arguments[1]:= '--internal'; |
|
214 |
arguments[2]:= '--nomusic'; |
|
215 |
argumentsNumber:= 3; |
|
216 |
||
11434 | 217 |
queueExecution(currentConfig); |
10448 | 218 |
end; |
219 |
end; |
|
220 |
||
11451 | 221 |
procedure runNetGame(); |
222 |
begin |
|
223 |
with currentConfig do |
|
224 |
begin |
|
225 |
gameType:= gtNet; |
|
226 |
arguments[0]:= ''; |
|
227 |
arguments[1]:= '--internal'; |
|
228 |
arguments[2]:= '--nomusic'; |
|
229 |
argumentsNumber:= 3; |
|
230 |
||
231 |
queueExecution(currentConfig); |
|
232 |
end; |
|
233 |
end; |
|
234 |
||
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
235 |
procedure tryAddTeam(teamName: PChar); cdecl; |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
236 |
var msg: ansistring; |
10446 | 237 |
i, hn, hedgehogsNumber: Longword; |
238 |
team: PTeam; |
|
10450 | 239 |
c: Longword; |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
240 |
begin |
11444 | 241 |
team:= teamByName(teamName); |
242 |
if team = nil then exit; |
|
243 |
||
244 |
if isConnected then |
|
245 |
sendTeam(team^) |
|
246 |
else |
|
10446 | 247 |
with currentConfig do |
248 |
begin |
|
249 |
hedgehogsNumber:= 0; |
|
250 |
i:= 0; |
|
251 |
||
252 |
while (i < 8) and (teams[i].hogsNumber > 0) do |
|
253 |
begin |
|
254 |
inc(i); |
|
255 |
inc(hedgehogsNumber, teams[i].hogsNumber) |
|
256 |
end; |
|
257 |
||
258 |
// no free space for a team or reached hogs number maximum |
|
259 |
if (i > 7) or (hedgehogsNumber >= 48) then exit; |
|
260 |
||
10448 | 261 |
c:= getUnusedColor; |
262 |
||
10446 | 263 |
teams[i]:= team^; |
11454 | 264 |
teams[i].extDriven:= false; |
10446 | 265 |
|
266 |
if i = 0 then hn:= 4 else hn:= teams[i - 1].hogsNumber; |
|
267 |
if hn > 48 - hedgehogsNumber then hn:= 48 - hedgehogsNumber; |
|
268 |
teams[i].hogsNumber:= hn; |
|
10448 | 269 |
|
270 |
teams[i].color:= c; |
|
10446 | 271 |
|
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
272 |
msg:= '0' + #10 + teamName; |
10951
89a7f617e091
- Move protocol handling events to main thread through qt's main loop
unc0rr
parents:
10892
diff
changeset
|
273 |
sendUI(mtAddPlayingTeam, @msg[1], length(msg)); |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
274 |
|
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
275 |
msg:= teamName + #10 + colorsSet[teams[i].color]; |
10951
89a7f617e091
- Move protocol handling events to main thread through qt's main loop
unc0rr
parents:
10892
diff
changeset
|
276 |
sendUI(mtTeamColor, @msg[1], length(msg)); |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
277 |
|
11443 | 278 |
msg:= teamName + #10 + IntToStr(hn); |
279 |
sendUI(mtHedgehogsNumber, @msg[1], length(msg)); |
|
280 |
||
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
281 |
msg:= teamName; |
10951
89a7f617e091
- Move protocol handling events to main thread through qt's main loop
unc0rr
parents:
10892
diff
changeset
|
282 |
sendUI(mtRemoveTeam, @msg[1], length(msg)) |
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
283 |
end |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
284 |
end; |
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
285 |
|
10448 | 286 |
|
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
287 |
procedure tryRemoveTeam(teamName: PChar); cdecl; |
11446 | 288 |
var i: Longword; |
10448 | 289 |
tn: shortstring; |
11446 | 290 |
isLocal: boolean; |
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
291 |
begin |
10448 | 292 |
with currentConfig do |
293 |
begin |
|
294 |
i:= 0; |
|
295 |
tn:= teamName; |
|
296 |
while (i < 8) and (teams[i].teamName <> tn) do |
|
297 |
inc(i); |
|
298 |
||
299 |
// team not found??? |
|
300 |
if (i > 7) then exit; |
|
301 |
||
11446 | 302 |
isLocal:= not teams[i].extDriven; |
303 |
||
304 |
if isConnected and not isLocal then |
|
305 |
exit; // we cannot remove this team |
|
306 |
||
10448 | 307 |
while (i < 7) and (teams[i + 1].hogsNumber > 0) do |
308 |
begin |
|
309 |
teams[i]:= teams[i + 1]; |
|
310 |
inc(i) |
|
311 |
end; |
|
312 |
||
313 |
teams[i].hogsNumber:= 0 |
|
314 |
end; |
|
315 |
||
11446 | 316 |
sendUI(mtRemovePlayingTeam, @tn[1], length(tn)); |
317 |
if isConnected then |
|
318 |
removeTeam(tn); |
|
319 |
if isLocal then |
|
320 |
sendUI(mtAddTeam, @tn[1], length(tn)) |
|
10444
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
321 |
end; |
47a6231f1fc1
Teams widget now allows to add and remove teams (basic implementation, no checks performed, no colors, no hedgehogs)
unc0rr
parents:
10432
diff
changeset
|
322 |
|
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
323 |
|
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
324 |
procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
325 |
var i, dc: Longword; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
326 |
tn: shortstring; |
11443 | 327 |
msg: ansistring; |
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
328 |
begin |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
329 |
with currentConfig do |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
330 |
begin |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
331 |
i:= 0; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
332 |
tn:= teamName; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
333 |
while (i < 8) and (teams[i].teamName <> tn) do |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
334 |
inc(i); |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
335 |
// team not found??? |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
336 |
if (i > 7) then exit; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
337 |
|
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
338 |
if dir >= 0 then dc:= 1 else dc:= 8; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
339 |
teams[i].color:= (teams[i].color + dc) mod 9; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
340 |
|
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
341 |
msg:= tn + #10 + colorsSet[teams[i].color]; |
10951
89a7f617e091
- Move protocol handling events to main thread through qt's main loop
unc0rr
parents:
10892
diff
changeset
|
342 |
sendUI(mtTeamColor, @msg[1], length(msg)) |
10452
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
343 |
end |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
344 |
end; |
03519fd9f98d
Show team color in teams list widget, also allow to change it on mouse click
unc0rr
parents:
10450
diff
changeset
|
345 |
|
10456 | 346 |
procedure setTheme(themeName: PChar); cdecl; |
347 |
begin |
|
348 |
currentConfig.theme:= themeName |
|
349 |
end; |
|
350 |
||
10612 | 351 |
procedure setScript(scriptName: PChar); cdecl; |
352 |
begin |
|
11431 | 353 |
currentConfig.script:= scriptName |
10612 | 354 |
end; |
355 |
||
10819
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
356 |
procedure setScheme(schemeName: PChar); cdecl; |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
357 |
var scheme: PScheme; |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
358 |
begin |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
359 |
scheme:= schemeByName(schemeName); |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
360 |
|
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
361 |
if scheme <> nil then |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
362 |
currentConfig.scheme:= scheme^ |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
363 |
end; |
57e21f7621b0
Send selected scheme config on engine initialization (WIP)
unc0rr
parents:
10612
diff
changeset
|
364 |
|
10888 | 365 |
procedure setAmmo(ammoName: PChar); cdecl; |
366 |
var ammo: PAmmo; |
|
367 |
begin |
|
368 |
ammo:= ammoByName(ammoName); |
|
369 |
||
370 |
if ammo <> nil then |
|
10892 | 371 |
currentConfig.ammo:= ammo^ |
10888 | 372 |
end; |
373 |
||
11431 | 374 |
procedure netSetSeed(seed: shortstring); |
375 |
begin |
|
376 |
if seed <> currentConfig.seed then |
|
377 |
begin |
|
378 |
currentConfig.seed:= seed; |
|
11432 | 379 |
sendUI(mtSeed, @seed[1], length(seed)); |
380 |
||
381 |
getPreview() |
|
11431 | 382 |
end |
383 |
end; |
|
384 |
||
385 |
procedure netSetTheme(themeName: shortstring); |
|
386 |
begin |
|
387 |
if themeName <> currentConfig.theme then |
|
388 |
begin |
|
389 |
currentConfig.theme:= themeName; |
|
390 |
sendUI(mtTheme, @themeName[1], length(themeName)) |
|
391 |
end |
|
392 |
end; |
|
393 |
||
394 |
procedure netSetScript(scriptName: shortstring); |
|
395 |
begin |
|
396 |
if scriptName <> currentConfig.script then |
|
397 |
begin |
|
11433 | 398 |
previewNeedsUpdate:= true; |
11431 | 399 |
currentConfig.script:= scriptName; |
400 |
sendUI(mtScript, @scriptName[1], length(scriptName)) |
|
401 |
end |
|
402 |
end; |
|
403 |
||
11433 | 404 |
procedure netSetFeatureSize(fsize: LongInt); |
405 |
var s: shortstring; |
|
406 |
begin |
|
407 |
if fsize <> currentConfig.featureSize then |
|
408 |
begin |
|
409 |
previewNeedsUpdate:= true; |
|
410 |
currentConfig.featureSize:= fsize; |
|
411 |
s:= IntToStr(fsize); |
|
412 |
sendUI(mtFeatureSize, @s[1], length(s)) |
|
413 |
end |
|
414 |
end; |
|
415 |
||
416 |
procedure netSetMapGen(mapgen: LongInt); |
|
417 |
var s: shortstring; |
|
418 |
begin |
|
419 |
if mapgen <> currentConfig.mapgen then |
|
420 |
begin |
|
421 |
previewNeedsUpdate:= true; |
|
422 |
currentConfig.mapgen:= mapgen; |
|
423 |
s:= IntToStr(mapgen); |
|
424 |
sendUI(mtMapGen, @s[1], length(s)) |
|
425 |
end |
|
426 |
end; |
|
427 |
||
428 |
procedure netSetMap(map: shortstring); |
|
429 |
begin |
|
430 |
sendUI(mtMap, @map[1], length(map)) |
|
431 |
end; |
|
432 |
||
433 |
procedure netSetMazeSize(mazesize: LongInt); |
|
434 |
var s: shortstring; |
|
435 |
begin |
|
436 |
if mazesize <> currentConfig.mazesize then |
|
437 |
begin |
|
438 |
previewNeedsUpdate:= true; |
|
439 |
currentConfig.mazesize:= mazesize; |
|
440 |
s:= IntToStr(mazesize); |
|
441 |
sendUI(mtMazeSize, @s[1], length(s)) |
|
442 |
end |
|
443 |
end; |
|
444 |
||
445 |
procedure netSetTemplate(template: LongInt); |
|
446 |
var s: shortstring; |
|
447 |
begin |
|
448 |
if template <> currentConfig.template then |
|
449 |
begin |
|
450 |
previewNeedsUpdate:= true; |
|
451 |
currentConfig.template:= template; |
|
452 |
s:= IntToStr(template); |
|
453 |
sendUI(mtTemplate, @s[1], length(s)) |
|
454 |
end |
|
455 |
end; |
|
456 |
||
457 |
procedure updatePreviewIfNeeded; |
|
458 |
begin |
|
459 |
if previewNeedsUpdate then |
|
460 |
getPreview |
|
461 |
end; |
|
462 |
||
11437 | 463 |
procedure netSetAmmo(name: shortstring; definition: ansistring); |
464 |
var ammo: TAmmo; |
|
465 |
i: LongInt; |
|
466 |
begin |
|
467 |
ammo.ammoName:= name; |
|
468 |
i:= length(definition) div 4; |
|
469 |
ammo.a:= copy(definition, 1, i); |
|
470 |
ammo.b:= copy(definition, i + 1, i); |
|
471 |
ammo.c:= copy(definition, i * 2 + 1, i); |
|
472 |
ammo.d:= copy(definition, i * 3 + 1, i); |
|
473 |
||
474 |
currentConfig.ammo:= ammo; |
|
475 |
sendUI(mtAmmo, @name[1], length(name)) |
|
476 |
end; |
|
477 |
||
11440 | 478 |
procedure netSetScheme(scheme: TScheme); |
479 |
begin |
|
480 |
currentConfig.scheme:= scheme; |
|
481 |
sendUI(mtScheme, @scheme.schemeName[1], length(scheme.schemeName)) |
|
482 |
end; |
|
483 |
||
11442 | 484 |
procedure netAddTeam(team: TTeam); |
485 |
var msg: ansistring; |
|
486 |
i, hn, hedgehogsNumber: Longword; |
|
487 |
c: Longword; |
|
488 |
begin |
|
489 |
with currentConfig do |
|
490 |
begin |
|
491 |
hedgehogsNumber:= 0; |
|
492 |
i:= 0; |
|
493 |
||
494 |
while (i < 8) and (teams[i].hogsNumber > 0) do |
|
495 |
begin |
|
496 |
inc(i); |
|
497 |
inc(hedgehogsNumber, teams[i].hogsNumber) |
|
498 |
end; |
|
499 |
||
500 |
// no free space for a team - server bug??? |
|
501 |
if (i > 7) or (hedgehogsNumber >= 48) then exit; |
|
502 |
||
503 |
c:= getUnusedColor; |
|
504 |
||
505 |
teams[i]:= team; |
|
11444 | 506 |
teams[i].extDriven:= true; |
11442 | 507 |
|
508 |
if i = 0 then hn:= 4 else hn:= teams[i - 1].hogsNumber; |
|
509 |
if hn > 48 - hedgehogsNumber then hn:= 48 - hedgehogsNumber; |
|
510 |
teams[i].hogsNumber:= hn; |
|
511 |
||
512 |
teams[i].color:= c; |
|
513 |
||
514 |
msg:= '0' + #10 + team.teamName; |
|
515 |
sendUI(mtAddPlayingTeam, @msg[1], length(msg)); |
|
516 |
||
517 |
msg:= team.teamName + #10 + colorsSet[teams[i].color]; |
|
518 |
sendUI(mtTeamColor, @msg[1], length(msg)); |
|
519 |
end |
|
520 |
end; |
|
521 |
||
11444 | 522 |
procedure netAcceptedTeam(teamName: shortstring); |
523 |
var msg: ansistring; |
|
524 |
i, hn, hedgehogsNumber: Longword; |
|
525 |
c: Longword; |
|
526 |
team: PTeam; |
|
527 |
begin |
|
528 |
with currentConfig do |
|
529 |
begin |
|
530 |
team:= teamByName(teamName); |
|
531 |
// no such team??? |
|
532 |
if team = nil then exit; |
|
533 |
||
534 |
hedgehogsNumber:= 0; |
|
535 |
i:= 0; |
|
536 |
||
537 |
while (i < 8) and (teams[i].hogsNumber > 0) do |
|
538 |
begin |
|
539 |
inc(i); |
|
540 |
inc(hedgehogsNumber, teams[i].hogsNumber) |
|
541 |
end; |
|
542 |
||
543 |
// no free space for a team - server bug??? |
|
544 |
if (i > 7) or (hedgehogsNumber >= 48) then exit; |
|
545 |
||
546 |
c:= getUnusedColor; |
|
547 |
||
548 |
teams[i]:= team^; |
|
549 |
teams[i].extDriven:= false; |
|
550 |
||
551 |
if i = 0 then hn:= 4 else hn:= teams[i - 1].hogsNumber; |
|
552 |
if hn > 48 - hedgehogsNumber then hn:= 48 - hedgehogsNumber; |
|
553 |
teams[i].hogsNumber:= hn; |
|
554 |
||
555 |
teams[i].color:= c; |
|
556 |
||
557 |
msg:= '0' + #10 + teamName; |
|
558 |
sendUI(mtAddPlayingTeam, @msg[1], length(msg)); |
|
559 |
||
560 |
msg:= teamName + #10 + colorsSet[teams[i].color]; |
|
561 |
sendUI(mtTeamColor, @msg[1], length(msg)); |
|
562 |
||
563 |
msg:= teamName; |
|
564 |
sendUI(mtRemoveTeam, @msg[1], length(msg)) |
|
565 |
end |
|
566 |
end; |
|
567 |
||
11443 | 568 |
procedure netRemoveTeam(teamName: shortstring); |
569 |
var msg: shortstring; |
|
570 |
i: Longword; |
|
571 |
tn: shortstring; |
|
572 |
isLocal: boolean; |
|
573 |
begin |
|
574 |
with currentConfig do |
|
575 |
begin |
|
576 |
i:= 0; |
|
577 |
tn:= teamName; |
|
578 |
while (i < 8) and (teams[i].teamName <> tn) do |
|
579 |
inc(i); |
|
580 |
||
581 |
// team not found??? |
|
582 |
if (i > 7) then exit; |
|
583 |
||
584 |
isLocal:= not teams[i].extDriven; |
|
585 |
||
586 |
while (i < 7) and (teams[i + 1].hogsNumber > 0) do |
|
587 |
begin |
|
588 |
teams[i]:= teams[i + 1]; |
|
589 |
inc(i) |
|
590 |
end; |
|
591 |
||
592 |
teams[i].hogsNumber:= 0 |
|
593 |
end; |
|
594 |
||
595 |
msg:= teamName; |
|
596 |
||
597 |
sendUI(mtRemovePlayingTeam, @msg[1], length(msg)); |
|
598 |
if isLocal then |
|
599 |
sendUI(mtAddTeam, @msg[1], length(msg)) |
|
600 |
end; |
|
601 |
||
11442 | 602 |
procedure netSetTeamColor(team: shortstring; color: Longword); |
603 |
var i: Longword; |
|
11443 | 604 |
msg: ansistring; |
11442 | 605 |
begin |
606 |
with currentConfig do |
|
607 |
begin |
|
608 |
i:= 0; |
|
609 |
||
610 |
while (i < 8) and (teams[i].teamName <> team) do |
|
611 |
inc(i); |
|
612 |
// team not found??? |
|
613 |
if (i > 7) then exit; |
|
614 |
||
615 |
teams[i].color:= color mod 9; |
|
616 |
||
617 |
msg:= team + #10 + colorsSet[teams[i].color]; |
|
618 |
sendUI(mtTeamColor, @msg[1], length(msg)) |
|
619 |
end |
|
620 |
end; |
|
621 |
||
11443 | 622 |
procedure netSetHedgehogsNumber(team: shortstring; hogsNumber: Longword); |
623 |
var i: Longword; |
|
624 |
msg: ansistring; |
|
625 |
begin |
|
626 |
if hogsNumber > 8 then exit; |
|
627 |
||
628 |
with currentConfig do |
|
629 |
begin |
|
630 |
i:= 0; |
|
631 |
||
632 |
while (i < 8) and (teams[i].teamName <> team) do |
|
633 |
inc(i); |
|
634 |
// team not found??? |
|
635 |
if (i > 7) then exit; |
|
636 |
||
637 |
teams[i].hogsNumber:= hogsNumber; |
|
638 |
||
639 |
msg:= team + #10 + IntToStr(hogsNumber); |
|
640 |
sendUI(mtHedgehogsNumber, @msg[1], length(msg)) |
|
641 |
end |
|
642 |
end; |
|
643 |
||
644 |
procedure netResetTeams(); |
|
645 |
var msg: shortstring; |
|
646 |
i: Longword; |
|
647 |
begin |
|
648 |
with currentConfig do |
|
649 |
begin |
|
650 |
i:= 0; |
|
651 |
||
652 |
while (i < 8) and (teams[i].hogsNumber > 0) do |
|
653 |
begin |
|
654 |
msg:= teams[i].teamName; |
|
655 |
||
656 |
sendUI(mtRemovePlayingTeam, @msg[1], length(msg)); |
|
657 |
if not teams[i].extDriven then |
|
658 |
sendUI(mtAddTeam, @msg[1], length(msg)); |
|
659 |
||
660 |
teams[i].hogsNumber:= 0; |
|
661 |
inc(i) |
|
662 |
end; |
|
663 |
||
664 |
end; |
|
665 |
end; |
|
666 |
||
11462 | 667 |
procedure netDrawnData(data: ansistring); |
668 |
begin |
|
669 |
currentConfig.drawnDataSize:= length(data); |
|
670 |
currentConfig.drawnData:= data; |
|
671 |
||
672 |
getPreview |
|
673 |
end; |
|
674 |
||
10406 | 675 |
end. |