Merge branch 'tessallation' of pwning.de:/pioneers into tessallation

Pioneers.cabal

@@ -16,14 +16,15 @@ executable Pioneers
                    Map.Graphics,
                    Map.Creation,
                    Map.StaticMaps,
-                   IQM.Types,
-                   IQM.TestMain,
-                   IQM.Parser,
+                   Importer.IQM.Types,
+                   Importer.IQM.TestMain,
+                   Importer.IQM.Parser,
                    Render.Misc,
                    Render.Render,
                    Render.RenderObject,
+                   Render.Types,
                    UI.Callbacks,
-                   Types,
+                   UI.Types,
                    UI.SurfaceOverlay
                    Types
   main-is:         Main.hs
@@ -45,7 +46,7 @@ executable Pioneers
                    SDL2 >= 0.1.0,
                    time >=1.4.0,
                    GLUtil >= 0.7,
-                   attoparsec >= 0.11.2
-  other-modules:   Render.Types
+                   attoparsec >= 0.11.2,
+                   attoparsec-binary >= 0.1
   Default-Language: Haskell2010
 

shaders/map/tessEval.shader

@@ -2,6 +2,101 @@
 
 #extension GL_ARB_tessellation_shader : require
 
+//#include "shaders/3rdParty/noise.glsl"
+
+vec3 mod289(vec3 x) {
+  return x - floor(x * (1.0 / 289.0)) * 289.0;
+}
+
+vec4 mod289(vec4 x) {
+  return x - floor(x * (1.0 / 289.0)) * 289.0;
+}
+
+vec4 permute(vec4 x) {
+     return mod289(((x*34.0)+1.0)*x);
+}
+
+vec4 taylorInvSqrt(vec4 r)
+{
+  return 1.79284291400159 - 0.85373472095314 * r;
+}
+
+float snoise(vec3 v)
+  {
+  const vec2  C = vec2(1.0/6.0, 1.0/3.0) ;
+  const vec4  D = vec4(0.0, 0.5, 1.0, 2.0);
+
+// First corner
+  vec3 i  = floor(v + dot(v, C.yyy) );
+  vec3 x0 =   v - i + dot(i, C.xxx) ;
+
+// Other corners
+  vec3 g = step(x0.yzx, x0.xyz);
+  vec3 l = 1.0 - g;
+  vec3 i1 = min( g.xyz, l.zxy );
+  vec3 i2 = max( g.xyz, l.zxy );
+
+  //   x0 = x0 - 0.0 + 0.0 * C.xxx;
+  //   x1 = x0 - i1  + 1.0 * C.xxx;
+  //   x2 = x0 - i2  + 2.0 * C.xxx;
+  //   x3 = x0 - 1.0 + 3.0 * C.xxx;
+  vec3 x1 = x0 - i1 + C.xxx;
+  vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
+  vec3 x3 = x0 - D.yyy;      // -1.0+3.0*C.x = -0.5 = -D.y
+
+// Permutations
+  i = mod289(i);
+  vec4 p = permute( permute( permute(
+             i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
+           + i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
+           + i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
+
+// Gradients: 7x7 points over a square, mapped onto an octahedron.
+// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
+  float n_ = 0.142857142857; // 1.0/7.0
+  vec3  ns = n_ * D.wyz - D.xzx;
+
+  vec4 j = p - 49.0 * floor(p * ns.z * ns.z);  //  mod(p,7*7)
+
+  vec4 x_ = floor(j * ns.z);
+  vec4 y_ = floor(j - 7.0 * x_ );    // mod(j,N)
+
+  vec4 x = x_ *ns.x + ns.yyyy;
+  vec4 y = y_ *ns.x + ns.yyyy;
+  vec4 h = 1.0 - abs(x) - abs(y);
+
+  vec4 b0 = vec4( x.xy, y.xy );
+  vec4 b1 = vec4( x.zw, y.zw );
+
+  //vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
+  //vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
+  vec4 s0 = floor(b0)*2.0 + 1.0;
+  vec4 s1 = floor(b1)*2.0 + 1.0;
+  vec4 sh = -step(h, vec4(0.0));
+
+  vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
+  vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
+
+  vec3 p0 = vec3(a0.xy,h.x);
+  vec3 p1 = vec3(a0.zw,h.y);
+  vec3 p2 = vec3(a1.xy,h.z);
+  vec3 p3 = vec3(a1.zw,h.w);
+
+//Normalise gradients
+  vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
+  p0 *= norm.x;
+  p1 *= norm.y;
+  p2 *= norm.z;
+  p3 *= norm.w;
+
+// Mix final noise value
+  vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
+  m = m * m;
+  return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
+                                dot(p2,x2), dot(p3,x3) ) );
+  }
+
+
 layout(triangles, equal_spacing, cw) in;
 in vec3 tcPosition[];
 in vec4 tcColor[];
@@ -38,6 +133,7 @@ void main()
     float i2 = (1-gl_TessCoord.z)*gl_TessCoord.z * length(cross(tcNormal[2],tessNormal));
     float standout = i0+i1+i2;
     tePosition = tePosition+tessNormal*standout;
+    tePosition = tePosition+0.05*snoise(tePosition);
     gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1);
     fogDist = gl_Position.z;
 

