--- /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