# HG changeset patch
# User unc0rr
# Date 1391773467 -14400
# Node ID b7f632c127849313b56f8e9ce337e5eabf0f372b
# Parent  7e05a397602fa0d83f2cc95fe4cc99945b1ac73f
Pas2C recognizes ansistrings

diff -r 7e05a397602f -r b7f632c12784 hedgewars/pas2cRedo.pas
--- a/hedgewars/pas2cRedo.pas	Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/pas2cRedo.pas	Fri Feb 07 15:44:27 2014 +0400
@@ -75,8 +75,9 @@
     pos : function : integer;
     StrToInt : function : integer;
     SetLength, val, StrDispose, StrCopy : procedure;
-    _pchar, StrAlloc : function : PChar;
-    pchar2str : function : string;
+    _pchar, _pcharA, StrAlloc : function : PChar;
+    pchar2str, astr2str : function : string;
+    pchar2astr, str2astr : function : ansistring;
     memcpy : procedure;
     StrLength : function : integer;
 
diff -r 7e05a397602f -r b7f632c12784 hedgewars/pas2cSystem.pas
--- a/hedgewars/pas2cSystem.pas	Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/pas2cSystem.pas	Fri Feb 07 15:44:27 2014 +0400
@@ -116,6 +116,7 @@
 
     _strconcat, _strappend, _strprepend, _chrconcat : function : string;
     _strcompare, _strncompare, _strcomparec : function : boolean;
+    _strconcatA, _strappendA : function : ansistring;
 
     png_structp, png_set_write_fn, png_get_io_ptr,
     png_get_libpng_ver, png_create_write_struct,
diff -r 7e05a397602f -r b7f632c12784 hedgewars/uStore.pas
--- a/hedgewars/uStore.pas	Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/uStore.pas	Fri Feb 07 15:44:27 2014 +0400
@@ -1272,13 +1272,13 @@
 
 // get description's dimensions
 tmpdesc:= description;
-while tmpdesc <> '' do
+while length(tmpdesc) > 0 do
     begin
     tmpline:= tmpdesc;
     SplitByChar(tmpline, tmpdesc, '|');
-    if tmpline <> '' then
+    if length(tmpline) > 0 then
         begin
-        TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(tmpline), @i, @j);
+        TTF_SizeUTF8(Fontz[font].Handle, PChar(tmpline), @i, @j);
         if w < (i + wa) then
             w:= i + wa;
         inc(h, j + ha)
@@ -1315,20 +1315,20 @@
 
 // render all description lines
 tmpdesc:= description;
-while tmpdesc <> '' do
+while length(tmpdesc) > 0 do
     begin
     tmpline:= tmpdesc;
     SplitByChar(tmpline, tmpdesc, '|');
     r2:= r;
-    if tmpline <> '' then
+    if length(tmpline) > 0 then
         begin
-        r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, Str2PChar(tmpline));
+        r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, PChar(tmpline));
 
         // render highlighted caption (if there is a ':')
         tmpline2:= _S'';
         SplitByChar(tmpline, tmpline2, ':');
-        if tmpline2 <> _S'' then
-            WriteInRect(tmpsurf, cFontBorder + 2, r2.y + r2.h, $ffc7c7c7, font, Str2PChar(tmpline + ':'));
+        if length(tmpline2) > 0 then
+            WriteInRect(tmpsurf, cFontBorder + 2, r2.y + r2.h, $ffc7c7c7, font, PChar(tmpline + ':'));
         end
     end;
 
diff -r 7e05a397602f -r b7f632c12784 hedgewars/uWorld.pas
--- a/hedgewars/uWorld.pas	Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/uWorld.pas	Fri Feb 07 15:44:27 2014 +0400
@@ -219,7 +219,7 @@
     end;
 
 // if the string has been set, show it for (default timeframe) seconds
-if g <> '' then
+if length(g) > 0 then
     ShowMission(trgoal[gidCaption], trgoal[gidSubCaption], PChar(g), 1, 0);
 
 cWaveWidth:= SpritesData[sprWater].Width;
