| branch | qmlfrontend |
| changeset 11076 | fcbdee9cdd74 |
| parent 11075 | 842eb00b36ac |
| child 11413 | ffff8a0d1a76 |
| 11075:842eb00b36ac | 11076:fcbdee9cdd74 |
|---|---|
28 | PTCommand String HWProtocol |
28 | PTCommand String HWProtocol |
29 |
29 |
30 cmd = Command |
30 cmd = Command |
31 cmd1 s p = Command s [p] |
31 cmd1 s p = Command s [p] |
32 cmd2 s p1 p2 = Command s [p1, p2] |
32 cmd2 s p1 p2 = Command s [p1, p2] |
33 |
|
34 cmdName (Command n _) = n |
|
33 |
35 |
34 cmdParams2str (Command _ p) = "TCmdParam" ++ concatMap f p |
36 cmdParams2str (Command _ p) = "TCmdParam" ++ concatMap f p |
35 where |
37 where |
36 f Skip = "" |
38 f Skip = "" |
37 f SS = "S" |
39 f SS = "S" |
131 consumePrefix "" = id |
133 consumePrefix "" = id |
132 consumePrefix str = (text "consume" <> (parens . quotes $ text str) <> semi $$) |
134 consumePrefix str = (text "consume" <> (parens . quotes $ text str) <> semi $$) |
133 zeroChar = text "#0: state:= pstDisconnected;" |
135 zeroChar = text "#0: state:= pstDisconnected;" |
134 elsePart = text "else <unknown cmd> end;" |
136 elsePart = text "else <unknown cmd> end;" |
135 |
137 |
136 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, {-bodies, -}c, structs, realHandlers] |
138 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, {-bodies, -}c, structs, realHandlers, realHandlersArray] |
137 where |
139 where |
138 maybeQuotes "$" = text "#0" |
140 maybeQuotes "$" = text "#0" |
139 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
141 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
140 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
142 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
141 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
143 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
151 $+$ text "begin" |
153 $+$ text "begin" |
152 $+$ text "end" <> semi |
154 $+$ text "end" <> semi |
153 cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi |
155 cmds = text "type TCmdType = " <> parens (hsep $ punctuate comma $ map ((<>) (text "cmd_") . text) $ reverse fixedNames) <> semi |
154 structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription) |
156 structs = vcat (map text . Set.toList . Set.fromList $ map cmdParams2record commandsDescription) |
155 realHandlers = vcat $ punctuate (char '\n') $ map rh sortedCmdDescriptions |
157 realHandlers = vcat $ punctuate (char '\n') $ map rh sortedCmdDescriptions |
158 realHandlersArray = text "const handlers: array[TCmdType] of PHandler = " |
|
159 <> parens (hsep . punctuate comma . (:) (text "@handler__UNKNOWN_") $ map (text . (++) "@handler_" . fixName . cmdName) sortedCmdDescriptions) <> semi |
|
156 |
160 |
157 rh cmd@(Command n p) = text "procedure handler_" <> text (fixName n) <> parens (text "var p: " <> text (cmdParams2str cmd)) <> semi |
161 rh cmd@(Command n p) = text "procedure handler_" <> text (fixName n) <> parens (text "var p: " <> text (cmdParams2str cmd)) <> semi |
158 $+$ emptyBody $+$ if hasMany then vcat [space, text "procedure handler_" <> text (fixName n) <> text "_s" <> parens (text "var s: shortstring") <> semi |
162 $+$ emptyBody $+$ if hasMany then vcat [space, text "procedure handler_" <> text (fixName n) <> text "_s" <> parens (text "var s: shortstring") <> semi |
159 , emptyBody] else empty |
163 , emptyBody] else empty |
160 where |
164 where |