# HG changeset patch # User unc0rr # Date 1539463131 -7200 # Node ID 5988e73080a3fc79f172b50aaf3be4e92e2154a8 # Parent b6c35ac1c5ba37d11e14e7d35f0e4e07ae73c4e0 Make converter for uLandTemplates into yaml diff -r b6c35ac1c5ba -r 5988e73080a3 hedgewars/uLandTemplates.pas --- a/hedgewars/uLandTemplates.pas Sat Oct 13 18:32:41 2018 +0200 +++ b/hedgewars/uLandTemplates.pas Sat Oct 13 22:38:51 2018 +0200 @@ -1805,7 +1805,6 @@ (x:1005; y: 805; w: 0; h: 0) ); - const Template46Points: array[0..19] of TSDL_Rect = ( (x: 800; y: 1424; w: 1; h: 1), diff -r b6c35ac1c5ba -r 5988e73080a3 tools/pas2c/Pas2C.hs --- a/tools/pas2c/Pas2C.hs Sat Oct 13 18:32:41 2018 +0200 +++ b/tools/pas2c/Pas2C.hs Sat Oct 13 22:38:51 2018 +0200 @@ -186,6 +186,7 @@ toCFiles _ _ (_, Redo _) = return () toCFiles outputPath ns pu@(fileName, _) = do hPutStrLn stdout $ "Rendering '" ++ fileName ++ "'..." + --let (fn, p) = pu in writeFile (outputPath ++ fn ++ ".dump") $ show p toCFiles' pu where toCFiles' (fn, p@(Program {})) = writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p diff -r b6c35ac1c5ba -r 5988e73080a3 tools/pas2c/PascalUnitSyntaxTree.hs --- a/tools/pas2c/PascalUnitSyntaxTree.hs Sat Oct 13 18:32:41 2018 +0200 +++ b/tools/pas2c/PascalUnitSyntaxTree.hs Sat Oct 13 22:38:51 2018 +0200 @@ -5,20 +5,20 @@ | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize) | System [TypeVarDeclaration] | Redo [TypeVarDeclaration] - deriving (Show, Eq) + deriving (Show, Read, Eq) data Interface = Interface Uses TypesAndVars - deriving (Show, Eq) + deriving (Show, Read, Eq) data Implementation = Implementation Uses TypesAndVars - deriving (Show, Eq) + deriving (Show, Read, Eq) data Identifier = Identifier String BaseType - deriving (Show, Eq) + deriving (Show, Read, Eq) data TypesAndVars = TypesAndVars [TypeVarDeclaration] - deriving (Show, Eq) + deriving (Show, Read, Eq) data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression) | FunctionDeclaration Identifier Bool Bool Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) | OperatorDeclaration String Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) - deriving (Show, Eq) + deriving (Show, Read, Eq) data TypeDecl = SimpleType Identifier | RangeType Range | Sequence [Identifier] @@ -32,17 +32,17 @@ | DeriveType InitExpression | VoidType | VarParamType TypeDecl -- this is a hack - deriving (Show, Eq) + deriving (Show, Read, Eq) data Range = Range Identifier | RangeFromTo InitExpression InitExpression | RangeInfinite - deriving (Show, Eq) + deriving (Show, Read, Eq) data Initialize = Initialize String - deriving (Show, Eq) + deriving (Show, Read, Eq) data Finalize = Finalize String - deriving (Show, Eq) + deriving (Show, Read, Eq) data Uses = Uses [Identifier] - deriving (Show, Eq) + deriving (Show, Read, Eq) data Phrase = ProcCall Reference [Expression] | IfThenElse Expression Phrase (Maybe Phrase) | WhileCycle Expression Phrase @@ -54,7 +54,7 @@ | Assignment Reference Expression | BuiltInFunctionCall [Expression] Reference | NOP - deriving (Show, Eq) + deriving (Show, Read, Eq) data Expression = Expression String | BuiltInFunCall [Expression] Reference | PrefixOp String Expression @@ -70,7 +70,7 @@ | Reference Reference | SetExpression [Identifier] | Null - deriving (Show, Eq) + deriving (Show, Read, Eq) data Reference = ArrayElement [Expression] Reference | FunCall [Expression] Reference | TypeCast Identifier Expression @@ -79,7 +79,7 @@ | RecordField Reference Reference | Address Reference | RefExpression Expression - deriving (Show, Eq) + deriving (Show, Read, Eq) data InitExpression = InitBinOp String InitExpression InitExpression | InitPrefixOp String InitExpression | InitReference Identifier @@ -97,7 +97,7 @@ | InitNull | InitRange Range | InitTypeCast Identifier InitExpression - deriving (Show, Eq) + deriving (Show, Read, Eq) data BaseType = BTUnknown | BTChar @@ -116,4 +116,4 @@ | BTVoid | BTUnit | BTVarParam BaseType - deriving (Show, Eq) + deriving (Show, Read, Eq) diff -r b6c35ac1c5ba -r 5988e73080a3 tools/pas2c/landTemplatesUnit2yaml.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tools/pas2c/landTemplatesUnit2yaml.hs Sat Oct 13 22:38:51 2018 +0200 @@ -0,0 +1,84 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Monad +import Data.Maybe +import qualified Data.Yaml as YAML +import Data.Yaml ((.=)) +import Data.List +import qualified Data.ByteString.Char8 as B +import qualified Data.Text as Text + +import PascalUnitSyntaxTree + + +fixName :: String -> String +fixName "MaxHedgeHogs" = "max_hedgehogs" +fixName"canFlip" = "can_flip" +fixName"canInvert" = "can_invert" +fixName"canMirror" = "can_mirror" +fixName"TemplateWidth" = "width" +fixName"TemplateHeight" = "height" +fixName"RandPassesCount" = "rand_passes" +fixName"BezierizeCount" = "bezie_passes" +fixName"hasGirders" = "put_girders" +fixName"isNegative" = "is_negative" +fixName a = a + +instance YAML.ToJSON InitExpression where + toJSON (InitArray ar) = YAML.toJSON ar + toJSON (InitRecord ar) = YAML.object $ map (\(Identifier i _, iref) -> Text.pack (fixName i) .= iref) $ filter isRelevant ar + where + isRelevant (Identifier i _, _) | i `elem` ["BasePoints", "FillPoints", "BasePointsCount", "FillPointsCount"] = False + isRelevant _ = True + toJSON (InitTypeCast {}) = YAML.object [] + toJSON (BuiltInFunction {}) = YAML.object [] + toJSON (InitNumber n) = YAML.toJSON (read n :: Int) + toJSON (InitReference (Identifier "true" _)) = YAML.toJSON True + toJSON (InitReference (Identifier "false" _)) = YAML.toJSON False + toJSON a = error $ show a + +instance YAML.ToJSON Identifier where + toJSON (Identifier i _) = YAML.toJSON i + +data Template = Template InitExpression ([InitExpression], InitExpression) + deriving Show + +instance YAML.ToJSON Template where + toJSON (Template (InitRecord ri) (points, fpoints)) = YAML.toJSON $ InitRecord $ ri ++ [(Identifier "outline_points" BTUnknown, InitArray points), (Identifier "fill_points" BTUnknown, fpoints)] + +takeLast i = reverse . take i . reverse + +extractDeclarations :: PascalUnit -> [TypeVarDeclaration] +extractDeclarations (Unit (Identifier "uLandTemplates" _) (Interface _ (TypesAndVars decls)) _ _ _) = decls +extractDeclarations _ = error "Unexpected file structure" + +extractTemplatePoints :: Int -> [TypeVarDeclaration] -> ([InitExpression], InitExpression) +extractTemplatePoints templateNumber decls = (breakNTPX . head . catMaybes $ map (toTemplatePointInit "Points") decls, head . catMaybes $ map (toTemplatePointInit "FPoints") decls) + where + toTemplatePointInit suffix (VarDeclaration False False ([Identifier i _], _) ie) + | (i == "Template" ++ show templateNumber ++ suffix) = ie + | otherwise = Nothing + toTemplatePointInit _ _ = Nothing + + breakNTPX :: InitExpression -> [InitExpression] + breakNTPX (InitArray ia) = map (InitArray . filter (not . isNtpx)) $ groupBy (\a _ -> not $ isNtpx a) ia + breakNTPX a = error $ show a + isNtpx :: InitExpression -> Bool + isNtpx (InitRecord ((Identifier "x" _, InitReference (Identifier "NTPX" _)):_)) = True + isNtpx _ = False + +extractTemplates :: [TypeVarDeclaration] -> [Template] +extractTemplates decls = map toFull $ zip (head . catMaybes $ map toTemplateInit decls) [0..] + where + toTemplateInit (VarDeclaration False False ([Identifier "EdgeTemplates" _], _) (Just (InitArray ia))) = Just ia + toTemplateInit _ = Nothing + + toFull (ie, num) = let ps = extractTemplatePoints num decls in if "NTPX" `isInfixOf` show ps then error $ show num ++ " " ++ show ps else Template ie ps + +convert :: PascalUnit -> B.ByteString +convert pu = YAML.encode . extractTemplates . extractDeclarations $ pu + +main = do + f <- liftM read $ readFile "uLandTemplates.dump" + B.putStrLn $ convert f