src/Importer/IQM/Parser.hs

@@ -8,84 +8,98 @@ module Importer.IQM.Parser (parseIQM) where
 import Importer.IQM.Types
 import Data.Attoparsec.ByteString.Char8
 import Data.Attoparsec.ByteString
+import Data.Attoparsec.Binary
 import Data.ByteString.Char8 (pack)
-import Data.ByteString (split, null)
+import Data.ByteString (split, null, ByteString)
+import Data.ByteString.Unsafe (unsafeUseAsCString)
+import qualified Data.ByteString as B
 import Data.Word
 import Data.Int
 import Unsafe.Coerce
 import Control.Monad.Trans.State
 import Control.Monad.Trans.Class
 import Control.Monad
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
 
 import Prelude as P hiding (take, null)
 
 -- | helper-function for creating an integral out of [8-Bit Ints]
-w8ToInt :: Integral a => a -> a -> a
-w8ToInt i add = 256*i + add
+_w8ToInt :: Integral a => a -> a -> a
+_w8ToInt i add = 256*i + add
 
 -- | shorthand-function for parsing Word8 into Integrals
-parseNum :: (Integral a, Integral b) => [a] -> b
-parseNum = (foldl1 w8ToInt) . map fromIntegral
+_parseNum :: (Integral a, Integral b) => [a] -> b
+_parseNum = foldl1 _w8ToInt . map fromIntegral
 
 -- | read a 16-Bit Int from Parsing-Input and log 2 bytes in our Parsing-Monad
 --
 --   begins with _ to defeat ghc-warnings. Rename if used!
-_int16 :: CParser Int16
+_int16 :: CParser Word16
 _int16 = do
         ret <- lift $ do
                          a <- anyWord8 :: Parser Word8
                          b <- anyWord8 :: Parser Word8
-                         return $ parseNum [b,a]
+                         return $ _parseNum [b,a]
         modify (+2)
         return ret
 
 -- | read a 32-Bit Int from Parsing-Input and log 4 bytes in our Parsing-Monad
-int32 :: CParser Int32
-int32 = do
+_int32 :: CParser Int32
+_int32 = do
         ret <- lift $ do
                          a <- anyWord8 :: Parser Word8
                          b <- anyWord8 :: Parser Word8
                          c <- anyWord8 :: Parser Word8
                          d <- anyWord8 :: Parser Word8
-                         return $ parseNum [d,c,b,a]
+                         return $ _parseNum [d,c,b,a]
         modify (+4)
-        return $ ret
+        return ret
+
+w32leCParser :: CParser Word32
+w32leCParser = do
+	ret <- lift anyWord32le
+	modify (+4)
+	return ret
 
 -- | Parser for the header
 readHeader :: CParser IQMHeader
 readHeader = do
          _ <- lift $ string (pack "INTERQUAKEMODEL\0")
