Improve rendering of function types, ranges, and more
authorunc0rr
Sun, 15 Apr 2012 00:47:22 +0400
changeset 6891 ab9843957664
parent 6890 6fc12f30c55c
child 6892 c02710a8bac4
Improve rendering of function types, ranges, and more
hedgewars/GL.h
hedgewars/SDLh.pas
hedgewars/pas2c.h
hedgewars/pas2cSystem.pas
hedgewars/uConsts.pas
hedgewars/uVariables.pas
tools/PascalParser.hs
tools/PascalPreprocessor.hs
tools/pas2c.hs
--- a/hedgewars/GL.h	Sat Apr 14 23:50:14 2012 +0400
+++ b/hedgewars/GL.h	Sun Apr 15 00:47:22 2012 +0400
@@ -1,2 +1,3 @@
 #pragma once
 
+#include <GL/gl.h>
--- a/hedgewars/SDLh.pas	Sat Apr 14 23:50:14 2012 +0400
+++ b/hedgewars/SDLh.pas	Sun Apr 15 00:47:22 2012 +0400
@@ -422,10 +422,10 @@
         end;
 
     TSDL_RWops = record
-        seek: ^TSeek;
-        read: ^TRead;
-        write: ^TWrite;
-        close: ^TClose;
+        seek: TSeek;
+        read: TRead;
+        write: TWrite;
+        close: TClose;
         type_: LongWord;
         case Byte of
             0: (stdio: TStdio);
--- a/hedgewars/pas2c.h	Sat Apr 14 23:50:14 2012 +0400
+++ b/hedgewars/pas2c.h	Sun Apr 15 00:47:22 2012 +0400
@@ -14,6 +14,10 @@
     {
         char s[32];
     } string31;
+typedef struct string15_
+    {
+        char s[16];
+    } string15;
 
 typedef int SmallInt;
 typedef int Word;
--- a/hedgewars/pas2cSystem.pas	Sat Apr 14 23:50:14 2012 +0400
+++ b/hedgewars/pas2cSystem.pas	Sun Apr 15 00:47:22 2012 +0400
@@ -11,8 +11,8 @@
     SmallInt = integer;
     ShortInt = integer;
     QWord = integer;
-    GLInt = integer;
-    GLUInt = integer;
+    GLint = integer;
+    GLuint = integer;
     gl_unsigned_byte = integer;
     Int = integer;
 
@@ -23,7 +23,7 @@
     double = float;
     real = float;
     extended = float;
-    GLFloat = float;
+    GLfloat = float;
     gl_float = float;
 
     boolean = boolean;
--- a/hedgewars/uConsts.pas	Sat Apr 14 23:50:14 2012 +0400
+++ b/hedgewars/uConsts.pas	Sun Apr 15 00:47:22 2012 +0400
@@ -103,11 +103,13 @@
     MAXNAMELEN = 192;
     MAXROPEPOINTS = 3840;
 
+    {$IFNDEF PAS2C}
     // some opengl headers do not have these macros
     GL_BGR              = $80E0;
     GL_BGRA             = $80E1;
     GL_CLAMP_TO_EDGE    = $812F;
     GL_TEXTURE_PRIORITY = $8066;
+    {$ENDIF}
 
     cSendCursorPosTime  : LongWord = 50;
     cVisibleWater       : LongInt = 128;
--- a/hedgewars/uVariables.pas	Sat Apr 14 23:50:14 2012 +0400
+++ b/hedgewars/uVariables.pas	Sun Apr 15 00:47:22 2012 +0400
@@ -113,7 +113,7 @@
     // originally from uConsts
     Pathz: array[TPathType] of shortstring;
     UserPathz: array[TPathType] of shortstring;
-    CountTexz: array[1..Pred(AMMO_INFINITE)] of PTexture;
+    CountTexz: array[0..Pred(AMMO_INFINITE)] of PTexture;
     LAND_WIDTH       : Word;
     LAND_HEIGHT      : Word;
     LAND_WIDTH_MASK  : LongWord;
@@ -280,7 +280,7 @@
             );
 
     SpritesData: array[TSprite] of record
-            FileName: string[16];
+            FileName: string[15];
             Path, AltPath: TPathType;
             Texture: PTexture;
             Surface: PSDL_Surface;
@@ -620,7 +620,7 @@
                 imageWidth: 0; imageHeight: 0; saveSurf: false; priority:
                 tpMedium; getDimensions: false; getImageDimensions: true),
             //sprHandResurrector
