# HG changeset patch # User unc0rr # Date 1441473169 -10800 # Node ID 842eb00b36ac2ac616a72d3c35663ecf6b50e1fe # Parent 3ecf0610700502a5ab759b1188e5793302a895e7 Generate handlers for lists diff -r 3ecf06107005 -r 842eb00b36ac tools/protocolParser.hs --- a/tools/protocolParser.hs Thu Sep 03 23:33:06 2015 +0300 +++ b/tools/protocolParser.hs Sat Sep 05 20:12:49 2015 +0300 @@ -72,7 +72,6 @@ , cmd1 "TEAM_ACCEPTED" SS , cmd1 "HH_NUM" $ Many [SS] , cmd1 "TEAM_COLOR" $ Many [SS] - , cmd1 "TEAM_ACCEPTED" SS , cmd1 "BANLIST" $ Many [SS] , cmd1 "JOINED" $ Many [SS] , cmd1 "LOBBY:JOINED" $ Many [SS] @@ -97,6 +96,10 @@ unknowncmd = PTPrefix "$" [PTCommand "$" $ Command "__UNKNOWN__" [Many [SS]]] +fixName = map fixChar +fixChar c | isLetter c = c + | otherwise = '_' + groupByFirstChar :: [ParseTree] -> [(Char, [ParseTree])] groupByFirstChar = MM.assocs . MM.fromList . map breakCmd where @@ -143,9 +146,6 @@ handlerTypes = map cmdParams2handlerType sortedCmdDescriptions sortedCmdDescriptions = reverse $ sort commandsDescription fixedNames = map fixName handlers - fixName = map fixChar - fixChar c | isLetter c = c - | otherwise = '_' bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames handlerBody n = text "procedure handler_" <> text n <> semi $+$ text "begin" @@ -153,9 +153,15 @@ cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription) realHandlers = vcat $ punctuate (char '\n') $ map rh sortedCmdDescriptions - rh cmd@(Command n _) = text "procedure handler_" <> text (fixName n) <> parens (text "var p: " <> text (cmdParams2str cmd)) <> semi - $+$ text "begin" - $+$ text "end" <> 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] else empty + where + hasMany = any isMany p + isMany (Many _) = True + isMany _ = False + emptyBody = text "begin" $+$ text "end" <> semi pas = renderArrays $ buildTables $ buildParseTree commandsDescription where