-         v <- int32
-         -- when v /= 2 then --TODO: error something
-         size' <- int32
-         flags' <- int32
-         num_text' <- int32
-         ofs_text' <- int32
-         num_meshes' <- int32
-         ofs_meshes' <- int32
-         num_vertexarrays' <- int32
-         num_vertexes' <- int32
-         ofs_vertexarrays' <- int32
-         num_triangles' <- int32
-         ofs_triangles' <- int32
-         ofs_adjacency' <- int32
-         num_joints' <- int32
-         ofs_joints' <- int32
-         num_poses' <- int32
-         ofs_poses' <- int32
-         num_anims' <- int32
-         ofs_anims' <- int32
-         num_frames' <- int32
-         num_framechannels' <- int32
-         ofs_frames' <- int32
-         ofs_bounds' <- int32
-         num_comment' <- int32
-         ofs_comment' <- int32
-         num_extensions' <- int32
-         ofs_extensions' <- int32
+         modify (+16)
+         v <- w32leCParser
+	 lift $ when (v /= 2) $ fail "Version /= 2.\nThis Parser only supports Version 2 of the InterQuake-Model IQM"
+         -- when v /= 2 then fail parsing.
+         size' <- w32leCParser
+         flags' <- w32leCParser
+         num_text' <- w32leCParser
+         ofs_text' <- w32leCParser
+         num_meshes' <- w32leCParser
+         ofs_meshes' <- w32leCParser
+         num_vertexarrays' <- w32leCParser
+         num_vertexes' <- w32leCParser
+         ofs_vertexarrays' <- w32leCParser
+         num_triangles' <- w32leCParser
+         ofs_triangles' <- w32leCParser
+         ofs_adjacency' <- w32leCParser
+         num_joints' <- w32leCParser
+         ofs_joints' <- w32leCParser
+         num_poses' <- w32leCParser
+         ofs_poses' <- w32leCParser
+         num_anims' <- w32leCParser
+         ofs_anims' <- w32leCParser
+         num_frames' <- w32leCParser
+         num_framechannels' <- w32leCParser
+         ofs_frames' <- w32leCParser
+         ofs_bounds' <- w32leCParser
+         num_comment' <- w32leCParser
+         ofs_comment' <- w32leCParser
+         num_extensions' <- w32leCParser
+         ofs_extensions' <- w32leCParser
          return IQMHeader { version = v
                 , filesize           = size'
-                , flags              = flags'
+                , flags              = fromIntegral flags'
                 , num_text           = num_text'
                 , ofs_text           = ofs_text'
                 , num_meshes         = num_meshes'
@@ -115,12 +129,12 @@ readHeader = do
 -- | Parser for Mesh-Structure
 readMesh :: CParser IQMMesh
 readMesh = do
-        name <- int32
-        mat <- int32
-        fv <- int32
-        nv <- int32
-        ft <- int32
-        nt <- int32
+        name <- w32leCParser
+        mat <- w32leCParser
+        fv <- w32leCParser
+        nv <- w32leCParser
+        ft <- w32leCParser
+        nt <- w32leCParser
         return IQMMesh
                 { meshName              = if name == 0 then Nothing else Just (Mesh name)
                 , meshMaterial          = mat
@@ -140,12 +154,32 @@ readMeshes n = do
         ms <- readMeshes (n-1)
         return $ m:ms
 
+-- | Parser for Mesh-Structure
+readVAF :: CParser IQMVertexArray
+readVAF = do
+        vat <- rawEnumToVAT =<< w32leCParser
+        flags' <- w32leCParser
+        format <- rawEnumToVAF =<< w32leCParser
+        size <- w32leCParser
+        offset <- w32leCParser
+        return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset nullPtr
+
+-- | helper to read n consecutive Meshes tail-recursive
+readVAFs :: Int -> CParser [IQMVertexArray]
+readVAFs 1 = do
+        f <- readVAF
+        return [f]
+readVAFs n = do
+        f <- readVAF
+        fs <- readVAFs (n-1)
+        return $ f:fs
+
 -- | helper-Notation for subtracting 2 integral values of different kind in the precision
 --   of the target-kind
 (.-) :: forall a a1 a2.
               (Num a, Integral a2, Integral a1) =>
               a1 -> a2 -> a
-(.-) a b = (fromIntegral a) - (fromIntegral b)
+(.-) a b = fromIntegral a - fromIntegral b
 
 infix 5 .-
 
@@ -162,18 +196,53 @@ skipToCounter a = do
                         put d
 
 -- | Parses an IQM-File and handles back the Haskell-Structure
-parseIQM :: CParser IQM
-parseIQM = do
-        put 0                                                   --start at offset 0
+parseIQM :: String -> IO IQM
+parseIQM a =
+	do
+	f <- B.readFile a
+	putStrLn "Before Parse:"
+	putStrLn $ show f
+	putStrLn "Real Parse:"
+	r <- return $ parse doIQMparse f
+	raw <- case r of
+		Done _ x -> return x
+		y -> error $ show y	
+	let ret = raw
+	return ret
+
+readInVAO :: IQMVertexArray -> ByteString -> IO IQMVertexArray
+readInVAO (IQMVertexArray type' a format num offset ptr) d = 
+		do
+		let 
+			byteLen = (fromIntegral num)*(vaSize format)
+			data' = skipDrop (fromIntegral offset) byteLen d
+			
+		when (not (ptr == nullPtr)) $ error $ "Error reading Vertex-Array: Double Read of " ++ show type'
+		p <- mallocBytes byteLen
+		unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
+		p' <- unsafeCoerce p
+		return (IQMVertexArray type' a format num offset p')
+		
+doIQMparse :: Parser IQM
+doIQMparse = 
+	flip evalStateT 0 $ --evaluate parser with state starting at 0
+		do
         	h <- readHeader                                         --read header
 	        skipToCounter $ ofs_text h                              --skip 0-n bytes to get to text
 	        text <- lift . take . fromIntegral $ num_text h         --read texts
 	       	modify . (+) . fromIntegral $ num_text h                --put offset forward
 	        skipToCounter $ ofs_meshes h                            --skip 0-n bytes to get to meshes
-        meshes' <- readMeshes (fromIntegral (num_meshes h))     --read meshes
+	        meshes' <- readMeshes $ fromIntegral $ num_meshes h     --read meshes
+		skipToCounter $ ofs_vertexarrays h			--skip 0-n bytes to get to Vertex-Arrays
+                vaf <- readVAFs $ fromIntegral $ num_vertexarrays h     --read Vertex-Arrays
+
+		_ <- lift takeByteString
 	        return IQM
 	                { header = h
 	                , texts = filter (not.null) (split (unsafeCoerce '\0') text)
 	                , meshes = meshes'
+			, vertexArrays = vaf
 	                }
 
+skipDrop :: Int -> Int -> ByteString -> ByteString
+skipDrop a b= B.drop b . B.take a

src/Importer/IQM/Types.hs

@@ -1,19 +1,31 @@
--- | Int32 or Int64 - depending on implementation. Format just specifies "uint".
---   4-Byte in the documentation indicates Int32 - but not specified!
+{-# LANGUAGE ExistentialQuantification, RankNTypes, CPP, BangPatterns #-}
+-- | Word32 or Word64 - depending on implementation. Format just specifies "uint".
+--   4-Byte in the documentation indicates Word32 - but not specified!
 module Importer.IQM.Types where
 
+import Control.Monad.Trans.State.Lazy (StateT)
 import Data.Int
+import Data.Word
 import Data.ByteString
 import Data.Attoparsec.ByteString.Char8
-import Control.Monad.Trans.State.Lazy (StateT)
+import Foreign.Ptr
+import Graphics.Rendering.OpenGL.Raw.Types
+import Prelude as P
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.Marshal.Array
 
 -- | Mesh-Indices to distinguish the meshes referenced
-newtype Mesh = Mesh Int32 deriving (Show, Eq)
+newtype Mesh = Mesh Word32 deriving (Show, Eq)
 -- | State-Wrapped Parser-Monad which is capable of counting the
 --   Bytes read for offset-gap reasons
 type CParser a = StateT Int64 Parser a
 
-
+type Flags = GLbitfield      -- ^ Alias for UInt32
+type Offset = Word32         -- ^ Alias for UInt32
+type Index = GLuint          -- ^ Alias for UInt32
+type NumComponents = GLsizei -- ^ Alias for UInt32
+type IQMData = Ptr IQMVertexArrayFormat -- ^ Pointer for Data
 
 -- | Header of IQM-Format.
 --
@@ -23,33 +35,33 @@ type CParser a = StateT Int64 Parser a
 --
 --   ofs_* fields are aligned at 4-byte-boundaries
 data IQMHeader = IQMHeader
-                { version            :: Int32 -- ^ Must be 2
-                , filesize           :: Int32
-                , flags              :: Int32
-                , num_text           :: Int32
-                , ofs_text           :: Int32
-                , num_meshes         :: Int32
-                , ofs_meshes         :: Int32
-                , num_vertexarrays   :: Int32
-                , num_vertexes       :: Int32
-                , ofs_vertexarrays   :: Int32
-                , num_triangles      :: Int32
-                , ofs_triangles      :: Int32
-                , ofs_adjacency      :: Int32
-                , num_joints         :: Int32
-                , ofs_joints         :: Int32
-                , num_poses          :: Int32
-                , ofs_poses          :: Int32
-                , num_anims          :: Int32
-                , ofs_anims          :: Int32
-                , num_frames         :: Int32
-                , num_framechannels  :: Int32
-                , ofs_frames         :: Int32
-                , ofs_bounds         :: Int32
-                , num_comment        :: Int32
-                , ofs_comment        :: Int32
-                , num_extensions     :: Int32 -- ^ stored as linked list, not as array.
-                , ofs_extensions     :: Int32
+                { version            :: !Word32 -- ^ Must be 2
+                , filesize           :: !Word32
+                , flags              :: !Flags
+                , num_text           :: !Word32
+                , ofs_text           :: !Offset
+                , num_meshes         :: !Word32
+                , ofs_meshes         :: !Offset
+                , num_vertexarrays   :: !Word32
+                , num_vertexes       :: !Word32
+                , ofs_vertexarrays   :: !Offset
+                , num_triangles      :: !Word32
+                , ofs_triangles      :: !Offset
+                , ofs_adjacency      :: !Offset
+                , num_joints         :: !Word32
+                , ofs_joints         :: !Offset
+                , num_poses          :: !Word32
+                , ofs_poses          :: !Offset
+                , num_anims          :: !Word32
+                , ofs_anims          :: !Offset
+                , num_frames         :: !Word32
+                , num_framechannels  :: !Word32
+                , ofs_frames         :: !Offset
+                , ofs_bounds         :: !Offset
+                , num_comment        :: !Word32
+                , ofs_comment        :: !Offset
+                , num_extensions     :: !Word32 -- ^ stored as linked list, not as array.
+                , ofs_extensions     :: !Offset
                 } deriving (Show, Eq)
 
 -- | Format of an IQM-Mesh Structure.
@@ -57,13 +69,29 @@ data IQMHeader = IQMHeader
 --   Read it like a Header of the Meshes lateron in the Format
 data IQMMesh = IQMMesh
                 { meshName              :: Maybe Mesh
-                , meshMaterial          :: Int32
-                , meshFirstVertex       :: Int32
-                , meshNumVertexes       :: Int32
-                , meshFirstTriangle     :: Int32
-                , meshNumTriangles      :: Int32
+                , meshMaterial          :: Word32
+                , meshFirstVertex       :: Word32
+                , meshNumVertexes       :: Word32
+                , meshFirstTriangle     :: Word32
+                , meshNumTriangles      :: Word32
                 } deriving (Show, Eq)
 
+-- | Format of IQM-Triangle Structure
+data IQMTriangle = IQMTriangle VertexIndex VertexIndex VertexIndex
+
+-- | Type-Alias for Word32 indicating an index on vertices in IQMMesh
+type VertexIndex = Word32
+
+-- | Type-Alias for Word32 indicating an index on IQMTriangle
+type TriangleIndex = Word32
+
+-- | From the IQM-Format-Description:
+--
+--   each value is the index of the adjacent triangle for edge 0, 1, and 2, where ~0 (= -1)
+--   indicates no adjacent triangle indexes are relative to the iqmheader.ofs_triangles array
+--   and span all meshes, where 0 is the first triangle, 1 is the second, 2 is the third, etc.
+data IQMAdjacency = IQMAdjacency TriangleIndex TriangleIndex TriangleIndex
+
 -- | Format of a whole IQM-File
 --
 --   still unfinished!
@@ -71,5 +99,98 @@ data IQM = IQM
         { header                :: IQMHeader
         , texts                 :: [ByteString]
         , meshes                :: [IQMMesh]
+        , vertexArrays          :: [IQMVertexArray]
         } deriving (Show, Eq)
 
+-- | Different Vertex-Array-Types in IQM
+--
+--   Custom Types have to be > 0x10 as of specification
+
+data IQMVertexArrayType = IQMPosition
+                       | IQMTexCoord
+                       | IQMNormal
+                       | IQMTangent
+                       | IQMBlendIndexes
+                       | IQMBlendWeights
+                       | IQMColor
+                       | IQMCustomVAT Word32
+                       deriving (Show, Eq)
+
+-- | Lookup-Function for internal enum to VertexArrayFormat
+
+rawEnumToVAT :: Word32 -> CParser IQMVertexArrayType
+rawEnumToVAT 0 = return IQMPosition
+rawEnumToVAT 1 = return IQMTexCoord
+rawEnumToVAT 2 = return IQMNormal
+rawEnumToVAT 3 = return IQMTangent
+rawEnumToVAT 4 = return IQMBlendIndexes
+rawEnumToVAT 5 = return IQMBlendWeights
+rawEnumToVAT 6 = return IQMColor
+rawEnumToVAT a = return $ IQMCustomVAT a
+
+-- | Vetrex-Array-Format of the data found at offset
+data IQMVertexArrayFormat = IQMbyte
+                            | IQMubyte
+                            | IQMshort
+                            | IQMushort
+                            | IQMint
+                            | IQMuint
+                            | IQMhalf
+                            | IQMfloat
+                            | IQMdouble
+--                            | Unknown Word32
+                       deriving (Show, Eq)
+
+vaSize :: IQMVertexArrayFormat -> Int
+vaSize IQMbyte 		= sizeOf (undefined :: CSChar)
+vaSize IQMubyte 	= sizeOf (undefined :: CUChar)
+vaSize IQMshort 	= sizeOf (undefined :: CShort)
+vaSize IQMushort 	= sizeOf (undefined :: CUShort)
+vaSize IQMint 		= sizeOf (undefined :: CInt)
+vaSize IQMuint 		= sizeOf (undefined :: CUInt)
+vaSize IQMhalf 		= sizeOf (undefined :: Word16) --TODO: Find 16-Bit-Float-Datatype
+vaSize IQMfloat 	= sizeOf (undefined :: CFloat)
+vaSize IQMdouble 	= sizeOf (undefined :: CDouble)
+
+--mallocVArray :: Storable a => IQMVertexArrayFormat -> Int -> IO (Ptr a)
+--mallocVArray IQMbyte n	= mallocArray n :: IO (Ptr CSChar)
+--mallocVArray IQMubyte n	= mallocArray n :: IO (Ptr CUChar)
+
+-- | Lookup-Function for internal enum to VertexArrayFormat
+
+rawEnumToVAF :: Word32 -> CParser IQMVertexArrayFormat
+rawEnumToVAF 0 = return IQMbyte
+rawEnumToVAF 1 = return IQMubyte
+rawEnumToVAF 2 = return IQMshort
+rawEnumToVAF 3 = return IQMushort
+rawEnumToVAF 4 = return IQMint
+rawEnumToVAF 5 = return IQMuint
+rawEnumToVAF 6 = return IQMhalf
+rawEnumToVAF 7 = return IQMfloat
+rawEnumToVAF 8 = return IQMdouble
+--rawEnumToVAF a = return $ Unknown a
+rawEnumToVAF a = fail $ P.concat ["unrecognized enum(",show a,") in VertexArrayFormat"]
+
+
+-- | A Vertex-Array-Definiton.
+--
+--   The Vertex starts at Offset and has num_vertexes * NumComponents entries.
+--
+--   All Vertex-Arrays seem to have the same number of components, just differ in Type, Format
+--   and Flags
+data IQMVertexArray = IQMVertexArray
+                        IQMVertexArrayType
+                        Flags
+                        IQMVertexArrayFormat
+                        NumComponents
+                        Offset
+			IQMData
+                       deriving (Eq)
+instance Show IQMVertexArray where
+    show (IQMVertexArray t fl fo nc off _) = "IQMVertexArray (Type: " ++ show t ++
+                                                        ", Flags: " ++ show fl ++
+                                                        ", Format: " ++ show fo ++
+                                                        ", NumComponents: " ++ show nc ++
+                                                        ", Offset: " ++ show off ++
+                                                        ")"
+

src/Main.hs

@@ -16,7 +16,6 @@ import           Control.Concurrent.STM               (TQueue,
                                                        newTQueueIO)
 
 import           Control.Monad.RWS.Strict             (ask, evalRWST, get, liftIO, modify)
-import           Control.Monad.Trans.State            (evalStateT)
 import           Data.Functor                         ((<$>))
 import           Data.Monoid                          (mappend)
 
@@ -46,17 +45,21 @@ import           UI.Callbacks
 import           Map.Graphics
 import           Types
 import           Importer.IQM.Parser
-import           Data.Attoparsec.Char8 (parseTest)
-import qualified Data.ByteString as B
+--import           Data.Attoparsec.Char8 (parseTest)
+--import qualified Data.ByteString as B
 
 -- import qualified Debug.Trace                          as D (trace)
 
 --------------------------------------------------------------------------------
 
-testParser :: IO ()
-testParser = do
-        f <- B.readFile "sample.iqm"
-        parseTest (evalStateT parseIQM 0) f
+testParser :: String -> IO ()
+testParser a = putStrLn . show  =<< parseIQM a
+{-do
+		f <- B.readFile a
+		putStrLn "reading in:"
+		putStrLn $ show f
+		putStrLn "parsed:"
+		parseTest parseIQM f-}
 
 --------------------------------------------------------------------------------
 

src/Map/Combinators.hs

@@ -8,13 +8,13 @@ import System.Random
 
 -- preliminary
 infix 5 ->-
-(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap)
-f ->- g = (g . f)
+(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
+f ->- g = g . f
 
 -- also preliminary
 infix 5 -<-
-(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap)
-f -<- g = (f . g)
+(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
+f -<- g = f . g
 
 lake :: Int -> PlayMap -> PlayMap
 lake = undefined
@@ -40,7 +40,7 @@ gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
     -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map
     liftUp :: (Int, Int) -> Node -> Node
     liftUp (gx,gz) (Full     (x,z) y _ b pl pa r s) = let y_neu = max y e
-                                                      in  (Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s)
+                                                      in  Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s
       where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z)
     liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain []
       where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z)

src/Map/Creation.hs

@@ -31,8 +31,7 @@ aplByNode :: (Node -> Node) -> (Node -> Bool) -> PlayMap -> PlayMap
 aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) else (ab,c))) (assocs mp)) 
 
 aplAll :: [a -> a] -> a -> a
-aplAll []     m = m
-aplAll (f:fs) m = aplAll fs $ f m
+aplAll fs m = foldl (\ m f -> f m) m fs
 
 -- general 3D-Gaussian
 gauss3Dgeneral :: Floating q =>

src/Map/Graphics.hs

@@ -27,6 +27,7 @@ import Foreign.Storable      (sizeOf)
 import Foreign.Ptr           (Ptr, nullPtr, plusPtr)
 import Render.Misc           (checkError)
 import Linear
+import Control.Arrow         ((***))
 
 import Map.Types
 import Map.StaticMaps
@@ -43,7 +44,7 @@ type GraphicsMap = Array (Int, Int) MapEntry
 
 -- converts from classical x/z to striped version of a map
 convertToStripeMap :: PlayMap -> PlayMap
-convertToStripeMap mp = array (stripify l, stripify u) (map (\(i,e) -> (stripify i,strp e)) (assocs mp))
+convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp))
   where
     (l,u) = bounds mp
 
