# HG changeset patch # User unc0rr # Date 1447874319 -10800 # Node ID ffff8a0d1a766c56328e589d9dfaa767effd7b22 # Parent b894922d58cc809058d6afd9ddce2102f6550587 Implement processing net commands in the main thread diff -r b894922d58cc -r ffff8a0d1a76 hedgewars/uFLNet.pas --- a/hedgewars/uFLNet.pas Mon Nov 16 22:57:24 2015 +0300 +++ b/hedgewars/uFLNet.pas Wed Nov 18 22:18:39 2015 +0300 @@ -5,15 +5,15 @@ procedure initModule; procedure freeModule; +procedure sendNet(s: shortstring); implementation -uses SDLh, uFLIPC, uFLTypes, uFLUICallback, uFLNetTypes; +uses SDLh, uFLIPC, uFLTypes, uFLUICallback, uFLNetTypes, uFLUtils; const endCmd: string = #10 + #10; function getNextChar: char; forward; function getCurrChar: char; forward; -procedure sendNet(s: shortstring); forward; type TNetState = (netDisconnected, netConnecting, netLoggedIn); @@ -28,132 +28,123 @@ var state: TParserState; -// generated stuff here -const letters: array[0..206] of char = ('A', 'S', 'K', 'P', 'A', 'S', 'S', 'W', 'O', 'R', 'D', #10, 'B', 'A', 'N', 'L', 'I', 'S', 'T', #10, 'Y', 'E', #10, 'C', '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, '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', 'O', 'O', 'M', 'S', #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..206] of integer = (12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -38, 11, 7, 0, 0, 0, 0, 0, -37, 0, 0, -36, 26, 4, 0, 0, -35, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -34, 0, 0, 0, 0, 0, 0, 0, 0, -33, 3, 0, -32, 7, 0, 0, 0, 0, 0, -31, 5, 0, 0, 0, -30, 11, 0, 0, 0, 3, 0, -29, 0, 0, 0, -28, 7, 0, 0, 0, 0, 0, -27, 22, 4, 0, 0, -26, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, -25, 0, 0, 0, 0, -24, 11, 4, 0, 0, -23, 0, 0, 0, 0, 0, -22, 10, 4, 0, 0, -21, 0, 0, 0, 0, -20, 27, 18, 4, 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); +procedure handleTail; forward; +function getShortString: shortstring; forward; -procedure handler_ASKPASSWORD; -begin -end; +// generated stuff here +const letters: array[0..211] of char = ('A', 'S', 'K', 'P', 'A', 'S', 'S', 'W', + 'O', 'R', 'D', #10, 'B', 'A', 'N', 'L', 'I', 'S', 'T', #10, 'Y', 'E', #10, 'C', + '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', 'O', 'O', 'M', 'S', #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..211] of integer = (12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + -39, 11, 7, 0, 0, 0, 0, 0, -38, 0, 0, -37, 26, 4, 0, 0, -36, 12, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, -35, 0, 0, 0, 0, 0, 0, 0, 0, -34, 8, 2, -33, 0, 0, 0, 0, -32, 7, + 0, 0, 0, 0, 0, -31, 5, 0, 0, 0, -30, 11, 0, 0, 0, 3, 0, -29, 0, 0, 0, -28, 7, 0, + 0, 0, 0, 0, -27, 22, 4, 0, 0, -26, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, -25, 0, 0, + 0, 0, -24, 11, 4, 0, 0, -23, 0, 0, 0, 0, 0, -22, 10, 4, 0, 0, -21, 0, 0, 0, 0, + -20, 27, 18, 4, 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); -procedure handler_BANLIST; +procedure handler_; begin -end; - -procedure handler_BYE; -begin -end; - -procedure handler_CHAT; -begin -end; - -procedure handler_CLIENT_FLAGS; -begin + sendUI(mtNetData, @state.cmd, sizeof(state.cmd)); + writeln('handler_'); + handleTail() end; -procedure handler_CONNECTED; -var data: TCmdConnectedData; +procedure handler_L; begin - sendUI(mtNetData, nil, 0); -end; - -procedure handler_EM; -begin -end; - -procedure handler_HH_NUM; -begin + writeln('handler_L'); + handleTail() end; -procedure handler_INFO; -begin -end; - -procedure handler_JOINED; +procedure handler_ML; begin -end; - -procedure handler_JOINING; -begin -end; - -procedure handler_KICKED; -begin -end; - -procedure handler_LEFT; -begin + writeln('handler_ML'); + handleTail() end; -procedure handler_LOBBY_JOINED; +procedure handler_MS; +var cmd: TCmdParamS; + f: boolean; begin -end; + sendUI(mtNetData, @state.cmd, sizeof(state.cmd)); + writeln('handler_MS'); + cmd.cmd:= Succ(state.cmd); -procedure handler_LOBBY_LEFT; -begin -end; - -procedure handler_NICK; -begin + repeat + cmd.str1:= getShortString; + f:= cmd.str1[0] <> #0; + if f then + sendUI(mtNetData, @cmd, sizeof(cmd)); + until not f end; -procedure handler_NOTICE; -begin -end; - -procedure handler_PING; +procedure handler_S; begin - sendNet('PONG') -end; - -procedure handler_PROTO; -begin -end; - -procedure handler_ROOMS; -begin + writeln('handler_S'); + handleTail() end; -procedure handler_ROUND_FINISHED; +procedure handler_SL; begin + writeln('handler_SL'); + handleTail() end; -procedure handler_RUN_GAME; +procedure handler_SMS; begin -end; - -procedure handler_SERVER_AUTH; -begin -end; - -procedure handler_SERVER_MESSAGE; -begin + writeln('handler_SMS'); + handleTail() end; -procedure handler_SERVER_VARS; +procedure handler__i; +var cmd: TCmdParami; begin -end; - -procedure handler_TEAM_ACCEPTED; -begin + writeln('handler__i'); + getShortString; + cmd.cmd:= state.cmd; + cmd.param1:= strToInt(getShortString); + sendUI(mtNetData, @cmd, sizeof(cmd)); + handleTail() end; -procedure handler_TEAM_COLOR; +procedure handler_i; begin + writeln('handler_i'); + handleTail() end; -procedure handler_WARNING; -begin -end; - -procedure handler___UNKNOWN__; +procedure handler__UNKNOWN_; begin writeln('[NET] Unknown cmd'); end; -const handlers: array[0..28] of PHandler = (@handler___UNKNOWN__, @handler_WARNING, @handler_TEAM_COLOR, @handler_TEAM_ACCEPTED, @handler_SERVER_VARS, @handler_SERVER_MESSAGE, @handler_SERVER_AUTH, @handler_RUN_GAME, @handler_ROUND_FINISHED, @handler_ROOMS, @handler_PROTO, @handler_PING, @handler_NOTICE, @handler_NICK, @handler_LOBBY_LEFT, @handler_LOBBY_JOINED, @handler_LEFT, @handler_KICKED, @handler_JOINING, @handler_JOINED, @handler_INFO, @handler_HH_NUM, @handler_EM, @handler_CONNECTED, @handler_CLIENT_FLAGS, @handler_CHAT, @handler_BYE, @handler_BANLIST, @handler_ASKPASSWORD); +const handlers: array[0..29] of PHandler = (@handler__UNKNOWN_, @handler_L, @handler_MS, @handler_S, + @handler_SL, @handler_L, @handler_S, @handler_, @handler_, @handler_MS, + @handler_i, @handler_MS, @handler_L, @handler_S, @handler_SL, @handler_MS, + @handler_SMS, @handler_, @handler_S, @handler_MS, @handler_MS, @handler_MS, + @handler_L, @handler_ML, @handler__i, @handler_SMS, @handler_SL, @handler_SL, + @handler_MS, @handler_S); +const net2cmd: array[0..29] 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_ROOMS, 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_BYE, cmd_BANLIST, + cmd_ASKPASSWORD); // end of generated stuff @@ -233,16 +224,15 @@ if c = letters[state.l] then if commands[state.l] < 0 then begin - state.cmd:= TCmdType(-10 - commands[state.l]); + state.cmd:= net2cmd[-10 - commands[state.l]]; writeln('[NET] ', state.cmd); handlers[-10 - commands[state.l]](); - handleTail() end else inc(state.l) else begin - handler___UNKNOWN__(); + handler__UNKNOWN_(); handleTail() end end @@ -259,6 +249,25 @@ ipcToNet(s + endCmd); 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; + procedure netSendCallback(p: pointer; msg: PChar; len: Longword); begin // W A R N I N G: totally thread-unsafe due to use of sock variable diff -r b894922d58cc -r ffff8a0d1a76 hedgewars/uFLNetProtocol.pas --- a/hedgewars/uFLNetProtocol.pas Mon Nov 16 22:57:24 2015 +0300 +++ b/hedgewars/uFLNetProtocol.pas Wed Nov 18 22:18:39 2015 +0300 @@ -4,11 +4,196 @@ procedure passNetData(p: pointer); cdecl; implementation -uses uFLNetTypes; +uses uFLNetTypes, uFLTypes, uFLUICallback, uFLNet; + +type + PHandler = procedure (var t: TCmdData); + +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 +end; + +procedure handler_CHAT(var p: TCmdParamSL); +begin +end; + +procedure handler_CLIENT_FLAGS(var p: TCmdParamS); +begin +end; + +procedure handler_CLIENT_FLAGS_s(var s: TCmdParamS); +begin +end; + +procedure handler_CONNECTED(var p: TCmdParami); +begin + writeln('Connected!!!!! ', p.param1) +end; + +procedure handler_EM(var p: TCmdParam); +begin +end; + +procedure handler_EM_s(var s: TCmdParamS); +begin +end; + +procedure handler_ERROR(var p: TCmdParamL); +begin +end; + +procedure handler_HH_NUM(var p: TCmdParam); +begin +end; + +procedure handler_HH_NUM_s(var s: TCmdParamS); +begin +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 +end; + +procedure handler_JOINING(var p: TCmdParamS); +begin +end; + +procedure handler_KICKED(var p: TCmdParam); +begin +end; + +procedure handler_LEFT(var p: TCmdParamS); +begin +end; + +procedure handler_LEFT_s(var s: TCmdParamS); +begin +end; + +procedure handler_LOBBY_JOINED(var p: TCmdParam); +begin +end; + +procedure handler_LOBBY_JOINED_s(var s: TCmdParamS); +begin +end; + +procedure handler_LOBBY_LEFT(var p: TCmdParamSL); +begin +end; + +procedure handler_NICK(var p: TCmdParamS); +begin +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 +end; + +procedure handler_ROOMS(var p: TCmdParam); +begin +end; + +procedure handler_ROOMS_s(var s: TCmdParamS); +begin +end; + +procedure handler_ROUND_FINISHED(var p: TCmdParam); +begin +end; + +procedure handler_RUN_GAME(var p: TCmdParam); +begin +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 +end; + +procedure handler_TEAM_COLOR(var p: TCmdParam); +begin +end; + +procedure handler_TEAM_COLOR_s(var s: TCmdParamS); +begin +end; + +procedure handler_WARNING(var p: TCmdParamL); +begin +end; + +const handlers: array[TCmdType] of PHandler = (PHandler(@handler_ASKPASSWORD), + PHandler(@handler_BANLIST), PHandler(@handler_BANLIST_s), + PHandler(@handler_BYE), 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_HH_NUM_s), 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_LEFT_s), 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_ROOMS), + PHandler(@handler_ROOMS_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_TEAM_COLOR_s), PHandler(@handler_WARNING)); procedure passNetData(p: pointer); cdecl; begin - + handlers[TCmdData(p^).cmd.cmd](TCmdData(p^)) end; end. + diff -r b894922d58cc -r ffff8a0d1a76 hedgewars/uFLNetTypes.pas --- a/hedgewars/uFLNetTypes.pas Mon Nov 16 22:57:24 2015 +0300 +++ b/hedgewars/uFLNetTypes.pas Wed Nov 18 22:18:39 2015 +0300 @@ -1,14 +1,43 @@ unit uFLNetTypes; interface -type TCmdType = (cmd___UNKNOWN__, cmd_WARNING, cmd_TEAM_COLOR, cmd_TEAM_ACCEPTED, cmd_SERVER_VARS, cmd_SERVER_MESSAGE, cmd_SERVER_AUTH, cmd_RUN_GAME, cmd_ROUND_FINISHED, cmd_ROOMS, 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_EM, cmd_CONNECTED, cmd_CLIENT_FLAGS, cmd_CHAT, cmd_BYE, cmd_BANLIST, cmd_ASKPASSWORD); - TCmdConnectedData = record - cmd: TCmdType; - protocolNumber: Longword - end; +type TCmdType = (cmd_ASKPASSWORD, cmd_BANLIST, cmd_BANLIST_s, cmd_BYE, cmd_CHAT, + cmd_CLIENT_FLAGS, cmd_CLIENT_FLAGS_s, cmd_CONNECTED, cmd_EM, cmd_EM_s, + cmd_ERROR, cmd_HH_NUM, cmd_HH_NUM_s, cmd_INFO, cmd_INFO_s, cmd_JOINED, + cmd_JOINED_s, cmd_JOINING, cmd_KICKED, cmd_LEFT, cmd_LEFT_s, cmd_LOBBY_JOINED, + cmd_LOBBY_JOINED_s, cmd_LOBBY_LEFT, cmd_NICK, cmd_NOTICE, cmd_PING, cmd_PING_s, + cmd_PROTO, cmd_ROOMS, cmd_ROOMS_s, cmd_ROUND_FINISHED, cmd_RUN_GAME, + cmd_SERVER_AUTH, cmd_SERVER_MESSAGE, cmd_SERVER_VARS, cmd_TEAM_ACCEPTED, + cmd_TEAM_COLOR, cmd_TEAM_COLOR_s, cmd_WARNING); + + type TCmdParam = packed record + cmd: TCmdType; + end; + type TCmdParamL = packed record + cmd: TCmdType; + str1: string; + end; + type TCmdParamS = packed record + cmd: TCmdType; + str1: shortstring; + end; + type TCmdParamSL = packed record + cmd: TCmdType; + str1: shortstring; + str2: string; + end; + type TCmdParami = packed record + cmd: TCmdType; + param1: LongInt; + end; + TCmdData = record case byte of - 0: (cmdConnected: TCmdConnectedData) + 0: (cmd: TCmdParam); + 1: (cpl: TCmdParamL); + 2: (cps: TCmdParamS); + 3: (cpsl: TCmdParamSL); + 4: (cpi: TCmdParami); end; implementation diff -r b894922d58cc -r ffff8a0d1a76 tools/protocolParser.hs --- a/tools/protocolParser.hs Mon Nov 16 22:57:24 2015 +0300 +++ b/tools/protocolParser.hs Wed Nov 18 22:18:39 2015 +0300 @@ -96,7 +96,12 @@ , cmd "ROUND_FINISHED" [] ] -unknowncmd = PTPrefix "$" [PTCommand "$" $ Command "__UNKNOWN__" [Many [SS]]] +hasMany = any isMany +isMany (Many _) = True +isMany _ = False + +unknown = Command "__UNKNOWN__" [Many [SS]] +unknowncmd = PTPrefix "$" [PTCommand "$" $ unknown] fixName = map fixChar fixChar c | isLetter c = c @@ -135,7 +140,7 @@ zeroChar = text "#0: state:= pstDisconnected;" elsePart = text "else end;" -renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, {-bodies, -}c, structs, realHandlers, realHandlersArray] +renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, cmds, l, s, c, bodies, structs, realHandlers, realHandlersArray] where maybeQuotes "$" = text "#0" maybeQuotes s = if null $ tail s then quotes $ text s else text s @@ -145,28 +150,30 @@ <> parens (hsep . punctuate comma $ map text commands) <> semi c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = " <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi - handlerTypes = map cmdParams2handlerType sortedCmdDescriptions - sortedCmdDescriptions = reverse $ sort commandsDescription + grr = text "const net2cmd: array[0.." <> (int $ length fixedNames - 1) <> text "] of TCmdType = " + <> parens (hsep . punctuate comma $ map (text . (++) "cmd_") $ reverse fixedNames) <> semi + handlerTypes = map cmdParams2handlerType $ reverse sortedCmdDescriptions + sortedCmdDescriptions = sort commandsDescription fixedNames = map fixName handlers - bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames - handlerBody n = text "procedure handler_" <> text n <> semi + bodies = vcat $ punctuate (char '\n') $ map handlerBody $ nub $ sort handlerTypes + handlerBody n = text "procedure " <> text n <> semi $+$ text "begin" $+$ text "end" <> semi - cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi + cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ concatMap (rhentry "cmd_") $ sortedCmdDescriptions) <> semi structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription) - realHandlers = vcat $ punctuate (char '\n') $ map rh sortedCmdDescriptions + realHandlers = vcat $ punctuate (char '\n') $ map rh $ sortedCmdDescriptions realHandlersArray = text "const handlers: array[TCmdType] of PHandler = " - <> parens (hsep . punctuate comma . (:) (text "@handler__UNKNOWN_") $ map (text . (++) "@handler_" . fixName . cmdName) sortedCmdDescriptions) <> semi + <> parens (hsep . punctuate comma . concatMap (rhentry "@handler_") $ sortedCmdDescriptions) <> semi rh cmd@(Command n p) = text "procedure handler_" <> text (fixName n) <> parens (text "var p: " <> text (cmdParams2str cmd)) <> semi - $+$ emptyBody $+$ if hasMany then vcat [space, text "procedure handler_" <> text (fixName n) <> text "_s" <> parens (text "var s: shortstring") <> semi + $+$ emptyBody $+$ if hasMany p then vcat [space, text "procedure handler_" <> text (fixName n) <> text "_s" <> parens (text "var s: TCmdParamS") <> semi , emptyBody] else empty where - hasMany = any isMany p - isMany (Many _) = True - isMany _ = False emptyBody = text "begin" $+$ text "end" <> semi +rhentry prefix cmd@(Command n p) = map ((<>) (text "PHandler") . parens) $ (text . (++) prefix . fixName . cmdName $ cmd) + : if hasMany p then [text . flip (++) "_s" . (++) prefix . fixName . cmdName $ cmd] else [] + pas = renderArrays $ buildTables $ buildParseTree commandsDescription where buildTables cmds = let (_, _, _, t1, t2, t3) = foldr walk (0, [0], -10, [], [], [[]]) cmds in (tail t1, tail t2, concat t3)