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