diff -r 7e05a397602f -r b7f632c12784 tools/pas2c/Pas2C.hs
--- a/tools/pas2c/Pas2C.hs	Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/Pas2C.hs	Fri Feb 07 15:44:27 2014 +0400
@@ -400,6 +400,7 @@
     f "float" = BTFloat
     f "char" = BTChar
     f "string" = BTString
+    f "ansistring" = BTAString
     f _ = error $ "Unknown system type: " ++ show st
 resolveType (PointerTo (SimpleType (Identifier i _))) = return . BTPointerTo $ BTUnresolved (map toLower i)
 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
@@ -427,6 +428,7 @@
 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
 resolveType (DeriveType _) = return BTUnknown
 resolveType String = return BTString
+resolveType AString = return BTAString
 resolveType VoidType = return BTVoid
 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
 resolveType (RangeType _) = return $ BTVoid
@@ -710,6 +712,7 @@
 baseType2C _ BTFloat = text "float"
 baseType2C _ BTBool = text "bool"
 baseType2C _ BTString = text "string255"
+baseType2C _ BTAString = text "astring"
 baseType2C s a = error $ "baseType2C: " ++ show a ++ "\n" ++ s
 
 type2C :: TypeDecl -> State RenderState (Doc -> Doc)
@@ -722,6 +725,7 @@
     where
     type2C' VoidType = return (text "void" <+>)
     type2C' String = return (text "string255" <+>)--return (text ("string" ++ show l) <+>)
+    type2C' AString = return (text "astring" <+>)
     type2C' (PointerTo (SimpleType i)) = do
         i' <- id2C IODeferred i
         lt <- gets lastType
@@ -812,10 +816,28 @@
                 BTPointerTo _ -> do
                     e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
                     return $ r <+> text "=" <+> e <> semi
+                BTAString -> do
+                    e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "astr2str" BTUnknown))
+                    return $ r <+> text "=" <+> e <> semi
                 BTString -> do
                     e <- expr2C expr
                     return $ r <+> text "=" <+> e <> semi
-                _ -> error $ "Assignment to string from " ++ show asgn
+                _ -> error $ "Assignment to string from " ++ show lt ++ "\n" ++ show asgn
+        (BTAString, _) -> do
+            void $ expr2C expr
+            lt <- gets lastType
+            case lt of
+                -- assume pointer to char for simplicity
+                BTPointerTo _ -> do
+                    e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2astr" BTUnknown))
+                    return $ r <+> text "=" <+> e <> semi
+                BTString -> do
+                    e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "str2astr" BTUnknown))
+                    return $ r <+> text "=" <+> e <> semi
+                BTAString -> do
+                    e <- expr2C expr
+                    return $ r <+> text "=" <+> e <> semi
+                _ -> error $ "Assignment to ansistring from " ++ show lt ++ "\n" ++ show asgn
         (BTArray _ _ _, _) -> do
             case expr of
                 Reference er -> do
@@ -913,12 +935,16 @@
 
 expr2C :: Expression -> State RenderState Doc
 expr2C (Expression s) = return $ text s
-expr2C (BinOp op expr1 expr2) = do
+expr2C bop@(BinOp op expr1 expr2) = do
     e1 <- expr2C expr1
     t1 <- gets lastType
     e2 <- expr2C expr2
     t2 <- gets lastType
     case (op2C op, t1, t2) of
+        ("+", BTAString, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcatA" (BTFunction False [(False, t1), (False, t2)] BTString))
+        ("+", BTAString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappendA" (BTFunction False [(False, t1), (False, t2)] BTAString))
+        (_, BTAString, _) -> error $ "unhandled bin op with ansistring on the left side: " ++ show bop
+        (_, _, BTAString) -> error $ "unhandled bin op with ansistring on the right side: " ++ show bop
         ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False [(False, t1), (False, t2)] BTString))
         ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False [(False, t1), (False, t2)] BTString))
         ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False [(False, t1), (False, t2)] BTString))
@@ -1041,9 +1067,21 @@
     modify (\s -> s{lastType = BTInt True})
     case lt of
          BTString -> return $ text "fpcrtl_Length" <> parens e'
+         BTAString -> return $ text "fpcrtl_LengthA" <> parens e'
          BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e'
          BTArray (RangeFromTo _ n) _ _ -> initExpr2C (BuiltInFunction "succ" [n])
          _ -> error $ "length() called on " ++ show lt
