tools/pas2c/landTemplatesUnit2yaml.hs
author alfadur
Tue, 28 Mar 2023 17:53:30 +0300
changeset 15944 ccd458b08113
parent 13898 b95074eb8d57
permissions -rw-r--r--
add iteration overhead benchmark
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13887
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE OverloadedStrings #-}
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     2
module Main where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     3
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     4
import Control.Monad
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     5
import Data.Maybe
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     6
import qualified Data.Yaml as YAML
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     7
import Data.Yaml ((.=))
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     8
import Data.List
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
     9
import qualified Data.ByteString.Char8 as B
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    10
import qualified Data.Text as Text
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    11
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    12
import PascalUnitSyntaxTree
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    13
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    14
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    15
fixName :: String -> String
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    16
fixName "MaxHedgeHogs" = "max_hedgehogs"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    17
fixName"canFlip" = "can_flip"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    18
fixName"canInvert" = "can_invert"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    19
fixName"canMirror" = "can_mirror"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    20
fixName"TemplateWidth" = "width"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    21
fixName"TemplateHeight" = "height"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    22
fixName"RandPassesCount" = "rand_passes"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    23
fixName"BezierizeCount" = "bezie_passes"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    24
fixName"hasGirders" = "put_girders"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    25
fixName"isNegative" = "is_negative"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    26
fixName a = a
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    27
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    28
instance YAML.ToJSON InitExpression where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    29
  toJSON (InitArray ar) = YAML.toJSON ar
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    30
  toJSON (InitRecord ar) = YAML.object $ map (\(Identifier i _, iref) ->  Text.pack (fixName i) .= iref) $ filter isRelevant ar
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    31
    where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    32
        isRelevant (Identifier i _, _) | i `elem` ["BasePoints", "FillPoints", "BasePointsCount", "FillPointsCount"] = False
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    33
        isRelevant _ = True
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    34
  toJSON (InitTypeCast {}) = YAML.object []
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    35
  toJSON (BuiltInFunction {}) = YAML.object []
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    36
  toJSON (InitNumber n) = YAML.toJSON (read n :: Int)
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    37
  toJSON (InitReference (Identifier "true" _)) = YAML.toJSON True
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    38
  toJSON (InitReference (Identifier "false" _)) = YAML.toJSON False
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    39
  toJSON a = error $ show a
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    40
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    41
instance YAML.ToJSON Identifier where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    42
    toJSON (Identifier i _) = YAML.toJSON i
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    43
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    44
data Template = Template InitExpression ([InitExpression], InitExpression)
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    45
    deriving Show
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    46
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    47
instance YAML.ToJSON Template where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    48
    toJSON (Template (InitRecord ri) (points, fpoints)) = YAML.toJSON $ InitRecord $ ri ++ [(Identifier "outline_points" BTUnknown, InitArray points), (Identifier "fill_points" BTUnknown, fpoints)]
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    49
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    50
takeLast i = reverse . take i . reverse
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    51
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    52
extractDeclarations  :: PascalUnit -> [TypeVarDeclaration]
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    53
extractDeclarations (Unit (Identifier "uLandTemplates" _) (Interface _ (TypesAndVars decls)) _ _ _) = decls
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    54
extractDeclarations _ = error "Unexpected file structure"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    55
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    56
extractTemplatePoints :: Int -> [TypeVarDeclaration] -> ([InitExpression], InitExpression)
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    57
extractTemplatePoints templateNumber decls = (breakNTPX . head . catMaybes $ map (toTemplatePointInit "Points") decls, head . catMaybes $ map (toTemplatePointInit "FPoints") decls)
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    58
    where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    59
        toTemplatePointInit suffix (VarDeclaration False False ([Identifier i _], _) ie)
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    60
            | (i == "Template" ++ show templateNumber ++ suffix) = ie
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    61
            | otherwise = Nothing
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    62
        toTemplatePointInit _ _ = Nothing
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    63
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    64
        breakNTPX :: InitExpression -> [InitExpression]
13898
b95074eb8d57 Convert uLandTemplates into yaml file
unc0rr
parents: 13887
diff changeset
    65
        breakNTPX (InitArray ia) = map InitArray . filter ((<) 0 . length) . map (filter (not . isNtpx)) $ groupBy (\a b -> isNtpx a == isNtpx b) ia
13887
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    66
        breakNTPX a = error $ show a
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    67
        isNtpx :: InitExpression -> Bool
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    68
        isNtpx (InitRecord ((Identifier "x" _, InitReference (Identifier "NTPX" _)):_)) = True
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    69
        isNtpx _ = False
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    70
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    71
extractTemplates :: [TypeVarDeclaration] -> [Template]
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    72
extractTemplates decls = map toFull $ zip (head . catMaybes $ map toTemplateInit decls) [0..]
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    73
    where
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    74
        toTemplateInit (VarDeclaration False False ([Identifier "EdgeTemplates" _], _) (Just (InitArray ia))) = Just ia
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    75
        toTemplateInit _ = Nothing
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    76
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    77
        toFull (ie, num) = let ps = extractTemplatePoints num decls in if "NTPX" `isInfixOf` show ps then error $ show num ++ " " ++ show ps else Template ie ps
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    78
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    79
convert :: PascalUnit -> B.ByteString
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    80
convert pu = YAML.encode . extractTemplates . extractDeclarations $ pu
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    81
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    82
main = do
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    83
    f <- liftM read $ readFile "uLandTemplates.dump"
5988e73080a3 Make converter for uLandTemplates into yaml
unc0rr
parents:
diff changeset
    84
    B.putStrLn $ convert f