tools/protocolParser.hs
branchqmlfrontend
changeset 11434 d96a37de1076
parent 11433 cc12bba5b2a2
child 11446 908aed8525f9
equal deleted inserted replaced
11433:cc12bba5b2a2 11434:d96a37de1076
    98         , cmd "ROUND_FINISHED" []
    98         , cmd "ROUND_FINISHED" []
    99         , cmd1 "ADD_TEAM" $ Many [SS]
    99         , cmd1 "ADD_TEAM" $ Many [SS]
   100         , cmd1 "REMOVE_TEAM" SS
   100         , cmd1 "REMOVE_TEAM" SS
   101         , cmd1 "CFG~MAP" SS
   101         , cmd1 "CFG~MAP" SS
   102         , cmd1 "CFG~SEED" SS
   102         , cmd1 "CFG~SEED" SS
       
   103         , cmd1 "CFG~SCHEME" $ Many [SS]
   103         , cmd1 "CFG~THEME" SS
   104         , cmd1 "CFG~THEME" SS
   104         , cmd1 "CFG~TEMPLATE" IntP
   105         , cmd1 "CFG~TEMPLATE" IntP
   105         , cmd1 "CFG~MAPGEN" IntP
   106         , cmd1 "CFG~MAPGEN" IntP
   106         , cmd1 "CFG~FEATURE_SIZE" IntP
   107         , cmd1 "CFG~FEATURE_SIZE" IntP
   107         , cmd1 "CFG~MAZE_SIZE" IntP
   108         , cmd1 "CFG~MAZE_SIZE" IntP
   108         , cmd1 "CFG~SCRIPT" SS
   109         , cmd1 "CFG~SCRIPT" SS
   109         , cmd1 "CFG~DRAWNMAP" LS
   110         , cmd1 "CFG~DRAWNMAP" LS
   110         , cmd2 "CFG~AMMO" SS LS
   111         , cmd2 "CFG~AMMO" SS LS
   111         , cmd1 "FULLMAPCONFIG" $ Many [LS]
   112         , cmd1 "CFG~FULLMAPCONFIG" $ Many [LS]
   112     ]
   113     ]
   113 
   114 
   114 hasMany = any isMany
   115 hasMany = any isMany
   115 isMany (Many _) = True
   116 isMany (Many _) = True
   116 isMany _ = False
   117 isMany _ = False
   150 dumpTree = vcat . map dt
   151 dumpTree = vcat . map dt
   151     where
   152     where
   152     dt (PTPrefix s st) = text s $$ (nest (length s) $ vcat $ map dt st)
   153     dt (PTPrefix s st) = text s $$ (nest (length s) $ vcat $ map dt st)
   153     dt _ = char '$'
   154     dt _ = char '$'
   154 
   155 
   155 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, cmds, l, s, c, bodies, structs, realHandlers, realHandlersArray]
   156 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, l, s, c, bodies, structs, realHandlers, realHandlersArray, cmds]
   156     where
   157     where
   157         maybeQuotes "$" = text "#0"
   158         maybeQuotes "$" = text "#0"
   158         maybeQuotes "~" = text "#10"
   159         maybeQuotes "~" = text "#10"
   159         maybeQuotes s = if null $ tail s then quotes $ text s else text s
   160         maybeQuotes s = if null $ tail s then quotes $ text s else text s
   160         l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = "
   161         l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = "
   163             <> parens (hsep . punctuate comma $ map text commands) <> semi
   164             <> parens (hsep . punctuate comma $ map text commands) <> semi
   164         c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = "
   165         c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = "
   165             <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi
   166             <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi
   166         grr = text "const net2cmd: array[0.." <> (int $ length fixedNames - 1) <> text "] of TCmdType = "
   167         grr = text "const net2cmd: array[0.." <> (int $ length fixedNames - 1) <> text "] of TCmdType = "
   167             <> parens (hsep . punctuate comma $ map (text . (++) "cmd_") $ reverse fixedNames) <> semi
   168             <> parens (hsep . punctuate comma $ map (text . (++) "cmd_") $ reverse fixedNames) <> semi
   168         handlerTypes = map cmdParams2handlerType $ reverse sortedCmdDescriptions
   169         handlerTypes = "handler__UNKNOWN_" : (map cmdParams2handlerType $ reverse sortedCmdDescriptions)
   169         sortedCmdDescriptions = sort commandsDescription
   170         sortedCmdDescriptions = sort commandsDescription
   170         fixedNames = map fixName handlers
   171         fixedNames = map fixName handlers
   171         bodies = vcat $ punctuate (char '\n') $ map handlerBody $ nub $ sort handlerTypes
   172         bodies = vcat $ punctuate (char '\n') $ map handlerBody $ nub $ sort handlerTypes
   172         handlerBody n = text "procedure " <> text n <> semi
   173         handlerBody n = text "procedure " <> text n <> semi
   173             $+$ text "begin"
   174             $+$ text "begin"