@@ -77,7 +78,7 @@ bufferObjectPtr = plusPtr (nullPtr :: Ptr GLfloat) . fromIntegral
 
 mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat
 mapVertexArrayDescriptor count' offset =
-   VertexArrayDescriptor count' Float mapStride (bufferObjectPtr ((fromIntegral offset)*sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset))
+   VertexArrayDescriptor count' Float mapStride (bufferObjectPtr (fromIntegral offset * sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset))
 
 fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
 fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0)  --color first

src/Map/Map.hs

@@ -34,7 +34,7 @@ giveNeighbourhood :: PlayMap      -- ^ map on which to find neighbourhood
                   -> [(Int, Int)] -- ^ neighbourhood
 giveNeighbourhood _  0 (a,b) = [(a,b)]
 giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in 
-                             remdups . concat $ ns:(map (giveNeighbourhood mp (n-1)) ns)
+                             remdups . concat $ ns : map (giveNeighbourhood mp (n-1)) ns
 
 -- removing duplicates in O(n log n), losing order and adding Ord requirement
 remdups :: Ord a => [a] -> [a]

src/Map/StaticMaps.hs

@@ -7,17 +7,17 @@ import Map.Creation
 
 -- entirely empty map, only uses the minimal constructor
 mapEmpty :: PlayMap
