--- a/hedgewars/uFLGameConfig.pas Sun Dec 17 00:09:24 2017 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,688 +0,0 @@
-unit uFLGameConfig;
-interface
-uses uFLTypes;
-
-procedure resetGameConfig; cdecl;
-procedure runQuickGame; cdecl;
-procedure runLocalGame; cdecl;
-procedure getPreview; cdecl;
-
-procedure setSeed(seed: PChar); cdecl;
-function getSeed: PChar; cdecl;
-procedure setTheme(themeName: PChar); cdecl;
-procedure setScript(scriptName: PChar); cdecl;
-procedure setScheme(schemeName: PChar); cdecl;
-procedure setAmmo(ammoName: PChar); cdecl;
-
-procedure tryAddTeam(teamName: PChar); cdecl;
-procedure tryRemoveTeam(teamName: PChar); cdecl;
-procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl;
-
-procedure netSetSeed(seed: shortstring);
-procedure netSetTheme(themeName: shortstring);
-procedure netSetScript(scriptName: shortstring);
-procedure netSetFeatureSize(fsize: LongInt);
-procedure netSetMapGen(mapgen: LongInt);
-procedure netSetMap(map: shortstring);
-procedure netSetMazeSize(mazesize: LongInt);
-procedure netSetTemplate(template: LongInt);
-procedure netSetAmmo(name: shortstring; definition: ansistring);
-procedure netSetScheme(scheme: TScheme);
-procedure netAddTeam(team: TTeam);
-procedure netAcceptedTeam(teamName: shortstring);
-procedure netSetTeamColor(team: shortstring; color: Longword);
-procedure netSetHedgehogsNumber(team: shortstring; hogsNumber: Longword);
-procedure netRemoveTeam(teamName: shortstring);
-procedure netDrawnData(data: ansistring);
-procedure netResetTeams();
-procedure updatePreviewIfNeeded;
-
-procedure sendConfig(config: PGameConfig);
-procedure runNetGame();
-
-implementation
-uses uFLIPC, uFLUtils, uFLTeams, uFLThemes, uFLSChemes, uFLAmmo
- , uFLUICallback, uFLRunQueue, uFLNet, uUtils, uFLDrawnMap
- , SDLh;
-
-var
- currentConfig: TGameConfig;
- previewNeedsUpdate: boolean;
-
-function getScriptPath(scriptName: shortstring): shortstring;
-begin
- getScriptPath:= '/Scripts/Multiplayer/' + scriptName + '.lua'
-end;
-
-procedure sendDrawnMap(config: PGameConfig);
-var i: Longword;
- data: PByteArray;
- dataLen: Longword;
- s: shortstring;
-begin
- decodeDrawnMap(config^.drawnData, config^.drawnDataSize, data, dataLen);
-
- i:= 0;
-
- s[0]:= #240;
- while i < dataLen do
- begin
- if dataLen - i > 240 then
- begin
- Move(data^[i], s[1], 240)
- end else
- begin
- Move(data^[i], s[1], dataLen - i);
- s[0]:= char(dataLen - i)
- end;
-
- ipcToEngine('edraw ' + s);
- inc(i, 240)
- end;
-
- if dataLen > 0 then
- FreeMem(data, dataLen);
-end;
-
-procedure sendConfig(config: PGameConfig);
-var i: Longword;
-begin
-with config^ do
-begin
- case gameType of
- gtPreview: begin
- if script <> 'Normal' then
- ipcToEngine('escript ' + getScriptPath(script));
- ipcToEngine('eseed ' + seed);
- ipcToEngine('e$mapgen ' + intToStr(mapgen));
- if (mapgen = 1) or (mapgen = 2) then
- ipcToEngine('e$maze_size ' + intToStr(mazeSize))
- else
- ipcToEngine('e$template_filter ' + intToStr(template));
- ipcToEngine('e$feature_size ' + intToStr(featureSize));
- if mapgen = 3 then
- sendDrawnMap(config);
- end;
-gtLocal, gtNet: begin
- if gameType = gtNet then
- ipcToEngine('TN');
- if script <> 'Normal' then
- ipcToEngine('escript ' + getScriptPath(script));
- ipcToEngine('eseed ' + seed);
- ipcToEngine('e$mapgen ' + intToStr(mapgen));
- if (mapgen = 1) or (mapgen = 2) then
- ipcToEngine('e$maze_size ' + intToStr(mazeSize))
- else
- ipcToEngine('e$template_filter ' + intToStr(template));
- ipcToEngine('e$feature_size ' + intToStr(featureSize));
- ipcToEngine('e$theme ' + theme);
- if mapgen = 3 then
- sendDrawnMap(config);
-
- sendSchemeConfig(scheme);
-
- i:= 0;
- while (i < 8) and (teams[i].hogsNumber > 0) do
- begin
- sendTeamConfig(config^.scheme.health, teams[i]);
- sendAmmoConfig(config^.ammo);
- inc(i)
- end;
- end;
- end;
-
- ipcToEngine('!');
-end;
-end;
-
-procedure resetGameConfig; cdecl;
-var i: Longword;
-begin
- with currentConfig do
- begin
- script:= 'Normal';
-
- for i:= 0 to 7 do
- teams[i].hogsNumber:= 0
- end
-end;
-
-procedure setSeed(seed: PChar); cdecl;
-begin
- sendUI(mtSeed, @seed[1], length(seed));
- currentConfig.seed:= seed
-end;
-
-function getSeed: PChar; cdecl;
-begin
- getSeed:= str2PChar(currentConfig.seed)
-end;
-
-function getUnusedColor: Longword;
-var i, c: Longword;
- fColorMatched: boolean;
-begin
- c:= 0;
- i:= 0;
- repeat
- repeat
- fColorMatched:= (currentConfig.teams[i].hogsNumber > 0) and (currentConfig.teams[i].color = c);
- inc(i)
- until (i >= 8) or (currentConfig.teams[i].hogsNumber = 0) or fColorMatched;
-
- if fColorMatched then
- begin
- i:= 0;
- inc(c)
- end;
- until not fColorMatched;
-
- getUnusedColor:= c
-end;
-
-procedure runQuickGame; cdecl;
-begin
- with currentConfig do
- begin
- gameType:= gtLocal;
- arguments[0]:= '';
- arguments[1]:= '--internal';
- arguments[2]:= '--nomusic';
- argumentsNumber:= 3;
-
- teams[0]:= createRandomTeam;
- teams[0].color:= 0;
- teams[1]:= createRandomTeam;
- teams[1].color:= 1;
- teams[1].botLevel:= 3;
-
- queueExecution(currentConfig);
- end;
-end;
-
-
-procedure getPreview; cdecl;
-begin
- previewNeedsUpdate:= false;
-
- with currentConfig do
- begin
- gameType:= gtPreview;
- arguments[0]:= '';
- arguments[1]:= '--internal';
- arguments[2]:= '--landpreview';
- argumentsNumber:= 3;
-
- queueExecution(currentConfig);
- end;
-end;
-
-procedure runLocalGame; cdecl;
-begin
- with currentConfig do
- begin
- gameType:= gtLocal;
- arguments[0]:= '';
- arguments[1]:= '--internal';
- arguments[2]:= '--nomusic';
- argumentsNumber:= 3;
-
- queueExecution(currentConfig);
- end;
-end;
-
-procedure runNetGame();
-begin
- with currentConfig do
- begin
- gameType:= gtNet;
- arguments[0]:= '';
- arguments[1]:= '--internal';
- arguments[2]:= '--nomusic';
- argumentsNumber:= 3;
-
- queueExecution(currentConfig);
- end;
-end;
-
-procedure tryAddTeam(teamName: PChar); cdecl;
-var msg: ansistring;
- i, hn, hedgehogsNumber: Longword;
- team: PTeam;
- c: Longword;
-begin
- team:= teamByName(teamName);
- if team = nil then exit;
-
- if isConnected then
- sendTeam(team^)
- else
- with currentConfig do
- begin
- hedgehogsNumber:= 0;
- i:= 0;
-
- while (i < 8) and (teams[i].hogsNumber > 0) do
- begin
- inc(i);
- inc(hedgehogsNumber, teams[i].hogsNumber)
- end;
-
- // no free space for a team or reached hogs number maximum
- if (i > 7) or (hedgehogsNumber >= 48) then exit;
-
- c:= getUnusedColor;
-
- teams[i]:= team^;
- teams[i].extDriven:= false;
-
- if i = 0 then hn:= 4 else hn:= teams[i - 1].hogsNumber;
- if hn > 48 - hedgehogsNumber then hn:= 48 - hedgehogsNumber;
- teams[i].hogsNumber:= hn;
-
- teams[i].color:= c;
-
- msg:= '0' + #10 + teamName;
- sendUI(mtAddPlayingTeam, @msg[1], length(msg));
-
- msg:= teamName + #10 + colorsSet[teams[i].color];
- sendUI(mtTeamColor, @msg[1], length(msg));
-
- msg:= teamName + #10 + IntToStr(hn);
- sendUI(mtHedgehogsNumber, @msg[1], length(msg));
-
- msg:= teamName;
- sendUI(mtRemoveTeam, @msg[1], length(msg))
- end
-end;
-
-
-procedure tryRemoveTeam(teamName: PChar); cdecl;
-var i: Longword;
- tn: shortstring;
- isLocal: boolean;
-begin
- with currentConfig do
- begin
- i:= 0;
- tn:= teamName;
- while (i < 8) and (teams[i].teamName <> tn) do
- inc(i);
-
- // team not found???
- if (i > 7) then exit;
-
- isLocal:= not teams[i].extDriven;
-
- if isConnected and not isLocal then
- exit; // we cannot remove this team
-
- while (i < 7) and (teams[i + 1].hogsNumber > 0) do
- begin
- teams[i]:= teams[i + 1];
- inc(i)
- end;
-
- teams[i].hogsNumber:= 0
- end;
-
- sendUI(mtRemovePlayingTeam, @tn[1], length(tn));
- if isConnected then
- removeTeam(tn);
- if isLocal then
- sendUI(mtAddTeam, @tn[1], length(tn))
-end;
-
-
-procedure changeTeamColor(teamName: PChar; dir: LongInt); cdecl;
-var i, dc: Longword;
- tn: shortstring;
- msg: ansistring;
-begin
- with currentConfig do
- begin
- i:= 0;
- tn:= teamName;
- while (i < 8) and (teams[i].teamName <> tn) do
- inc(i);
- // team not found???
- if (i > 7) then exit;
-
- if dir >= 0 then dc:= 1 else dc:= 8;
- teams[i].color:= (teams[i].color + dc) mod 9;
-
- msg:= tn + #10 + colorsSet[teams[i].color];
- sendUI(mtTeamColor, @msg[1], length(msg))
- end
-end;
-
-procedure setTheme(themeName: PChar); cdecl;
-begin
- currentConfig.theme:= themeName
-end;
-
-procedure setScript(scriptName: PChar); cdecl;
-begin
- currentConfig.script:= scriptName
-end;
-
-procedure setScheme(schemeName: PChar); cdecl;
-var scheme: PScheme;
-begin
- scheme:= schemeByName(schemeName);
-
- if scheme <> nil then
- currentConfig.scheme:= scheme^
-end;
-
-procedure setAmmo(ammoName: PChar); cdecl;
-var ammo: PAmmo;
-begin
- ammo:= ammoByName(ammoName);
-
- if ammo <> nil then
- currentConfig.ammo:= ammo^
-end;
-
-procedure netSetSeed(seed: shortstring);
-begin
- if seed <> currentConfig.seed then
- begin
- currentConfig.seed:= seed;
- sendUI(mtSeed, @seed[1], length(seed));
-
- getPreview()
- end
-end;
-
-procedure netSetTheme(themeName: shortstring);
-begin
- if themeName <> currentConfig.theme then
- begin
- currentConfig.theme:= themeName;
- sendUI(mtTheme, @themeName[1], length(themeName))
- end
-end;
-
-procedure netSetScript(scriptName: shortstring);
-begin
- if scriptName <> currentConfig.script then
- begin
- previewNeedsUpdate:= true;
- currentConfig.script:= scriptName;
- sendUI(mtScript, @scriptName[1], length(scriptName))
- end
-end;
-
-procedure netSetFeatureSize(fsize: LongInt);
-var s: shortstring;
-begin
- if fsize <> currentConfig.featureSize then
- begin
- previewNeedsUpdate:= true;
- currentConfig.featureSize:= fsize;
- s:= IntToStr(fsize);
- sendUI(mtFeatureSize, @s[1], length(s))
- end
-end;
-
-procedure netSetMapGen(mapgen: LongInt);
-var s: shortstring;
-begin
- if mapgen <> currentConfig.mapgen then
- begin
- previewNeedsUpdate:= true;
- currentConfig.mapgen:= mapgen;
- s:= IntToStr(mapgen);
- sendUI(mtMapGen, @s[1], length(s))
- end
-end;
-
-procedure netSetMap(map: shortstring);
-begin
- sendUI(mtMap, @map[1], length(map))
-end;
-
-procedure netSetMazeSize(mazesize: LongInt);
-var s: shortstring;
-begin
- if mazesize <> currentConfig.mazesize then
- begin
- previewNeedsUpdate:= true;
- currentConfig.mazesize:= mazesize;
- s:= IntToStr(mazesize);
- sendUI(mtMazeSize, @s[1], length(s))
- end
-end;
-
-procedure netSetTemplate(template: LongInt);
-var s: shortstring;
-begin
- if template <> currentConfig.template then
- begin
- previewNeedsUpdate:= true;
- currentConfig.template:= template;
- s:= IntToStr(template);
- sendUI(mtTemplate, @s[1], length(s))
- end
-end;
-
-procedure updatePreviewIfNeeded;
-begin
- if previewNeedsUpdate then
- getPreview
-end;
-
-procedure netSetAmmo(name: shortstring; definition: ansistring);
-var ammo: TAmmo;
- i: LongInt;
-begin
- ammo.ammoName:= name;
- i:= length(definition) div 4;
- ammo.a:= copy(definition, 1, i);
- ammo.b:= copy(definition, i + 1, i);
- ammo.c:= copy(definition, i * 2 + 1, i);
- ammo.d:= copy(definition, i * 3 + 1, i);
-
- currentConfig.ammo:= ammo;
- sendUI(mtAmmo, @name[1], length(name))
-end;
-
-procedure netSetScheme(scheme: TScheme);
-begin
- currentConfig.scheme:= scheme;
- sendUI(mtScheme, @scheme.schemeName[1], length(scheme.schemeName))
-end;
-
-procedure netAddTeam(team: TTeam);
-var msg: ansistring;
- i, hn, hedgehogsNumber: Longword;
- c: Longword;
-begin
- with currentConfig do
- begin
- hedgehogsNumber:= 0;
- i:= 0;
-
- while (i < 8) and (teams[i].hogsNumber > 0) do
- begin
- inc(i);
- inc(hedgehogsNumber, teams[i].hogsNumber)
- end;
-
- // no free space for a team - server bug???
- if (i > 7) or (hedgehogsNumber >= 48) then exit;
-
- c:= getUnusedColor;
-
- teams[i]:= team;
- teams[i].extDriven:= true;
-
- if i = 0 then hn:= 4 else hn:= teams[i - 1].hogsNumber;
- if hn > 48 - hedgehogsNumber then hn:= 48 - hedgehogsNumber;
- teams[i].hogsNumber:= hn;
-
- teams[i].color:= c;
-
- msg:= '0' + #10 + team.teamName;
- sendUI(mtAddPlayingTeam, @msg[1], length(msg));
-
- msg:= team.teamName + #10 + colorsSet[teams[i].color];
- sendUI(mtTeamColor, @msg[1], length(msg));
- end
-end;
-
-procedure netAcceptedTeam(teamName: shortstring);
-var msg: ansistring;
- i, hn, hedgehogsNumber: Longword;
- c: Longword;
- team: PTeam;
-begin
- with currentConfig do
- begin
- team:= teamByName(teamName);
- // no such team???
- if team = nil then exit;
-
- hedgehogsNumber:= 0;
- i:= 0;
-
- while (i < 8) and (teams[i].hogsNumber > 0) do
- begin
- inc(i);
- inc(hedgehogsNumber, teams[i].hogsNumber)
- end;
-
- // no free space for a team - server bug???
- if (i > 7) or (hedgehogsNumber >= 48) then exit;
-
- c:= getUnusedColor;
-
- teams[i]:= team^;
- teams[i].extDriven:= false;
-
- if i = 0 then hn:= 4 else hn:= teams[i - 1].hogsNumber;
- if hn > 48 - hedgehogsNumber then hn:= 48 - hedgehogsNumber;
- teams[i].hogsNumber:= hn;
-
- teams[i].color:= c;
-
- msg:= '0' + #10 + teamName;
- sendUI(mtAddPlayingTeam, @msg[1], length(msg));
-
- msg:= teamName + #10 + colorsSet[teams[i].color];
- sendUI(mtTeamColor, @msg[1], length(msg));
-
- msg:= teamName;
- sendUI(mtRemoveTeam, @msg[1], length(msg))
- end
-end;
-
-procedure netRemoveTeam(teamName: shortstring);
-var msg: shortstring;
- i: Longword;
- tn: shortstring;
- isLocal: boolean;
-begin
- with currentConfig do
- begin
- i:= 0;
- tn:= teamName;
- while (i < 8) and (teams[i].teamName <> tn) do
- inc(i);
-
- // team not found???
- if (i > 7) then exit;
-
- isLocal:= not teams[i].extDriven;
-
- while (i < 7) and (teams[i + 1].hogsNumber > 0) do
- begin
- teams[i]:= teams[i + 1];
- inc(i)
- end;
-
- teams[i].hogsNumber:= 0
- end;
-
- msg:= teamName;
-
- sendUI(mtRemovePlayingTeam, @msg[1], length(msg));
- if isLocal then
- sendUI(mtAddTeam, @msg[1], length(msg))
-end;
-
-procedure netSetTeamColor(team: shortstring; color: Longword);
-var i: Longword;
- msg: ansistring;
-begin
- with currentConfig do
- begin
- i:= 0;
-
- while (i < 8) and (teams[i].teamName <> team) do
- inc(i);
- // team not found???
- if (i > 7) then exit;
-
- teams[i].color:= color mod 9;
-
- msg:= team + #10 + colorsSet[teams[i].color];
- sendUI(mtTeamColor, @msg[1], length(msg))
- end
-end;
-
-procedure netSetHedgehogsNumber(team: shortstring; hogsNumber: Longword);
-var i: Longword;
- msg: ansistring;
-begin
- if hogsNumber > 8 then exit;
-
- with currentConfig do
- begin
- i:= 0;
-
- while (i < 8) and (teams[i].teamName <> team) do
- inc(i);
- // team not found???
- if (i > 7) then exit;
-
- teams[i].hogsNumber:= hogsNumber;
-
- msg:= team + #10 + IntToStr(hogsNumber);
- sendUI(mtHedgehogsNumber, @msg[1], length(msg))
- end
-end;
-
-procedure netResetTeams();
-var msg: shortstring;
- i: Longword;
-begin
- with currentConfig do
- begin
- i:= 0;
-
- while (i < 8) and (teams[i].hogsNumber > 0) do
- begin
- msg:= teams[i].teamName;
-
- sendUI(mtRemovePlayingTeam, @msg[1], length(msg));
- if not teams[i].extDriven then
- sendUI(mtAddTeam, @msg[1], length(msg));
-
- teams[i].hogsNumber:= 0;
- inc(i)
- end;
-
- end;
-end;
-
-procedure netDrawnData(data: ansistring);
-begin
- currentConfig.drawnDataSize:= length(data);
- currentConfig.drawnData:= data;
-
- getPreview
-end;
-
-end.