tools/pas2c/landTemplatesUnit2yaml.hs
author Wuzzy <Wuzzy2@mail.ru>
Thu, 25 Apr 2019 23:01:05 +0200
changeset 14844 e239378a9400
parent 13903 b95074eb8d57
permissions -rw-r--r--
Prevent entering “/”, “\” and “:” in team and scheme names. The name of teams and schems is saved in the file name itself, so these characters would cause trouble as they are used in path names in Linux and Windows.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13892
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]
13903
b95074eb8d57 Convert uLandTemplates into yaml file
unc0rr
parents: 13892
diff changeset
    65
        breakNTPX (InitArray ia) = map InitArray . filter ((<) 0 . length) . map (filter (not . isNtpx)) $ groupBy (\a b -> isNtpx a == isNtpx b) ia
13892
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