-mapEmpty = array ((0,0), (199,199)) [((a,b), (Minimal (a,b))) | a <- [0..199], b <- [0..199]]
+mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]]
 
 mapCenterMountain :: PlayMap
 mapCenterMountain = array ((0,0),(199,199)) nodes
     where
       nodes    = water ++ beach ++ grass ++ hill ++ mountain
-      water    = [((a,b), (Full (a,b) 0.0       Ocean    BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) > 95]
-      beach    = [((a,b), (Full (a,b) (g2d a b) Beach    BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 95, (m2d (a,b)) > 75]
-      grass    = [((a,b), (Full (a,b) (g2d a b) Grass    BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 75, (m2d (a,b)) > 25]
-      hill     = [((a,b), (Full (a,b) (g2d a b) Hill     BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 25, (m2d (a,b)) > 10]
-      mountain = [((a,b), (Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 10]
+      water    = [((a,b), Full (a,b) 0.0       Ocean    BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) > 95]
+      beach    = [((a,b), Full (a,b) (g2d a b) Beach    BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 95, m2d (a,b) > 75]
+      grass    = [((a,b), Full (a,b) (g2d a b) Grass    BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 75, m2d (a,b) > 25]
+      hill     = [((a,b), Full (a,b) (g2d a b) Hill     BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 25, m2d (a,b) > 10]
+      mountain = [((a,b), Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 10]
 
       g2d :: Int -> Int -> Float
       g2d x y = gauss3D (fromIntegral x) (fromIntegral y)
@@ -28,7 +28,7 @@ mapCenterMountain = array ((0,0),(199,199)) nodes
 -- small helper for some hills. Should be replaced by multi-layer perlin-noise
 -- TODO: Replace as given in comment.
 _noisyMap :: (Floating q) => q -> q -> q
-_noisyMap = \x y -> gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y
+_noisyMap x y =    gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y
                 +  gauss3Dgeneral 5  10.0 10.0 10.0 10.0 x y
                 +  gauss3Dgeneral 5  150.0 120.0 10.0 10.0 x y
                 +  gauss3Dgeneral 5  50.0 75.0 10.0 10.0 x y
@@ -38,14 +38,13 @@ _noisyMap = \x y -> gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y
 mapNoise :: PlayMap
 mapNoise = array ((0,0),(199,199)) nodes
     where
-      nodes    = [((a,b), (Full
-                            (a,b)
+      nodes    = [((a,b), Full (a,b)
                                (height a b)
                                (heightToTerrain GrassIslandMap $ height a b)
                                BNothing
                                NoPlayer
                                NoPath
                                Plain
-                            [])) | a <- [0..199], b <- [0..199]]
+                               []) | a <- [0..199], b <- [0..199]]
                  where
-                    height a b = (_noisyMap (fromIntegral a) (fromIntegral b))
+                    height a b = _noisyMap (fromIntegral a) (fromIntegral b)

src/Map/Types.hs

@@ -20,7 +20,7 @@ data PlayerInfo = NoPlayer
 
 instance Show PlayerInfo where
     show (NoPlayer)   = "not occupied"
-    show (Occupied i) = "occupied by player " ++ (show i)
+    show (Occupied i) = "occupied by player " ++ show i
 
 -- | Path info, is this node part of a path and if so, where does it lead?
 data PathInfo   = NoPath
@@ -34,7 +34,7 @@ data ResInfo    = Plain
 
 instance Show ResInfo where
     show (Plain)           = "no resources"
-    show (ResInfo res amt) = "Resource: " ++ (show res) ++ "," ++ (show amt)
+    show (ResInfo res amt) = "Resource: " ++ show res ++ "," ++ show amt
 
 -- | What commodities are currently stored here?
 type StorInfo   = [(Commodity,Amount)]
@@ -49,7 +49,7 @@ data BuildInfo  = BStruc Structure
                 | BLarge
 
 instance Show BuildInfo where
-    show (BStruc s) = "Structure: " ++ (show s)
+    show (BStruc s) = "Structure: " ++ show s
     show (BNothing) = "no Structure possible"
     show (BFlag)    = "only flags possible"
     show (BMine)    = "mines possible"