# HG changeset patch
# User unc0rr
# Date 1321181186 -10800
# Node ID 734fed7aefd3fc66162d08c3e667ddfa0a801151
# Parent  d8f62c805619aa18d0f40c38630bff2c0cc742ba
Introduce initialization expressions

diff -r d8f62c805619 -r 734fed7aefd3 hedgewars/uLandGraphics.pas
--- a/hedgewars/uLandGraphics.pas	Sun Nov 13 18:23:05 2011 +0100
+++ b/hedgewars/uLandGraphics.pas	Sun Nov 13 13:46:26 2011 +0300
@@ -233,7 +233,7 @@
                begin
                by:= t div 2; bx:= i div 2;
                end;
-           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not disableLandBack then
+           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
                begin
                inc(cnt);
                LandPixels[by, bx]:= LandBackPixel(i, t)
@@ -255,7 +255,7 @@
                begin
                by:= t div 2; bx:= i div 2;
                end;
-           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not disableLandBack then
+           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
                begin
                inc(cnt);
                LandPixels[by, bx]:= LandBackPixel(i, t)
@@ -277,7 +277,7 @@
                begin
                by:= t div 2; bx:= i div 2;
                end;
-           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not disableLandBack then
+           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
                begin
                inc(cnt);
                LandPixels[by, bx]:= LandBackPixel(i, t)
@@ -298,7 +298,7 @@
                begin
                by:= t div 2; bx:= i div 2;
                end;