-            (FileName: 'Cross'; Path: ptGraphics; altPath: ptNone;
+            (FileName: 'Cross'; Path: ptGraphics; AltPath: ptNone;
                 Texture: nil; Surface: nil; Width: 108; Height: 138;
                 imageWidth: 0; imageHeight: 0; saveSurf: false; priority:
                 tpMedium; getDimensions: false; getImageDimensions: true),
@@ -667,7 +667,7 @@
             Sprite: TSprite;
             FramesCount: Longword;
             Interval: Longword;
-            cmd: string[20];
+            cmd: string[31];
             Voice: TSound;
             VoiceDelay: LongWord;
             end = (
@@ -681,7 +681,7 @@
             );
 
     Soundz: array[TSound] of record
-            FileName: string[25];
+            FileName: string[31];
             Path    : TPathType;
             end = (
             (FileName:                         ''; Path: ptNone  ),// sndNone
--- a/tools/PascalParser.hs	Sat Apr 14 23:50:14 2012 +0400
+++ b/tools/PascalParser.hs	Sun Apr 15 00:47:22 2012 +0400
@@ -14,7 +14,7 @@
 import PascalBasics
 import PascalUnitSyntaxTree
     
-knownTypes = ["shortstring", "char", "byte"]
+knownTypes = ["shortstring", "ansistring", "char", "byte"]
 
 pascalUnit = do
     comments
@@ -119,6 +119,7 @@
     char '^' >> typeDecl >>= return . PointerTo
     , try (string "shortstring") >> return (String 255)
     , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
+    , try (string "ansistring") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
     , arrayDecl
     , recordDecl
     , setDecl
--- a/tools/PascalPreprocessor.hs	Sat Apr 14 23:50:14 2012 +0400
+++ b/tools/PascalPreprocessor.hs	Sun Apr 15 00:47:22 2012 +0400
@@ -15,7 +15,7 @@
         , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
         ]
 
-initDefines = Map.fromList [("FPC", "")]
+initDefines = Map.fromList [("FPC", ""), ("PAS2C", "")]
         
 preprocess :: String -> IO String
 preprocess fn = do
--- a/tools/pas2c.hs	Sat Apr 14 23:50:14 2012 +0400
+++ b/tools/pas2c.hs	Sun Apr 15 00:47:22 2012 +0400
@@ -310,7 +310,9 @@
     fun2C b name f
 tvar2C _ td@(TypeDeclaration i' t) = do
     i <- id2CTyped t i'
-    tp <- type2C t
+    tp <- case t of
+        FunctionType {} -> type2C (PointerTo t)
+        _ -> type2C t
     return [text "typedef" <+> tp i]
     
 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
@@ -370,16 +372,25 @@
     return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace
 initExpr2C (InitArray [value]) = initExpr2C value
 initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
-initExpr2C (InitRange (Range i)) = id2C IOLookup i
-initExpr2C (InitRange (RangeFromTo (InitNumber "0") (InitNumber a))) = return . text $ show (read a + 1)
-initExpr2C (InitRange a) = return $ text "<<range>>"
+initExpr2C r@(InitRange (Range i@(Identifier i' _))) = do
+    id2C IOLookup i
+    t <- gets lastType
+    case t of
+         BTEnum s -> return . int $ length s
+         BTInt -> case i' of
+                       "byte" -> return $ int 256
+                       _ -> error $ "InitRange identifier: " ++ i'
+         _ -> error $ "InitRange: " ++ show r
+initExpr2C (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r]
+initExpr2C (InitRange a) = error $ show a --return $ text "<<range>>"
 initExpr2C (InitSet []) = return $ text "0"
 initExpr2C (InitSet a) = return $ text "<<set>>"
 initExpr2C (BuiltInFunction "low" [InitReference e]) = return $ 
     case e of
          (Identifier "LongInt" _) -> int (-2^31)
          _ -> error $ show e
-initExpr2C (BuiltInFunction "succ" [InitReference e]) = liftM (<> text " + 1") $ id2C IOLookup e
+initExpr2C (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C e
+initExpr2C (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C e
 initExpr2C b@(BuiltInFunction _ _) = error $ show b    
 initExpr2C a = error $ "initExpr2C: don't know how to render " ++ show a
 
@@ -402,7 +413,7 @@
     type2C' VoidType = return (text "void" <+>)
     type2C' (String l) = return (text ("string" ++ show l) <+>)
     type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i
-    type2C' (PointerTo t) = liftM (\t a -> t (text "*" <> a)) $ type2C t
+    type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
     type2C' (RecordType tvs union) = do
         t <- withState' id $ mapM (tvar2C False) tvs
         u <- unions