author | unc0rr |
Sun, 17 Dec 2017 21:09:59 +0100 | |
branch | qmlfrontend |
changeset 12856 | 95d903b976d0 |
parent 12855 | 1b2b84315d27 |
child 12857 | 90f927b4b9e1 |
hedgewars/hwLibrary.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLAmmo.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLDrawnMap.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLGameConfig.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLNet.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLNetProtocol.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLNetTypes.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLSchemes.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLScripts.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLTeams.pas | file | annotate | diff | comparison | revisions | |
hedgewars/uFLThemes.pas | file | annotate | diff | comparison | revisions |
--- a/hedgewars/hwLibrary.pas Sun Dec 17 00:09:24 2017 +0100 +++ b/hedgewars/hwLibrary.pas Sun Dec 17 21:09:59 2017 +0100 @@ -39,16 +39,8 @@ , uLocale {$IFDEF ANDROID}, jni{$ENDIF} , uFLTypes - , uFLGameConfig , uFLIPC , uPhysFSLayer - , uFLThemes - , uFLTeams - , uFLScripts - , uFLSchemes - , uFLAmmo - , uFLNet - , uFLNetProtocol , uFLUICallback , uFLRunQueue ; @@ -154,50 +146,10 @@ Game; {$ELSE} exports - runQuickGame, - runLocalGame, - getPreview, registerUIMessagesCallback, flibInit, - flibFree, - //game config - resetGameConfig, - setSeed, - getSeed, - setTheme, - setScript, - setScheme, - setAmmo, - getThemesList, - freeThemesList, - getThemeIcon, - getScriptsList, - getSchemesList, - getAmmosList, - getTeamsList, - tryAddTeam, - tryRemoveTeam, - changeTeamColor, - // network - connectOfficialServer, - passNetData, - passToNet, - passFlibEvent, - sendChatLine, - joinRoom, - partRoom, - - // dunno what these are - RunEngine, - LoadLocaleWrapper, - HW_versionInfo, - HW_versionString, - HW_terminate, - HW_getNumberOfWeapons, - HW_getMaxNumberOfHogs, - HW_getMaxNumberOfTeams, - HW_getWeaponNameByIndex, - HW_memoryWarningCallback; + flibFree + ; {$ENDIF} begin
--- a/hedgewars/uFLAmmo.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,136 +0,0 @@ -unit uFLAmmo; -interface -uses uFLTypes; - -function getAmmosList: PPChar; cdecl; -procedure freeAmmosList; - -function ammoByName(s: shortstring): PAmmo; -procedure sendAmmoConfig(var ammo: TAmmo); - -implementation -uses uFLUtils, uFLIPC, uPhysFSLayer, uFLThemes; - -const MAX_AMMO_NAMES = 64; -type - TAmmoArray = array [0..0] of TAmmo; - PAmmoArray = ^TAmmoArray; -var - ammoList: PAmmo; - ammoNumber: LongInt; - listOfAmmoNames: array[0..MAX_AMMO_NAMES] of PChar; - -procedure loadAmmo; -var f: PFSFile; - ammo: PAmmo; - ammos: PAmmoArray; - s: ansistring; - i: Longword; -begin - f:= pfsOpenRead('/Config/weapons.ini'); - ammoNumber:= 0; - - if f <> nil then - begin - while (not pfsEOF(f)) do - begin - pfsReadLnA(f, s); - - if (length(s) > 0) and (s[1] <> '[') then - inc(ammoNumber); - end; - - //inc(ammoNumber); // add some default ammo - - ammoList:= GetMem(sizeof(ammoList^) * (ammoNumber + 1)); - ammo:= PAmmo(ammoList); - pfsSeek(f, 0); - - while (not pfsEOF(f)) do - begin - pfsReadLnA(f, s); - - i:= 1; - while(i <= length(s)) and (s[i] <> '=') do inc(i); - - if i < length(s) then - begin - ammo^.ammoName:= copy(s, 1, i - 1); - delete(s, 1, i); - // TODO: split into 4 shortstrings - i:= length(s) div 4; - ammo^.a:= copy(s, 1, i); - ammo^.b:= copy(s, i + 1, i); - ammo^.c:= copy(s, i * 2 + 1, i); - ammo^.d:= copy(s, i * 3 + 1, i); - inc(ammo) - end; - end; - - pfsClose(f) - end; -end; - - -function getAmmosList: PPChar; cdecl; -var i, t, l: Longword; - ammo: PAmmo; -begin - if ammoList = nil then - loadAmmo; - - t:= ammoNumber; - if t >= MAX_AMMO_NAMES then - t:= MAX_AMMO_NAMES; - - ammo:= ammoList; - for i:= 0 to Pred(t) do - begin - l:= length(ammo^.ammoName); - if l >= 255 then l:= 254; - ammo^.ammoName[l + 1]:= #0; - listOfAmmoNames[i]:= @ammo^.ammoName[1]; - inc(ammo) - end; - - listOfAmmoNames[t]:= nil; - - getAmmosList:= listOfAmmoNames -end; - -function ammoByName(s: shortstring): PAmmo; -var i: Longword; - ammo: PAmmo; -begin - ammo:= ammoList; - i:= 0; - while (i < ammoNumber) and (ammo^.ammoName <> s) do - begin - inc(ammo); - inc(i) - end; - - if i < ammoNumber then ammoByName:= ammo else ammoByName:= nil -end; - -procedure freeAmmosList; -begin - if ammoList <> nil then - FreeMem(ammoList, sizeof(ammoList^) * (ammoNumber + 1)) -end; - - -procedure sendAmmoConfig(var ammo: TAmmo); -var i: Longword; -begin - with ammo do - begin - ipcToEngine('eammloadt ' + ammo.a); - ipcToEngine('eammprob ' + ammo.b); - ipcToEngine('eammdelay ' + ammo.c); - ipcToEngine('eammreinf ' + ammo.d); - ipcToEngine('eammstore'); - end -end; - -end.
--- a/hedgewars/uFLDrawnMap.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -unit uFLDrawnMap; -interface -uses SDLh; - -procedure decodeDrawnMap(data: ansistring; dataSize: Longword; var mapData: PByteArray; var size: Longword); - -implementation -uses uUtils, zlib; - -procedure decodeDrawnMap(data: ansistring; dataSize: Longword; var mapData: PByteArray; var size: Longword); -var i, cl: Longword; - ul: uLong; - s: shortstring; - r: LongInt; - compressedBuf, uncompressedData: PByteArray; -begin - if dataSize = 0 then - begin - mapData:= nil; - size:= 0; - exit; - end; - - compressedBuf:= GetMem(dataSize * 3 div 4); - cl:= 0; - i:= 1; - - while i < dataSize do - begin - if dataSize - i > 240 then - s:= copy(data, i, 240) - else - s:= copy(data, i, dataSize - i + 1); - - s:= DecodeBase64(s); - Move(s[1], compressedBuf^[cl], byte(s[0])); - inc(i, 240); - inc(cl, byte(s[0])); - end; - - ul:= SDLNet_Read32(compressedBuf); - uncompressedData:= GetMem(ul); - r:= uncompress(pBytef(uncompressedData), @ul, @(compressedBuf^[4]), cl - 4); - FreeMem(compressedBuf, dataSize * 3 div 4); - - if r = Z_OK then - begin - mapData:= uncompressedData; - size:= ul - end else - begin - FreeMem(uncompressedData, ul); - mapData:= nil; - size:= 0 - end; -end; - -end.
--- 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.
--- a/hedgewars/uFLNet.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,444 +0,0 @@ -unit uFLNet; -interface -uses SDLh; - -procedure connectOfficialServer; - -procedure initModule; -procedure freeModule; -procedure sendNet(s: shortstring); -procedure sendNetLn(s: shortstring); -procedure passToNet(data: PByteArray; len: Longword); - -var isConnected: boolean = false; - myNickname: shortstring = 'qmlfrontend'; - -implementation -uses uFLIPC, uFLUICallback, uFLNetTypes, uFLUtils, uFLTypes; - -const endCmd: shortstring = #10 + #10; - -function getNextChar: char; forward; -function getCurrChar: char; forward; - -type - TParserState = record - cmd: TCmdType; - l: LongInt; - buf: shortstring; - bufpos: byte; - end; - PHandler = procedure; - -var state: TParserState; - -procedure handleTail; forward; -function getShortString: shortstring; forward; -function getLongString: ansistring; forward; - -procedure handler_; -begin - sendUI(mtNetData, @state.cmd, sizeof(state.cmd)); - handleTail() -end; - -procedure handler_L; -var cmd: TCmdParamL; - s: ansistring; -begin - cmd.cmd:= state.cmd; - s:= getLongString; - cmd.str1len:= length(s); - if cmd.str1len = 0 then exit; - cmd.str1:= s; - sendUI(mtNetData, @cmd, sizeof(cmd)); - handleTail() -end; - -procedure handler_ML; -var cmd: TCmdParamL; - f: boolean; - s: ansistring; -begin - sendUI(mtNetData, @state.cmd, sizeof(state.cmd)); - cmd.cmd:= Succ(state.cmd); - - repeat - s:= getLongString; - cmd.str1len:= length(s); - f:= cmd.str1len <> 0; - - if f then - begin - cmd.str1:= s; - sendUI(mtNetData, @cmd, sizeof(cmd)); - end - until not f; - state.l:= 0 -end; - -procedure handler_MS; -var cmd: TCmdParamS; - f: boolean; -begin - sendUI(mtNetData, @state.cmd, sizeof(state.cmd)); - cmd.cmd:= Succ(state.cmd); - - repeat - cmd.str1:= getShortString; - f:= cmd.str1[0] <> #0; - if f then - sendUI(mtNetData, @cmd, sizeof(cmd)); - until not f; - state.l:= 0 -end; - -procedure handler_S; -var cmd: TCmdParamS; -begin - cmd.cmd:= state.cmd; - cmd.str1:= getShortString; - if cmd.str1[0] = #0 then exit; - sendUI(mtNetData, @cmd, sizeof(cmd)); - handleTail() -end; - -procedure handler_SL; -var cmd: TCmdParamSL; -begin - cmd.cmd:= state.cmd; - cmd.str1:= getShortString; - if cmd.str1[0] = #0 then exit; - cmd.str2:= getLongString; - if cmd.str2[0] = #0 then exit; - sendUI(mtNetData, @cmd, sizeof(cmd)); - handleTail() -end; - -procedure handler_SMS; -var cmd: TCmdParamS; - f: boolean; -begin - cmd.cmd:= state.cmd; - cmd.str1:= getShortString; - if cmd.str1[0] = #0 then exit; - sendUI(mtNetData, @cmd, sizeof(cmd)); - - cmd.cmd:= Succ(state.cmd); - repeat - cmd.str1:= getShortString; - f:= cmd.str1[0] <> #0; - if f then - sendUI(mtNetData, @cmd, sizeof(cmd)); - until not f; - state.l:= 0 -end; - -procedure handler_SS; -var cmd: TCmdParamSS; -begin - cmd.cmd:= state.cmd; - cmd.str1:= getShortString; - if cmd.str1[0] = #0 then exit; - cmd.str2:= getShortString; - if cmd.str2[0] = #0 then exit; - sendUI(mtNetData, @cmd, sizeof(cmd)); - handleTail() -end; - -procedure handler__i; -var cmd: TCmdParami; - s: shortstring; -begin - s:= getShortString(); - if s[0] = #0 then exit; - cmd.cmd:= state.cmd; - s:= getShortString(); - if s[0] = #0 then exit; - cmd.param1:= strToInt(s); - sendUI(mtNetData, @cmd, sizeof(cmd)); - handleTail() -end; - -procedure handler_i; -var cmd: TCmdParami; - s: shortstring; -begin - s:= getShortString(); - if s[0] = #0 then exit; - cmd.cmd:= state.cmd; - cmd.param1:= strToInt(s); - sendUI(mtNetData, @cmd, sizeof(cmd)); - handleTail() -end; - -procedure handler__UNKNOWN_; -begin - //writeln('[NET] Unknown cmd'); - handleTail(); - state.l:= 0 -end; - -const net2cmd: array[0..46] of TCmdType = (cmd_WARNING, cmd_WARNING, - cmd_TEAM_COLOR, cmd_TEAM_ACCEPTED, cmd_SERVER_VARS, cmd_SERVER_MESSAGE, - cmd_SERVER_AUTH, cmd_RUN_GAME, cmd_ROUND_FINISHED, cmd_ROOM_UPD, cmd_ROOM_DEL, - cmd_ROOM_ADD, cmd_ROOMS, cmd_REMOVE_TEAM, cmd_PROTO, cmd_PING, cmd_NOTICE, - cmd_NICK, cmd_LOBBY_LEFT, cmd_LOBBY_JOINED, cmd_LEFT, cmd_KICKED, cmd_JOINING, - cmd_JOINED, cmd_INFO, cmd_HH_NUM, cmd_ERROR, cmd_EM, cmd_CONNECTED, - cmd_CLIENT_FLAGS, cmd_CHAT, cmd_CFG_THEME, cmd_CFG_TEMPLATE, cmd_CFG_SEED, - cmd_CFG_SCRIPT, cmd_CFG_SCHEME, cmd_CFG_MAZE_SIZE, cmd_CFG_MAP, cmd_CFG_MAPGEN, - cmd_CFG_FULLMAPCONFIG, cmd_CFG_FEATURE_SIZE, cmd_CFG_DRAWNMAP, cmd_CFG_AMMO, - cmd_BYE, cmd_BANLIST, cmd_ASKPASSWORD, cmd_ADD_TEAM); -const letters: array[0..332] of char = ('A', 'D', 'D', '_', 'T', 'E', 'A', 'M', - #10, 'S', 'K', 'P', 'A', 'S', 'S', 'W', 'O', 'R', 'D', #10, 'B', 'A', 'N', 'L', - 'I', 'S', 'T', #10, 'Y', 'E', #10, 'C', 'F', 'G', #10, 'A', 'M', 'M', 'O', #10, - 'D', 'R', 'A', 'W', 'N', 'M', 'A', 'P', #10, 'F', 'E', 'A', 'T', 'U', 'R', 'E', - '_', 'S', 'I', 'Z', 'E', #10, 'U', 'L', 'L', 'M', 'A', 'P', 'C', 'O', 'N', 'F', - 'I', 'G', #10, 'M', 'A', 'P', 'G', 'E', 'N', #10, #10, 'Z', 'E', '_', 'S', 'I', - 'Z', 'E', #10, 'S', 'C', 'H', 'E', 'M', 'E', #10, 'R', 'I', 'P', 'T', #10, 'E', - 'E', 'D', #10, 'T', 'E', 'M', 'P', 'L', 'A', 'T', 'E', #10, 'H', 'E', 'M', 'E', - #10, 'H', 'A', 'T', #10, 'L', 'I', 'E', 'N', 'T', '_', 'F', 'L', 'A', 'G', 'S', - #10, 'O', 'N', 'N', 'E', 'C', 'T', 'E', 'D', #10, 'E', 'M', #10, 'R', 'R', 'O', - 'R', #10, 'H', 'H', '_', 'N', 'U', 'M', #10, 'I', 'N', 'F', 'O', #10, 'J', 'O', - 'I', 'N', 'E', 'D', #10, 'I', 'N', 'G', #10, 'K', 'I', 'C', 'K', 'E', 'D', #10, - 'L', 'E', 'F', 'T', #10, 'O', 'B', 'B', 'Y', ':', 'J', 'O', 'I', 'N', 'E', 'D', - #10, 'L', 'E', 'F', 'T', #10, 'N', 'I', 'C', 'K', #10, 'O', 'T', 'I', 'C', 'E', - #10, 'P', 'I', 'N', 'G', #10, 'R', 'O', 'T', 'O', #10, 'R', 'E', 'M', 'O', 'V', - 'E', '_', 'T', 'E', 'A', 'M', #10, 'O', 'O', 'M', 'S', #10, #10, 'A', 'D', 'D', - #10, 'D', 'E', 'L', #10, 'U', 'P', 'D', #10, 'U', 'N', 'D', '_', 'F', 'I', 'N', - 'I', 'S', 'H', 'E', 'D', #10, 'U', 'N', '_', 'G', 'A', 'M', 'E', #10, 'S', 'E', - 'R', 'V', 'E', 'R', '_', 'A', 'U', 'T', 'H', #10, 'M', 'E', 'S', 'S', 'A', 'G', - 'E', #10, 'V', 'A', 'R', 'S', #10, 'T', 'E', 'A', 'M', '_', 'A', 'C', 'C', 'E', - 'P', 'T', 'E', 'D', #10, 'C', 'O', 'L', 'O', 'R', #10, 'W', 'A', 'R', 'N', 'I', - 'N', 'G', #10, #0, #10); -const commands: array[0..332] of integer = (20, 8, 0, 0, 0, 0, 0, 0, -56, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -55, 11, 7, 0, 0, 0, 0, 0, -54, 0, 0, -53, 115, 89, 0, - 0, 5, 0, 0, 0, -52, 9, 0, 0, 0, 0, 0, 0, 0, -51, 26, 12, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -49, 16, 0, 6, 4, 0, 0, -48, -47, - 0, 0, 0, 0, 0, 0, 0, -46, 16, 11, 5, 0, 0, 0, -45, 0, 0, 0, 0, -44, 0, 0, 0, - -43, 0, 8, 0, 0, 0, 0, 0, 0, -42, 0, 0, 0, 0, -41, 4, 0, 0, -40, 12, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -39, 0, 0, 0, 0, 0, 0, 0, 0, -38, 8, 2, -37, 0, 0, 0, 0, -36, - 7, 0, 0, 0, 0, 0, -35, 5, 0, 0, 0, -34, 11, 0, 0, 0, 3, 0, -33, 0, 0, 0, -32, 7, - 0, 0, 0, 0, 0, -31, 22, 4, 0, 0, -30, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, -29, 0, - 0, 0, 0, -28, 11, 4, 0, 0, -27, 0, 0, 0, 0, 0, -26, 10, 4, 0, 0, -25, 0, 0, 0, - 0, -24, 51, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, -23, 31, 17, 0, 2, -22, 0, 4, 0, 0, - -21, 4, 0, 0, -20, 0, 0, 0, -19, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -18, 0, 0, - 0, 0, 0, 0, 0, -17, 25, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, -16, 8, 0, 0, 0, 0, 0, 0, - -15, 0, 0, 0, 0, -14, 20, 0, 0, 0, 0, 9, 0, 0, 0, 0, 0, 0, 0, -13, 0, 0, 0, 0, - 0, -12, 8, 0, 0, 0, 0, 0, 0, -11, 0, -10); -const handlers: array[0..46] of PHandler = (@handler__UNKNOWN_, @handler_L, - @handler_SS, @handler_S, @handler_SL, @handler_L, @handler_S, @handler_, - @handler_, @handler_MS, @handler_S, @handler_MS, @handler_MS, @handler_S, - @handler_i, @handler_MS, @handler_L, @handler_S, @handler_SL, @handler_MS, - @handler_SL, @handler_, @handler_S, @handler_MS, @handler_MS, @handler_SS, - @handler_L, @handler_ML, @handler__i, @handler_SMS, @handler_SL, @handler_S, - @handler_i, @handler_S, @handler_S, @handler_MS, @handler_i, @handler_i, - @handler_S, @handler_MS, @handler_i, @handler_L, @handler_SL, @handler_SL, - @handler_MS, @handler_S, @handler_MS); - -procedure handleTail; -var cnt: Longint; - c: char; -begin - c:= getCurrChar; - repeat - if c = #10 then cnt:= 0 else cnt:= 1; - repeat - c:= getNextChar; - inc(cnt) - until (c = #0) or (c = #10); - until (c = #0) or (cnt = 1); - state.l:= 0 -end; - -var sock: PTCPSocket; - netReaderThread: PSDL_Thread; - -function getCurrChar: char; -begin - getCurrChar:= state.buf[state.bufpos] -end; - -function getNextChar: char; -var r: byte; -begin - if state.bufpos < byte(state.buf[0]) then - begin - inc(state.bufpos); - end else - begin - r:= SDLNet_TCP_Recv(sock, @state.buf[1], 255); - if r > 0 then - begin - state.bufpos:= 1; - state.buf[0]:= char(r); - end else - begin - state.bufpos:= 0; - state.buf[0]:= #0; - end - end; - - getNextChar:= state.buf[state.bufpos]; -end; - -function netReader(data: pointer): LongInt; cdecl; export; -var c: char; - ipaddr: TIPAddress; -begin - netReader:= 0; - - if SDLNet_ResolveHost(ipaddr, PChar('netserver.hedgewars.org'), 46631) = 0 then - sock:= SDLNet_TCP_Open(ipaddr); - - repeat - c:= getNextChar; - //writeln('>>>>> ', c, ' [', letters[state.l], '] ', commands[state.l], ' ', state.l); - if c = #0 then - isConnected:= false - else - begin - while (letters[state.l] <> c) and (commands[state.l] > 0) do - inc(state.l, commands[state.l]); - - if c = letters[state.l] then - if commands[state.l] < 0 then - begin - state.cmd:= net2cmd[-10 - commands[state.l]]; - //writeln('[NET] ', state.cmd); - handlers[-10 - commands[state.l]](); - state.l:= 0 - end - else - inc(state.l) - else - begin - handler__UNKNOWN_() - end - end - until not isConnected; - - SDLNet_TCP_Close(sock); - sock:= nil; - - writeln('[NET] netReader: disconnected'); -end; - -procedure sendNet(s: shortstring); -begin - writeln('[NET] Send: ', s); - ipcToNet(s + endCmd); -end; - -procedure sendNetLn(s: shortstring); -begin - writeln('[NET] Send: ', s); - ipcToNet(s + #10); -end; - -function getShortString: shortstring; -var s: shortstring; - c: char; -begin - s[0]:= #0; - - repeat - inc(s[0]); - s[byte(s[0])]:= getNextChar - until (s[0] = #255) or (s[byte(s[0])] = #10) or (s[byte(s[0])] = #0); - - if s[byte(s[0])] = #10 then - dec(s[0]) - else - repeat c:= getNextChar until (c = #0) or (c = #10); - - getShortString:= s -end; - -function getLongString: ansistring; -var s: shortstring; - l: ansistring; - c: char; -begin - l:= ''; - - repeat - s[0]:= #0; - repeat - inc(s[0]); - c:= getNextChar; - s[byte(s[0])]:= c - until (s[0] = #255) or (c = #10) or (c = #0); - - if s[byte(s[0])] = #10 then - dec(s[0]); - - l:= l + s - until (c = #10) or (c = #0); - - getLongString:= l -end; - -procedure netSendCallback(p: pointer; msg: PChar; len: Longword); -begin - // FIXME W A R N I N G: totally thread-unsafe due to use of sock variable - SDLNet_TCP_Send(sock, msg, len); -end; - -procedure connectOfficialServer; -begin - if sock <> nil then - exit; - - state.bufpos:= 0; - state.buf:= ''; - - state.l:= 0; - isConnected:= true; - - netReaderThread:= SDL_CreateThread(@netReader, 'netReader', nil); - SDL_DetachThread(netReaderThread) -end; - - -procedure passToNet(data: PByteArray; len: Longword); -var i: Longword; - l: ansistring; - s: shortstring; -begin - i:= 0; - - while(i < len) do - begin - if data^[i + 1] = ord('s') then - begin - s[0]:= char(data^[i] - 1); - Move(data^[i + 2], s[1], data^[i] - 1); - - l:= myNickname + #10; - l:= l + s; - - sendUI(mtRoomChatLine, @l[1], length(l)); - sendNetLn('CHAT'); - sendNet(s); - end; - - inc(i, data^[i] + 1); - end; -end; - -procedure initModule; -begin - sock:= nil; - isConnected:= false; - - SDLNet_Init; - - registerNetCallback(nil, @netSendCallback); -end; - -procedure freeModule; -begin -end; - -end.
--- a/hedgewars/uFLNetProtocol.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,598 +0,0 @@ -unit uFLNetProtocol; -interface - -procedure passNetData(p: pointer); cdecl; - -procedure sendChatLine(msg: PChar); cdecl; -procedure joinRoom(roomName: PChar); cdecl; -procedure partRoom(msg: PChar); cdecl; - -procedure ResetNetState; - -implementation -uses uFLNetTypes, uFLTypes, uFLUICallback, uFLNet, uFLGameConfig, uFLUtils, uFLIPC, uUtils; - -type - PHandler = procedure (var t: TCmdData); - -var isInRoom: boolean; - -procedure onRoomLeaving(); -begin - isInRoom:= false; - sendUI(mtMoveToLobby, nil, 0); - netResetTeams -end; - -var teamIndex: LongInt; - tmpTeam: TTeam; - -const teamFields: array[0..22] of PShortstring = ( - @tmpTeam.teamName - , @tmpTeam.grave - , @tmpTeam.fort - , @tmpTeam.voice - , @tmpTeam.flag - , @tmpTeam.owner - , nil - , @tmpTeam.hedgehogs[0].name - , @tmpTeam.hedgehogs[0].hat - , @tmpTeam.hedgehogs[1].name - , @tmpTeam.hedgehogs[1].hat - , @tmpTeam.hedgehogs[2].name - , @tmpTeam.hedgehogs[2].hat - , @tmpTeam.hedgehogs[3].name - , @tmpTeam.hedgehogs[3].hat - , @tmpTeam.hedgehogs[4].name - , @tmpTeam.hedgehogs[4].hat - , @tmpTeam.hedgehogs[5].name - , @tmpTeam.hedgehogs[5].hat - , @tmpTeam.hedgehogs[6].name - , @tmpTeam.hedgehogs[6].hat - , @tmpTeam.hedgehogs[7].name - , @tmpTeam.hedgehogs[7].hat - ); - -procedure handler_ADD_TEAM(var p: TCmdParam); -begin - teamIndex:= 0; - tmpTeam.color:= 0 -end; - -procedure handler_ADD_TEAM_s(var s: TCmdParamS); -begin - if teamIndex = 6 then - tmpTeam.botLevel:= strToInt(s.str1) - else if teamIndex < 23 then - teamFields[teamIndex]^:= s.str1; - - if teamIndex = 22 then - netAddTeam(tmpTeam); - - inc(teamIndex); -end; - -procedure handler_ASKPASSWORD(var p: TCmdParamS); -begin -end; - -procedure handler_BANLIST(var p: TCmdParam); -begin -end; - -procedure handler_BANLIST_s(var s: TCmdParamS); -begin -end; - -procedure handler_BYE(var p: TCmdParamSL); -begin - sendUI(mtDisconnected, @p.str2[1], length(p.str2)); -end; - -procedure handler_CFG_AMMO(var p: TCmdParamSL); -begin - netSetAmmo(p.str1, p.str2) -end; - -procedure handler_CFG_DRAWNMAP(var p: TCmdParamL); -begin - netDrawnData(copy(ansistring(p.str1), 1, p.str1len)) -end; - -procedure handler_CFG_FEATURE_SIZE(var p: TCmdParami); -begin - if isInRoom then - begin - netSetFeatureSize(p.param1); - updatePreviewIfNeeded - end; -end; - -var fmcfgIndex: integer; - -procedure handler_CFG_FULLMAPCONFIG(var p: TCmdParam); -begin - fmcfgIndex:= 0; -end; - -procedure handler_CFG_FULLMAPCONFIG_s(var s: TCmdParamS); -begin - if not isInRoom then exit; - - inc(fmcfgIndex); - case fmcfgIndex of - 1: netSetFeatureSize(strToInt(s.str1)); - 2: if s.str1[0] <> '+' then netSetMap(s.str1); - 3: netSetMapGen(strToInt(s.str1)); - 4: netSetMazeSize(strToInt(s.str1)); - 5: netSetSeed(s.str1); - 6: begin - netSetTemplate(strToInt(s.str1)); - updatePreviewIfNeeded; - end; - end; -end; - -procedure handler_CFG_MAP(var p: TCmdParamS); -begin - if isInRoom then - netSetMap(p.str1); -end; - -procedure handler_CFG_MAPGEN(var p: TCmdParami); -begin - if isInRoom then - begin - netSetMapGen(p.param1); - updatePreviewIfNeeded - end -end; - -procedure handler_CFG_MAZE_SIZE(var p: TCmdParami); -begin - if isInRoom then - begin - netSetMazeSize(p.param1); - updatePreviewIfNeeded - end -end; - -var schemeIndex: LongInt; - tmpScheme: TScheme; - -procedure handler_CFG_SCHEME(var p: TCmdParam); -begin - schemeIndex:= 0 -end; - -const schemeFields: array[0..43] of pointer = ( - @tmpScheme.schemeName // 0 - , @tmpScheme.fortsmode // 1 - , @tmpScheme.divteams // 2 - , @tmpScheme.solidland // 3 - , @tmpScheme.border // 4 - , @tmpScheme.lowgrav // 5 - , @tmpScheme.laser // 6 - , @tmpScheme.invulnerability // 7 - , @tmpScheme.resethealth // 8 - , @tmpScheme.vampiric // 9 - , @tmpScheme.karma // 10 - , @tmpScheme.artillery // 11 - , @tmpScheme.randomorder // 12 - , @tmpScheme.king // 13 - , @tmpScheme.placehog // 14 - , @tmpScheme.sharedammo // 15 - , @tmpScheme.disablegirders // 16 - , @tmpScheme.disablelandobjects // 17 - , @tmpScheme.aisurvival // 18 - , @tmpScheme.infattack // 19 - , @tmpScheme.resetweps // 20 - , @tmpScheme.perhogammo // 21 - , @tmpScheme.disablewind // 22 - , @tmpScheme.morewind // 23 - , @tmpScheme.tagteam // 24 - , @tmpScheme.bottomborder // 25 - , @tmpScheme.damagefactor // 26 - , @tmpScheme.turntime // 27 - , @tmpScheme.health // 28 - , @tmpScheme.suddendeath // 29 - , @tmpScheme.caseprobability // 30 - , @tmpScheme.minestime // 31 - , @tmpScheme.minesnum // 32 - , @tmpScheme.minedudpct // 33 - , @tmpScheme.explosives // 34 - , @tmpScheme.airmines // 35 - , @tmpScheme.healthprobability // 36 - , @tmpScheme.healthcaseamount // 37 - , @tmpScheme.waterrise // 38 - , @tmpScheme.healthdecrease // 39 - , @tmpScheme.ropepct // 40 - , @tmpScheme.getawaytime // 41 - , @tmpScheme.worldedge // 42 - , @tmpScheme.scriptparam // 43 - ); - -procedure handler_CFG_SCHEME_s(var s: TCmdParamS); -begin - if(schemeIndex = 0) then - tmpScheme.schemeName:= s.str1 - else - if(schemeIndex = 43) then - tmpScheme.scriptparam:= copy(s.str1, 2, length(s.str1) - 1) - else - if(schemeIndex < 26) then - PBoolean(schemeFields[schemeIndex])^:= s.str1[1] = 't' - else - if(schemeIndex < 43) then - PLongInt(schemeFields[schemeIndex])^:= strToInt(s.str1); - - if(schemeIndex = 43) then - netSetScheme(tmpScheme); - - inc(schemeIndex); -end; - -procedure handler_CFG_SCRIPT(var p: TCmdParamS); -begin - if isInRoom then - netSetScript(p.str1) -end; - -procedure handler_CFG_SEED(var p: TCmdParamS); -begin - if isInRoom then - netSetSeed(p.str1) -end; - -procedure handler_CFG_TEMPLATE(var p: TCmdParami); -begin - if isInRoom then - begin - netSetTemplate(p.param1); - updatePreviewIfNeeded - end -end; - -procedure handler_CFG_THEME(var p: TCmdParamS); -begin - if isInRoom then - netSetTheme(p.str1) -end; - -procedure handler_CHAT(var p: TCmdParamSL); -var s: string; -begin - s:= p.str1 + #10 + copy(p.str2, 0, p.str2len); - if isInRoom then - sendUI(mtRoomChatLine, @s[1], length(s)) - else - sendUI(mtLobbyChatLine, @s[1], length(s)); -end; - -var flags: array[TClientFlag] of LongInt; - isFlagsLine: boolean; -procedure handler_CLIENT_FLAGS(var p: TCmdParamS); -var f: TClientFlag; -begin - for f:= Low(TClientFlag) to High(TClientFlag) do - flags[f]:= 0; - - isFlagsLine:= true; -end; - -procedure handler_CLIENT_FLAGS_s(var s: TCmdParamS); -var isRemoval: boolean; - flagValue, i: LongInt; -begin - if isFlagsLine then - begin - if s.str1[1] = '+' then flagValue:= 1 else flagValue:= -1; - for i:= 2 to Length(s.str1) do - case s.str1[1] of - 'r': flags[cfReady]:= flagValue; - 'u': flags[cfRegistered]:= flagValue; - 'i': flags[cfInRoom]:= flagValue; - 'c': flags[cfContributor]:= flagValue; - 'g': flags[cfInGame]:= flagValue; - 'h': flags[cfRoomAdmin]:= flagValue; - 'a': flags[cfServerAdmin]:= flagValue; - end; - - isFlagsLine:= false; - end else - begin - - end -end; - -procedure handler_CONNECTED(var p: TCmdParami); -begin - sendUI(mtConnected, nil, 0); - //writeln('Server features version ', p.param1); - sendNet('PROTO' + #10 + '52'); - sendNet('NICK' + #10 + myNickname); -end; - -procedure handler_EM(var p: TCmdParam); -begin -end; - -procedure handler_EM_s(var p: TCmdParamL); -var i, l: Longword; - s: shortstring; -begin - i:= 1; - l:= length(p.str1); - - while i < l do - begin - s:= DecodeBase64(copy(p.str1, i, 240)); - ipcToEngineRaw(@s[1], byte(s[0])); - inc(i, 160) - end; -end; - -procedure handler_ERROR(var p: TCmdParamL); -begin - sendUI(mtError, @p.str1[1], length(p.str1)); -end; - -procedure handler_HH_NUM(var p: TCmdParamSS); -begin - netSetHedgehogsNumber(p.str1, StrToInt(p.str2)) -end; - -procedure handler_INFO(var p: TCmdParam); -begin -end; - -procedure handler_INFO_s(var s: TCmdParamS); -begin -end; - -procedure handler_JOINED(var p: TCmdParam); -begin -end; - -procedure handler_JOINED_s(var s: TCmdParamS); -begin - if s.str1 = myNickname then // we joined a room - begin - isInRoom:= true; - sendUI(mtMoveToRoom, nil, 0); - end; - - sendUI(mtAddRoomClient, @s.str1[1], length(s.str1)); -end; - -procedure handler_JOINING(var p: TCmdParamS); -begin -end; - -procedure handler_KICKED(var p: TCmdParam); -begin - onRoomLeaving() -end; - -procedure handler_LEFT(var p: TCmdParamSL); -var s: string; -begin - s:= p.str1 + #10 + copy(p.str2, 0, p.str2len); - sendUI(mtRemoveRoomClient, @s[1], length(s)); -end; - -procedure handler_LOBBY_JOINED(var p: TCmdParam); -begin -end; - -procedure handler_LOBBY_JOINED_s(var s: TCmdParamS); -begin - if s.str1 = myNickname then - begin - sendUI(mtMoveToLobby, nil, 0); - sendNet('LIST'); - end; - - sendUI(mtAddLobbyClient, @s.str1[1], length(s.str1)); -end; - -procedure handler_LOBBY_LEFT(var p: TCmdParamSL); -var s: string; -begin - s:= p.str1 + #10 + copy(p.str2, 0, p.str2len); - sendUI(mtRemoveLobbyClient, @s[1], length(s)); -end; - -procedure handler_NICK(var p: TCmdParamS); -begin - myNickname:= p.str1; - sendUI(mtNickname, @p.str1[1], length(p.str1)); -end; - -procedure handler_NOTICE(var p: TCmdParamL); -begin -end; - -procedure handler_PING(var p: TCmdParam); -begin - sendNet('PONG') -end; - -procedure handler_PING_s(var s: TCmdParamS); -begin -end; - -procedure handler_PROTO(var p: TCmdParami); -begin - //writeln('Protocol ', p.param1) -end; - -procedure handler_REMOVE_TEAM(var p: TCmdParamS); -begin - netRemoveTeam(p.str1) -end; - -var roomInfo: string; - roomLinesCount: integer; - -procedure handler_ROOMS(var p: TCmdParam); -begin - roomInfo:= ''; - roomLinesCount:= 0 -end; - -procedure handler_ROOMS_s(var s: TCmdParamS); -begin - roomInfo:= roomInfo + s.str1 + #10; - - if roomLinesCount = 8 then - begin - sendUI(mtAddRoom, @roomInfo[1], length(roomInfo) - 1); - roomLinesCount:= 0; - roomInfo:= '' - end else inc(roomLinesCount); -end; - -procedure handler_ROOM_ADD(var p: TCmdParam); -begin - roomInfo:= ''; - roomLinesCount:= 0 -end; - -procedure handler_ROOM_ADD_s(var s: TCmdParamS); -begin - roomInfo:= roomInfo + s.str1 + #10; - inc(roomLinesCount); - - if roomLinesCount = 9 then - begin - sendUI(mtAddRoom, @roomInfo[1], length(roomInfo) - 1); - roomInfo:= ''; - roomLinesCount:= 0 - end; -end; - -procedure handler_ROOM_DEL(var p: TCmdParamS); -begin - sendUI(mtRemoveRoom, @p.str1[1], length(p.str1)); -end; - -procedure handler_ROOM_UPD(var p: TCmdParam); -begin - roomInfo:= ''; - roomLinesCount:= 0 -end; - -procedure handler_ROOM_UPD_s(var s: TCmdParamS); -begin - roomInfo:= roomInfo + s.str1 + #10; - inc(roomLinesCount); - - if roomLinesCount = 10 then - sendUI(mtUpdateRoom, @roomInfo[1], length(roomInfo) - 1); -end; - -procedure handler_ROUND_FINISHED(var p: TCmdParam); -begin -end; - -procedure handler_RUN_GAME(var p: TCmdParam); -begin - runNetGame -end; - -procedure handler_SERVER_AUTH(var p: TCmdParamS); -begin -end; - -procedure handler_SERVER_MESSAGE(var p: TCmdParamL); -begin -end; - -procedure handler_SERVER_VARS(var p: TCmdParamSL); -begin -end; - -procedure handler_TEAM_ACCEPTED(var p: TCmdParamS); -begin - netAcceptedTeam(p.str1) -end; - -procedure handler_TEAM_COLOR(var p: TCmdParamSS); -begin - netSetTeamColor(p.str1, StrToInt(p.str2)); -end; - -procedure handler_WARNING(var p: TCmdParamL); -begin - sendUI(mtWarning, @p.str1[1], length(p.str1)); -end; - -const handlers: array[TCmdType] of PHandler = (PHandler(@handler_ADD_TEAM), - PHandler(@handler_ADD_TEAM_s), PHandler(@handler_ASKPASSWORD), - PHandler(@handler_BANLIST), PHandler(@handler_BANLIST_s), - PHandler(@handler_BYE), PHandler(@handler_CFG_AMMO), - PHandler(@handler_CFG_DRAWNMAP), PHandler(@handler_CFG_FEATURE_SIZE), - PHandler(@handler_CFG_FULLMAPCONFIG), PHandler(@handler_CFG_FULLMAPCONFIG_s), - PHandler(@handler_CFG_MAP), PHandler(@handler_CFG_MAPGEN), - PHandler(@handler_CFG_MAZE_SIZE), PHandler(@handler_CFG_SCHEME), - PHandler(@handler_CFG_SCHEME_s), PHandler(@handler_CFG_SCRIPT), - PHandler(@handler_CFG_SEED), PHandler(@handler_CFG_TEMPLATE), - PHandler(@handler_CFG_THEME), PHandler(@handler_CHAT), - PHandler(@handler_CLIENT_FLAGS), PHandler(@handler_CLIENT_FLAGS_s), - PHandler(@handler_CONNECTED), PHandler(@handler_EM), PHandler(@handler_EM_s), - PHandler(@handler_ERROR), PHandler(@handler_HH_NUM), PHandler(@handler_INFO), - PHandler(@handler_INFO_s), PHandler(@handler_JOINED), - PHandler(@handler_JOINED_s), PHandler(@handler_JOINING), - PHandler(@handler_KICKED), PHandler(@handler_LEFT), - PHandler(@handler_LOBBY_JOINED), PHandler(@handler_LOBBY_JOINED_s), - PHandler(@handler_LOBBY_LEFT), PHandler(@handler_NICK), - PHandler(@handler_NOTICE), PHandler(@handler_PING), PHandler(@handler_PING_s), - PHandler(@handler_PROTO), PHandler(@handler_REMOVE_TEAM), - PHandler(@handler_ROOMS), PHandler(@handler_ROOMS_s), - PHandler(@handler_ROOM_ADD), PHandler(@handler_ROOM_ADD_s), - PHandler(@handler_ROOM_DEL), PHandler(@handler_ROOM_UPD), - PHandler(@handler_ROOM_UPD_s), PHandler(@handler_ROUND_FINISHED), - PHandler(@handler_RUN_GAME), PHandler(@handler_SERVER_AUTH), - PHandler(@handler_SERVER_MESSAGE), PHandler(@handler_SERVER_VARS), - PHandler(@handler_TEAM_ACCEPTED), PHandler(@handler_TEAM_COLOR), - PHandler(@handler_WARNING)); - -procedure passNetData(p: pointer); cdecl; -begin - handlers[TCmdData(p^).cmd.cmd](TCmdData(p^)) -end; - -procedure sendChatLine(msg: PChar); cdecl; -begin - sendNetLn('CHAT'); - sendNet(msg); -end; - -procedure joinRoom(roomName: PChar); cdecl; -begin - sendNetLn('JOIN_ROOM'); - sendNet(roomName); -end; - -procedure partRoom(msg: PChar); cdecl; -var s: string; -begin - if isInRoom then - begin - s:= 'PART'; - if length(msg) > 0 then - s:= s + #10 + msg; - sendNet(s); - - onRoomLeaving() - end -end; - -procedure ResetNetState; -begin - isInRoom:= false; -end; - -end. -
--- a/hedgewars/uFLNetTypes.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,57 +0,0 @@ -unit uFLNetTypes; -interface - -type TCmdType = (cmd_ADD_TEAM, cmd_ADD_TEAM_s, cmd_ASKPASSWORD, cmd_BANLIST, - cmd_BANLIST_s, cmd_BYE, cmd_CFG_AMMO, cmd_CFG_DRAWNMAP, cmd_CFG_FEATURE_SIZE, - cmd_CFG_FULLMAPCONFIG, cmd_CFG_FULLMAPCONFIG_s, cmd_CFG_MAP, cmd_CFG_MAPGEN, - cmd_CFG_MAZE_SIZE, cmd_CFG_SCHEME, cmd_CFG_SCHEME_s, cmd_CFG_SCRIPT, - cmd_CFG_SEED, cmd_CFG_TEMPLATE, cmd_CFG_THEME, cmd_CHAT, cmd_CLIENT_FLAGS, - cmd_CLIENT_FLAGS_s, cmd_CONNECTED, cmd_EM, cmd_EM_s, cmd_ERROR, cmd_HH_NUM, - cmd_INFO, cmd_INFO_s, cmd_JOINED, cmd_JOINED_s, cmd_JOINING, cmd_KICKED, - cmd_LEFT, cmd_LOBBY_JOINED, cmd_LOBBY_JOINED_s, cmd_LOBBY_LEFT, cmd_NICK, - cmd_NOTICE, cmd_PING, cmd_PING_s, cmd_PROTO, cmd_REMOVE_TEAM, cmd_ROOMS, - cmd_ROOMS_s, cmd_ROOM_ADD, cmd_ROOM_ADD_s, cmd_ROOM_DEL, cmd_ROOM_UPD, - cmd_ROOM_UPD_s, cmd_ROUND_FINISHED, cmd_RUN_GAME, cmd_SERVER_AUTH, - cmd_SERVER_MESSAGE, cmd_SERVER_VARS, cmd_TEAM_ACCEPTED, cmd_TEAM_COLOR, - cmd_WARNING); - - type TCmdParam = packed record - cmd: TCmdType; - end; - type TCmdParamL = packed record - cmd: TCmdType; - str1len: Longword; - str1: array[word] of char; - end; - type TCmdParamS = packed record - cmd: TCmdType; - str1: shortstring; - end; - type TCmdParamSL = packed record - cmd: TCmdType; - str1: shortstring; - str2len: Longword; - str2: array[word] of char; - end; - type TCmdParamSS = packed record - cmd: TCmdType; - str1: shortstring; - str2: shortstring; - end; - type TCmdParami = packed record - cmd: TCmdType; - param1: LongInt; - end; - - TCmdData = record - case byte of - 0: (cmd: TCmdParam); - 1: (cpl: TCmdParamL); - 2: (cps: TCmdParamS); - 3: (cpsl: TCmdParamSL); - 4: (cpi: TCmdParami); - end; - -implementation - -end.
--- a/hedgewars/uFLSchemes.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,246 +0,0 @@ -unit uFLSchemes; -interface -uses uFLTypes; - -function getSchemesList: PPChar; cdecl; -procedure freeSchemesList; - -function schemeByName(s: shortstring): PScheme; -procedure sendSchemeConfig(var scheme: TScheme); - -implementation -uses uFLUtils, uFLIPC, uPhysFSLayer, uFLThemes; - -const MAX_SCHEME_NAMES = 64; -type - TSchemeArray = array [0..0] of TScheme; - PSchemeArray = ^TSchemeArray; -var - schemesList: PScheme; - schemesNumber: LongInt; - listOfSchemeNames: array[0..MAX_SCHEME_NAMES] of PChar; - tmpScheme: TScheme; - -const ints: array[0 .. 17] of record - name: shortstring; - param: ^LongInt; - end = ( - (name: 'damagefactor'; param: @tmpScheme.damagefactor) - , (name: 'turntime'; param: @tmpScheme.turntime) - , (name: 'health'; param: @tmpScheme.health) - , (name: 'suddendeath'; param: @tmpScheme.suddendeath) - , (name: 'caseprobability'; param: @tmpScheme.caseprobability) - , (name: 'minestime'; param: @tmpScheme.minestime) - , (name: 'landadds'; param: @tmpScheme.landadds) - , (name: 'minedudpct'; param: @tmpScheme.minedudpct) - , (name: 'explosives'; param: @tmpScheme.explosives) - , (name: 'minesnum'; param: @tmpScheme.minesnum) - , (name: 'healthprobability'; param: @tmpScheme.healthprobability) - , (name: 'healthcaseamount'; param: @tmpScheme.healthcaseamount) - , (name: 'waterrise'; param: @tmpScheme.waterrise) - , (name: 'healthdecrease'; param: @tmpScheme.healthdecrease) - , (name: 'ropepct'; param: @tmpScheme.ropepct) - , (name: 'getawaytime'; param: @tmpScheme.getawaytime) - , (name: 'worldedge'; param: @tmpScheme.worldedge) - , (name: 'airmines'; param: @tmpScheme.airmines) - ); -const bools: array[0 .. 24] of record - name: shortstring; - param: ^boolean; - flag: Longword; - end = ( - (name: 'fortsmode'; param: @tmpScheme.fortsmode; flag: $00001000) - , (name: 'divteams'; param: @tmpScheme.divteams; flag: $00000010) - , (name: 'solidland'; param: @tmpScheme.solidland; flag: $00000004) - , (name: 'border'; param: @tmpScheme.border; flag: $00000008) - , (name: 'lowgrav'; param: @tmpScheme.lowgrav; flag: $00000020) - , (name: 'laser'; param: @tmpScheme.laser; flag: $00000040) - , (name: 'invulnerability'; param: @tmpScheme.invulnerability; flag: $00000080) - , (name: 'resethealth'; param: @tmpScheme.resethealth; flag: $00000100) - , (name: 'vampiric'; param: @tmpScheme.vampiric; flag: $00000200) - , (name: 'karma'; param: @tmpScheme.karma; flag: $00000400) - , (name: 'artillery'; param: @tmpScheme.artillery; flag: $00000800) - , (name: 'randomorder'; param: @tmpScheme.randomorder; flag: $00002000) - , (name: 'king'; param: @tmpScheme.king; flag: $00004000) - , (name: 'placehog'; param: @tmpScheme.placehog; flag: $00008000) - , (name: 'sharedammo'; param: @tmpScheme.sharedammo; flag: $00010000) - , (name: 'disablegirders'; param: @tmpScheme.disablegirders; flag: $00020000) - , (name: 'disablewind'; param: @tmpScheme.disablewind; flag: $00800000) - , (name: 'morewind'; param: @tmpScheme.morewind; flag: $01000000) - , (name: 'tagteam'; param: @tmpScheme.tagteam; flag: $02000000) - , (name: 'bottomborder'; param: @tmpScheme.bottomborder; flag: $04000000) - , (name: 'disablelandobjects'; param: @tmpScheme.disablelandobjects; flag: $00040000) - , (name: 'aisurvival'; param: @tmpScheme.aisurvival; flag: $00080000) - , (name: 'infattack'; param: @tmpScheme.infattack; flag: $00100000) - , (name: 'resetweps'; param: @tmpScheme.resetweps; flag: $00200000) - , (name: 'perhogammo'; param: @tmpScheme.perhogammo; flag: $00400000) - ); - -procedure loadSchemes; -var f: PFSFile; - schemes: PSchemeArray; - s: shortstring; - l, i, ii: Longword; - isFound: boolean; -begin - f:= pfsOpenRead('/Config/schemes.ini'); - schemesNumber:= 0; - - if f <> nil then - begin - while (not pfsEOF(f)) and (schemesNumber = 0) do - begin - pfsReadLn(f, s); - - if copy(s, 1, 5) = 'size=' then - schemesNumber:= strToInt(midStr(s, 6)); - end; - - //inc(schemesNumber); // add some default schemes - - schemesList:= GetMem(sizeof(schemesList^) * (schemesNumber + 1)); - schemes:= PSchemeArray(schemesList); - - while (not pfsEOF(f)) do - begin - pfsReadLn(f, s); - - i:= 1; - while(i <= length(s)) and (s[i] <> '\') do inc(i); - - if i < length(s) then - begin - l:= strToInt(copy(s, 1, i - 1)); - delete(s, 1, i); - - if (l <= schemesNumber) and (l > 0) then - begin - if copy(s, 1, 5) = 'name=' then - schemes^[l - 1].schemeName:= midStr(s, 6) - else if copy(s, 1, 12) = 'scriptparam=' then - schemes^[l - 1].scriptparam:= midStr(s, 13) else - begin - ii:= 0; - repeat - isFound:= readInt(ints[ii].name, s, PLongInt(ints[ii].param - @tmpScheme + @schemes^[l - 1])^); - inc(ii) - until isFound or (ii > High(ints)); - - if not isFound then - begin - ii:= 0; - repeat - isFound:= readBool(bools[ii].name, s, PBoolean(bools[ii].param - @tmpScheme + @schemes^[l - 1])^); - inc(ii) - until isFound or (ii > High(bools)); - end; - end; - end; - end; - end; - - pfsClose(f) - end; -end; - - -function getSchemesList: PPChar; cdecl; -var i, t, l: Longword; - scheme: PScheme; -begin - if schemesList = nil then - loadSchemes; - - t:= schemesNumber; - if t >= MAX_SCHEME_NAMES then - t:= MAX_SCHEME_NAMES; - - scheme:= schemesList; - for i:= 0 to Pred(t) do - begin - l:= length(scheme^.schemeName); - if l >= 255 then l:= 254; - scheme^.schemeName[l + 1]:= #0; - listOfSchemeNames[i]:= @scheme^.schemeName[1]; - inc(scheme) - end; - - listOfSchemeNames[t]:= nil; - - getSchemesList:= listOfSchemeNames -end; - -function schemeByName(s: shortstring): PScheme; -var i: Longword; - scheme: PScheme; -begin - scheme:= schemesList; - i:= 0; - while (i < schemesNumber) and (scheme^.schemeName <> s) do - begin - inc(scheme); - inc(i) - end; - - if i < schemesNumber then schemeByName:= scheme else schemeByName:= nil -end; - -procedure freeSchemesList; -begin - if schemesList <> nil then - FreeMem(schemesList, sizeof(schemesList^) * (schemesNumber + 1)) -end; - - -procedure sendSchemeConfig(var scheme: TScheme); -var i: Longword; - gf: Longword; -begin - with scheme do - begin - if turntime <> 45 then - ipcToEngine('e$turntime ' + inttostr(turntime * 1000)); - if minesnum <> 4 then - ipcToEngine('e$minesnum ' + inttostr(minesnum)); - if damagefactor <> 100 then - ipcToEngine('e$damagepct ' + inttostr(damagefactor)); - if worldedge > 0 then - ipcToEngine('e$worldedge ' + inttostr(worldedge)); - if length(scriptparam) > 0 then - ipcToEngine('e$scriptparam ' + scriptparam); - if suddendeath <> 15 then - ipcToEngine('e$sd_turns ' + inttostr(suddendeath)); - if waterrise <> 47 then - ipcToEngine('e$waterrise ' + inttostr(waterrise)); - if ropepct <> 100 then - ipcToEngine('e$ropepct ' + inttostr(ropepct)); - if getawaytime <> 100 then - ipcToEngine('e$getawaytime ' + inttostr(getawaytime)); - if caseprobability <> 5 then - ipcToEngine('e$casefreq ' + inttostr(caseprobability)); - if healthprobability <> 35 then - ipcToEngine('e$healthprob ' + inttostr(healthprobability)); - if minestime <> 3 then - ipcToEngine('e$minestime ' + inttostr(minestime * 1000)); - if minedudpct <> 0 then - ipcToEngine('e$minedudpct ' + inttostr(minedudpct)); - if explosives <> 2 then - ipcToEngine('e$explosives ' + inttostr(explosives)); - if airmines <> 0 then - ipcToEngine('e$airmines ' + inttostr(airmines)); - if healthcaseamount <> 25 then - ipcToEngine('e$hcaseamount ' + inttostr(healthcaseamount)); - if healthdecrease <> 5 then - ipcToEngine('e$healthdec ' + inttostr(healthdecrease)); - - gf:= 0; - - for i:= Low(bools) to High(bools) do - if PBoolean(bools[i].param - @tmpScheme + @scheme)^ then - gf:= gf or bools[i].flag; - - ipcToEngine('e$gmflags ' + inttostr(gf)); - end -end; - -end.
--- a/hedgewars/uFLScripts.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,128 +0,0 @@ -unit uFLScripts; -interface -uses uFLTypes; - -function getScriptsList: PPChar; cdecl; -procedure freeScriptsList; - -implementation -uses uFLUtils, uFLIPC, uPhysFSLayer, uFLThemes; - -const MAX_SCRIPT_NAMES = 64; -type - TScript = record - scriptName: shortstring; - description: shortstring; - gameScheme, weapons: shortstring; - end; - PScript = ^TScript; -var - scriptsList: PScript; - scriptsNumber: Longword; - listOfScriptNames: array[0..MAX_SCRIPT_NAMES] of PChar; - -procedure loadScript(var script: TScript; scriptName, fileName: shortstring); -var f: PFSFile; -begin - underScore2Space(scriptName); - script.scriptName:= scriptName; - script.description:= scriptName + ' script description'; - - f:= pfsOpenRead(copy(fileName, 1, length(fileName) - 4) + '.txt'); - - script.gameScheme:= ''; - script.weapons:= ''; - - if f <> nil then - begin - if not pfsEOF(f) then - begin - pfsReadLn(f, script.gameScheme); - - if not pfsEOF(f) then - pfsReadLn(f, script.weapons); - end; - - pfsClose(f) - end -end; - -procedure loadScripts; -var filesList, tmp: PPChar; - script: PScript; - s: shortstring; - l: Longword; -begin - filesList:= pfsEnumerateFiles('/Scripts/Multiplayer'); - scriptsNumber:= 1; - - tmp:= filesList; - while tmp^ <> nil do - begin - s:= shortstring(tmp^); - l:= length(s); - if (l > 4) and (copy(s, l - 3, 4) = '.lua') then inc(scriptsNumber); - inc(tmp) - end; - - scriptsList:= GetMem(sizeof(scriptsList^) * (scriptsNumber + 1)); - - script:= scriptsList; - - // add 'normal' script - script^.scriptName:= 'Normal'; - script^.description:= 'Normal gameplay'; - inc(script); - - // fill the rest from *.lua list - tmp:= filesList; - while tmp^ <> nil do - begin - s:= shortstring(tmp^); - l:= length(s); - if (l > 4) and (copy(s, l - 3, 4) = '.lua') then - begin - loadScript(script^, copy(s, 1, l - 4), '/Config/Scripts/' + s); - inc(script) - end; - inc(tmp) - end; - - pfsFreeList(filesList) -end; - - -function getScriptsList: PPChar; cdecl; -var i, t, l: Longword; - script: PScript; -begin - if scriptsList = nil then - loadScripts; - - t:= scriptsNumber; - if t >= MAX_SCRIPT_NAMES then - t:= MAX_SCRIPT_NAMES; - - script:= scriptsList; - for i:= 0 to Pred(t) do - begin - l:= length(script^.scriptName); - if l >= 255 then l:= 254; - script^.scriptName[l + 1]:= #0; - listOfScriptNames[i]:= @script^.scriptName[1]; - inc(script) - end; - - listOfScriptNames[t]:= nil; - - getScriptsList:= listOfScriptNames -end; - - -procedure freeScriptsList; -begin - if scriptsList <> nil then - FreeMem(scriptsList, sizeof(scriptsList^) * scriptsNumber) -end; - -end.
--- a/hedgewars/uFLTeams.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,225 +0,0 @@ -unit uFLTeams; -interface -uses uFLTypes; - -function createRandomTeam: TTeam; -procedure sendTeamConfig(hp: LongInt; var team: TTeam); - -function getTeamsList: PPChar; cdecl; -procedure freeTeamsList; - -function teamByName(s: shortstring): PTeam; - -procedure sendTeam(var team: TTeam); -procedure removeTeam(teamName: shortstring); - -implementation -uses uFLUtils, uFLIPC, uPhysFSLayer, uFLThemes, uFLNet; - -const MAX_TEAM_NAMES = 128; -var - teamsList: PTeam; - teamsNumber: Longword; - listOfTeamNames: array[0..MAX_TEAM_NAMES] of PChar; - - -function createRandomTeam: TTeam; -var t: TTeam; - i: Longword; -begin - with t do - begin - teamName:= 'team' + inttostr(random(100)); - - for i:= 0 to 7 do - with hedgehogs[i] do - begin - name:= 'hedgehog ' + inttostr(i); - hat:= 'NoHat' - end; - - botLevel:= 0; - hogsNumber:= 4 - end; - createRandomTeam:= t -end; - - -procedure sendTeamConfig(hp: LongInt; var team: TTeam); -var i: Longword; -begin - with team do - begin - ipcToEngine('eaddteam <hash> ' + colorsSet[color] + ' ' + teamName); - - if extDriven then - ipcToEngine('erdriven'); - - for i:= 0 to Pred(hogsNumber) do - begin - ipcToEngine('eaddhh ' + IntToStr(botLevel) + ' ' + IntToStr(hp) + ' ' + hedgehogs[i].name); - ipcToEngine('ehat ' + hedgehogs[i].hat); - end; - end -end; - - -procedure loadTeam(var team: TTeam; fileName: shortstring); -var f: PFSFile; - section: LongInt; - l: shortstring; -begin - section:= -1; - f:= pfsOpenRead(fileName); - - while (not pfsEOF(f)) do - begin - pfsReadLn(f, l); - - if l = '' then - else if l = '[Team]' then - section:= -2 - else if copy(l, 1, 9) = '[Hedgehog' then - section:= StrToInt(copy(l, 10, 1)) - else if section = -2 then - begin // [Team] - if copy(l, 1, 5) = 'Name=' then - team.teamName:= midStr(l, 6) - else if copy(l, 1, 6) = 'Grave=' then - team.grave:= midStr(l, 7) - else if copy(l, 1, 5) = 'Fort=' then - team.fort:= midStr(l, 6) - else if copy(l, 1, 5) = 'Flag=' then - team.flag:= midStr(l, 6) - else if copy(l, 1, 10) = 'Voicepack=' then - team.voice:= midStr(l, 11) - else if copy(l, 1, 11) = 'Difficulty=' then - team.botLevel:= StrToInt(midStr(l, 12)) - end else if (section >= 0) and (section <= 7) then - begin // [Hedgehog*] - if copy(l, 1, 5) = 'Name=' then - team.hedgehogs[section].name:= midStr(l, 6) - else if copy(l, 1, 4) = 'Hat=' then - team.hedgehogs[section].hat:= midStr(l, 5) - end; - end; - - pfsClose(f) -end; - - -procedure loadTeams; -var filesList, tmp: PPChar; - team: PTeam; - s: shortstring; - l: Longword; -begin - filesList:= pfsEnumerateFiles('/Config/Teams'); - teamsNumber:= 0; - - tmp:= filesList; - while tmp^ <> nil do - begin - s:= shortstring(tmp^); - l:= length(s); - if (l > 4) and (copy(s, l - 3, 4) = '.hwt') then inc(teamsNumber); - inc(tmp) - end; - - // TODO: no teams at all? - teamsList:= GetMem(sizeof(teamsList^) * teamsNumber); - - team:= teamsList; - tmp:= filesList; - while tmp^ <> nil do - begin - s:= shortstring(tmp^); - l:= length(s); - if (l > 4) and (copy(s, l - 3, 4) = '.hwt') then - begin - loadTeam(team^, '/Config/Teams/' + s); - inc(team) - end; - inc(tmp) - end; - - pfsFreeList(filesList) -end; - - -function getTeamsList: PPChar; cdecl; -var i, t, l: Longword; - team: PTeam; -begin - if teamsList = nil then - loadTeams; - - t:= teamsNumber; - if t >= MAX_TEAM_NAMES then - t:= MAX_TEAM_NAMES; - - team:= teamsList; - for i:= 0 to Pred(t) do - begin - l:= length(team^.teamName); - if l >= 255 then l:= 254; - team^.teamName[l + 1]:= #0; - listOfTeamNames[i]:= @team^.teamName[1]; - inc(team) - end; - - listOfTeamNames[t]:= nil; - - getTeamsList:= listOfTeamNames -end; - -function teamByName(s: shortstring): PTeam; -var i: Longword; - team: PTeam; -begin - team:= teamsList; - i:= 0; - while (i < teamsNumber) and (team^.teamName <> s) do - begin - inc(team); - inc(i) - end; - - if i < teamsNumber then teamByName:= team else teamByName:= nil -end; - -procedure freeTeamsList; -begin - if teamsList <> nil then - FreeMem(teamsList, sizeof(teamsList^) * teamsNumber) -end; - -procedure sendTeam(var team: TTeam); -var i: Longword; -begin - with team do - begin - sendNetLn('ADD_TEAM'); - sendNetLn(teamName); - sendNetLn(IntToStr(color)); - sendNetLn(grave); - sendNetLn(fort); - sendNetLn(voice); - sendNetLn(flag); - sendNetLn(IntToStr(botLevel)); - for i := 0 to 7 do - begin - sendNetLn(hedgehogs[i].name); - sendNetLn(hedgehogs[i].hat); - end; - sendNetLn('') - end; -end; - -procedure removeTeam(teamName: shortstring); -begin - sendNetLn('REMOVE_TEAM'); - sendNet(teamName) -end; - -end.
--- a/hedgewars/uFLThemes.pas Sun Dec 17 00:09:24 2017 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,85 +0,0 @@ -unit uFLThemes; -interface - -function getThemesList: PPChar; cdecl; -procedure freeThemesList(list: PPChar); cdecl; -function getThemeIcon(themeName: PChar; buffer: PChar; buflen: Longword): Longword; cdecl; - -const colorsSet: array[0..8] of shortstring = ( - '16712196' - , '4817089' - , '1959610' - , '11878895' - , '10526880' - , '2146048' - , '16681742' - , '6239749' - , '16776961'); - -implementation -uses uPhysFSLayer; - -function getThemesList: PPChar; cdecl; -var list, res, tmp: PPChar; - i, size: Longword; -begin - list:= pfsEnumerateFiles('Themes'); - size:= 0; - tmp:= list; - while tmp^ <> nil do - begin - inc(size); - inc(tmp) - end; - - res:= GetMem((3 + size) * sizeof(PChar)); - res^:= PChar(list); - inc(res); - res^:= PChar(res + size + 2); - inc(res); - - getThemesList:= res; - - for i:= 1 to size do - begin - if pfsExists('/Themes/' + shortstring(list^) + '/icon.png') then - begin - res^:= list^; - inc(res) - end; - - inc(list) - end; - - res^:= nil -end; - -procedure freeThemesList(list: PPChar); cdecl; -var listEnd: PPChar; -begin - dec(list); - listEnd:= PPChar(list^); - dec(list); - - pfsFreeList(PPChar(list^)); - freeMem(list, (listEnd - list) * sizeof(PChar)) -end; - -function getThemeIcon(themeName: PChar; buffer: PChar; buflen: Longword): Longword; cdecl; -var s: shortstring; - f: PFSFile; -begin - s:= '/Themes/' + shortstring(themeName) + '/icon@2x.png'; - - f:= pfsOpenRead(s); - - if f = nil then - getThemeIcon:= 0 - else - begin - getThemeIcon:= pfsBlockRead(f, buffer, buflen); - pfsClose(f) - end; -end; - -end.