+expr2C (BuiltInFunCall [e, e1, e2] (SimpleReference (Identifier "copy" _))) = do
+    e1' <- expr2C e1
+    e2' <- expr2C e2
+    e' <- expr2C e
+    lt <- gets lastType
+    let f name = return $ text name <> parens (hsep $ punctuate (char ',') [e', e1', e2'])
+    case lt of
+         BTString -> f "fpcrtl_copy"
+         BTAString -> f "fpcrtl_copyA"
+         _ -> error $ "copy() called on " ++ show lt
+     
 expr2C (BuiltInFunCall params ref) = do
     r <- ref2C ref
     t <- gets lastType
@@ -1091,7 +1129,8 @@
          (BTArray _ _ t') -> modify (\st -> st{lastType = t'})
 --         (BTFunctionReturn _ (BTArray _ _ t')) -> modify (\st -> st{lastType = t'})
 --         (BTFunctionReturn _ (BTString)) -> modify (\st -> st{lastType = BTChar})
-         (BTString) -> modify (\st -> st{lastType = BTChar})
+         BTString -> modify (\st -> st{lastType = BTChar})
+         BTAString -> modify (\st -> st{lastType = BTChar})
          (BTPointerTo t) -> do
                 t'' <- fromPointer (show t) =<< gets lastType
                 case t'' of
@@ -1159,6 +1198,7 @@
     lt <- expr2C expr >> gets lastType
     case (map toLower i, lt) of
         ("pchar", BTString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
+        ("pchar", BTAString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pcharA" $ BTPointerTo BTChar))
         ("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString))
         (a, _) -> do
             e <- expr2C expr
diff -r 7e05a397602f -r b7f632c12784 tools/pas2c/PascalBasics.hs
--- a/tools/pas2c/PascalBasics.hs	Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalBasics.hs	Fri Feb 07 15:44:27 2014 +0400
@@ -17,7 +17,7 @@
 string' = void . string
 
 builtin :: [String]
-builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
+builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length", "copy"]
 
 pascalLanguageDef :: GenLanguageDef String u Identity
 pascalLanguageDef
diff -r 7e05a397602f -r b7f632c12784 tools/pas2c/PascalParser.hs
--- a/tools/pas2c/PascalParser.hs	Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalParser.hs	Fri Feb 07 15:44:27 2014 +0400
@@ -138,7 +138,7 @@
     char' '^' >> typeDecl >>= return . PointerTo
     , try (string' "shortstring") >> return String
     , try (string' "string") >> optionMaybe (brackets pas $ integer pas) >> return String
-    , try (string' "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return String
+    , try (string' "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return AString
     , arrayDecl
     , recordDecl
     , setDecl
diff -r 7e05a397602f -r b7f632c12784 tools/pas2c/PascalPreprocessor.hs
--- a/tools/pas2c/PascalPreprocessor.hs	Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalPreprocessor.hs	Fri Feb 07 15:44:27 2014 +0400
@@ -81,7 +81,9 @@
         char' '}'
         f <- liftIO (readFile (inputPath ++ ifn) 
             `E.catch` (\(_ :: E.IOException) -> readFile (alternateInputPath ++ ifn) 
-            `E.catch` (\(_ :: E.IOException) -> error ("File not found: " ++ fn))))
+                `E.catch` (\(_ :: E.IOException) -> error $ "File not found: " ++ ifn)
+                )
+            )
         c <- getInput
         setInput $ f ++ c
         return ""
diff -r 7e05a397602f -r b7f632c12784 tools/pas2c/PascalUnitSyntaxTree.hs
--- a/tools/pas2c/PascalUnitSyntaxTree.hs	Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalUnitSyntaxTree.hs	Fri Feb 07 15:44:27 2014 +0400
@@ -26,6 +26,7 @@
     | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
     | PointerTo TypeDecl
     | String
+    | AString
     | Set TypeDecl
     | FunctionType TypeDecl [TypeVarDeclaration]
     | DeriveType InitExpression
@@ -100,6 +101,7 @@
 data BaseType = BTUnknown
     | BTChar
     | BTString
+    | BTAString
     | BTInt Bool -- second param indicates whether signed or not
     | BTBool
     | BTFloat