-           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not disableLandBack then
+           if ((Land[t, i] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not (disableLandBack) then
                begin
                inc(cnt);
                LandPixels[by, bx]:= LandBackPixel(i, t)
@@ -468,7 +468,7 @@
                     begin
                     by:= ty div 2; bx:= tx div 2;
                     end;
-                if ((Land[ty, tx] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not disableLandBack then
+                if ((Land[ty, tx] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
                     LandPixels[by, bx]:= LandBackPixel(tx, ty)
                 else if ((Land[ty, tx] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then 
                     LandPixels[by, bx]:= 0
@@ -588,7 +588,7 @@
                 begin
                 by:= ty div 2; bx:= tx div 2;
                 end;
-            if ((Land[ty, tx] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and not disableLandBack then
+            if ((Land[ty, tx] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then
                 LandPixels[by, bx]:= LandBackPixel(tx, ty)
             else if ((Land[ty, tx] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then
                 LandPixels[by, bx]:= 0;
diff -r d8f62c805619 -r 734fed7aefd3 tools/PascalParser.hs
--- a/tools/PascalParser.hs	Sun Nov 13 18:23:05 2011 +0100
+++ b/tools/PascalParser.hs	Sun Nov 13 13:46:26 2011 +0300
@@ -23,7 +23,7 @@
 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
-    | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression)
+    | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
     | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
     deriving Show
 data TypeDecl = SimpleType Identifier
@@ -49,7 +49,7 @@
         | WhileCycle Expression Phrase
         | RepeatCycle Expression [Phrase]
         | ForCycle Identifier Expression Expression Phrase
-        | WithBlock Expression Phrase
+        | WithBlock Reference Phrase
         | Phrases [Phrase]
         | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
         | Assignment Reference Expression
@@ -72,6 +72,18 @@
     | RecordField Reference Reference
     | Address Reference
     deriving Show
+data InitExpression = InitBinOp String InitExpression InitExpression
+    | InitPrefixOp String InitExpression
+    | InitReference Identifier
+    | InitArray [InitExpression]
+    | InitRecord [(Identifier, InitExpression)]
+    | InitFloat String
+    | InitNumber String
+    | InitHexNumber String
+    | InitString String
+    | InitChar String
+    | InitNull
+    deriving Show
     
 pascalLanguageDef
     = emptyDef
@@ -183,7 +195,7 @@
     init <- option Nothing $ do
         char '='
         comments
-        e <- expression
+        e <- initExpression
         comments
         return (Just e)
     return $ VarDeclaration False (ids, t) init
@@ -204,7 +216,7 @@
             return ()
         char '='
         comments
-        e <- expression
+        e <- initExpression
         comments
         return $ VarDeclaration False ([i], UnknownType) (Just e)
         
@@ -213,9 +225,9 @@
     , try (string "shortstring") >> return String
     , arrayDecl
     , recordDecl
+    , sequenceDecl >>= return . Sequence
+    , try (identifier pas) >>= return . SimpleType . Identifier
     , rangeDecl >>= return . RangeType
-    , sequenceDecl >>= return . Sequence
-    , identifier pas >>= return . SimpleType . Identifier
     ] <?> "type declaration"
     where
     arrayDecl = do
@@ -336,7 +348,7 @@
                 liftM Just functionBody
                 else
                 return Nothing
-        return $ [FunctionDeclaration i ret Nothing]
+        return $ [FunctionDeclaration i ret b]
 
 program = do
     string "program"
@@ -400,8 +412,8 @@
            , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
            , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
           ]
-        , [  Infix (try $ string "shl" >> return (BinOp "and")) AssocNone
-           , Infix (try $ string "shr" >> return (BinOp "or")) AssocNone
+        , [  Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
+           , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
           ]
         , [Prefix (try (string "not") >> return (PrefixOp "not"))]
         ]
@@ -459,12 +471,12 @@
 withBlock = do
     try $ string "with"
     comments
-    e <- expression
+    r <- reference
     comments
     string "do"
     comments
     o <- phrase
-    return $ WithBlock e o
+    return $ WithBlock r o
     
 repeatCycle = do
     try $ string "repeat"
@@ -543,3 +555,54 @@
             char ';'
             comments
             return u
+
+initExpression = buildExpressionParser table term <?> "initialization expression"
+    where
+    term = comments >> choice [
+        try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray
+        , parens pas (semiSep pas $ recField) >>= return . InitRecord
+        , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
+        , try $ float pas >>= return . InitFloat . show
+        , stringLiteral pas >>= return . InitString
+        , char '#' >> many digit >>= return . InitChar
+        , char '$' >> many hexDigit >>= return . InitHexNumber
+        , try $ string "nil" >> return InitNull
+        , iD >>= return . InitReference
+        ]
+        
+    recField = do
+        i <- iD
+        spaces
+        char ':'
+        spaces
+        e <- initExpression
+        spaces
+        return (i ,e)
+
+    table = [ 
+          [  Infix (char '*' >> return (InitBinOp "*")) AssocLeft
+           , Infix (char '/' >> return (InitBinOp "/")) AssocLeft
+           , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft
+           , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft
+          ]
+        , [  Infix (char '+' >> return (InitBinOp "+")) AssocLeft
+           , Infix (char '-' >> return (InitBinOp "-")) AssocLeft
+           , Prefix (char '-' >> return (InitPrefixOp "-"))
+          ]
+        , [  Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone
+           , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone
+           , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone
+           , Infix (char '<' >> return (InitBinOp "<")) AssocNone
+           , Infix (char '>' >> return (InitBinOp ">")) AssocNone
+           , Infix (char '=' >> return (InitBinOp "=")) AssocNone
+          ]
+        , [  Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
+           , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
+           , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+          ]
+        , [  Infix (try $ string "shl" >> return (InitBinOp "and")) AssocNone
+           , Infix (try $ string "shr" >> return (InitBinOp "or")) AssocNone
+          ]
+        , [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
+        ]
+    
\ No newline at end of file
diff -r d8f62c805619 -r 734fed7aefd3 tools/pas2c.hs
--- a/tools/pas2c.hs	Sun Nov 13 18:23:05 2011 +0100
+++ b/tools/pas2c.hs	Sun Nov 13 13:46:26 2011 +0300
@@ -4,8 +4,16 @@
 import Text.PrettyPrint.HughesPJ
 import Data.Maybe
 import Data.Char
+import Text.Parsec.String
 
 
+pas2C :: String -> IO String
+pas2C fileName = do
+    ptree <- parseFromFile pascalUnit fileName
+    case ptree of
+         (Left a) -> return (show a)
+         (Right a) -> (return . render . pascal2C) a
+
 pascal2C :: PascalUnit -> Doc
 pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation
 
@@ -21,17 +29,38 @@
 tvar2C :: TypeVarDeclaration -> Doc
 tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) = 
     type2C returnType <+> text (name ++ "();")
-
-    
 tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) = 
     type2C returnType <+> text (name ++ "()") 
     $$
     phrase2C phrase
-tvar2C _ = empty
+tvar2C (TypeDeclaration (Identifier i) t) = text "type" <+> text i <+> type2C t <> text ";"
+tvar2C (VarDeclaration isConst (ids, t) mInitExpr) = 
+    if isConst then text "const" else empty
+    <+>
+    type2C t
+    <+>
+    (hsep . punctuate (char ',') . map (\(Identifier i) -> text i) $ ids)
+    <+>
+    initExpr mInitExpr
+    <>
+    text ";"
+    where
+    initExpr Nothing = empty
+    initExpr (Just e) = text "=" <+> initExpr2C e
+
+initExpr2C :: InitExpression -> Doc    
+initExpr2C _ = text "<<expression>>"
 
 type2C :: TypeDecl -> Doc
 type2C UnknownType = text "void"
-type2C _ = text "<<type>>"
+type2C String = text "string"
+type2C (SimpleType (Identifier i)) = text i
+type2C (PointerTo t) = type2C t <> text "*"
+type2C (RecordType tvs) = text "{" $+$ (nest 4 . vcat . map tvar2C $ tvs) $+$ text "}"
+type2C (RangeType r) = text "<<range type>>"
+type2C (Sequence ids) = text "<<sequence type>>"
+type2C (ArrayDecl r t) = text "<<array type>>"
+
 
 phrase2C :: Phrase -> Doc
 phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"
@@ -46,15 +75,18 @@
     where
     case2C :: (Expression, Phrase) -> Doc
     case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
-{-
-        | RepeatCycle Expression Phrase
-        | ForCycle
-        -}
-phrase2C _ = empty
+phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p)
+phrase2C (ForCycle (Identifier i) e1 e2 p) = 
+    text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i])
+    $$
+    phrase2C (wrapPhrase p)
+phrase2C (RepeatCycle e p) = text "do" <+> phrase2C (Phrases p) <+> text "while" <> parens (text "!" <> parens (expr2C e))
+
 
 wrapPhrase p@(Phrases _) = p
 wrapPhrase p = Phrases [p]
 
+
 expr2C :: Expression -> Doc
 expr2C (Expression s) = text s
 expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)
@@ -79,6 +111,7 @@
 ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
 ref2C (Address ref) = text "&" <> ref2C ref
 
+
 op2C "or" = text "|"
 op2C "and" = text "&"
 op2C "not" = text "!"