From e5857e84351d4cd91af2d6927e5c2f4cc5a8ecec Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Wed, 16 Apr 2014 21:21:08 +0200
Subject: [PATCH 01/17] changed massively in Types of IQM-Loader

- massive Type-Change internally
- VertexArrays are now read headerwise

- IQM needs postprocessing for allocating C-Arrays of the Vertex-Objects
as they cannot be guaranteed to be collected in the first pass of reading.
(Normally they are sorted linear - but the offsets WOULD allow for them
to be anywhere in-between the sections)
---
 src/Importer/IQM/Parser.hs |  30 ++++++-
 src/Importer/IQM/Types.hs  | 168 +++++++++++++++++++++++++++++--------
 src/Map/StaticMaps.hs      |   4 +-
 3 files changed, 162 insertions(+), 40 deletions(-)

diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index cd777c0..9fe8bfd 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -30,7 +30,7 @@ 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
@@ -40,7 +40,7 @@ _int16 = do
         return ret
 
 -- | read a 32-Bit Int from Parsing-Input and log 4 bytes in our Parsing-Monad
-int32 :: CParser Int32
+int32 :: CParser Word32
 int32 = do
         ret <- lift $ do
                          a <- anyWord8 :: Parser Word8
@@ -55,6 +55,7 @@ int32 = do
 readHeader :: CParser IQMHeader
 readHeader = do
          _ <- lift $ string (pack "INTERQUAKEMODEL\0")
+         modify (+16)
          v <- int32
          -- when v /= 2 then --TODO: error something
          size' <- int32
@@ -85,7 +86,7 @@ readHeader = do
          ofs_extensions' <- int32
          return IQMHeader { version = v
                 , filesize           = size'
-                , flags              = flags'
+                , flags              = fromIntegral flags'
                 , num_text           = num_text'
                 , ofs_text           = ofs_text'
                 , num_meshes         = num_meshes'
@@ -140,6 +141,26 @@ readMeshes n = do
         ms <- readMeshes (n-1)
         return $ m:ms
 
+-- | Parser for Mesh-Structure
+readVAF :: CParser IQMVertexArray
+readVAF = do
+        vat <- rawEnumToVAT =<< int32
+        flags' <- int32
+        format <- rawEnumToVAF =<< int32
+        size <- int32
+        offset <- int32
+        return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset
+
+-- | 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.
@@ -171,9 +192,12 @@ parseIQM = do
         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
+        skipToCounter $ ofs_vertexarrays h                      --skip 0-n byots to get to vertexarray definition
+        va <- readVAFs (fromIntegral (num_vertexarrays h))      --read them
         return IQM
                 { header = h
                 , texts = filter (not.null) (split (unsafeCoerce '\0') text)
                 , meshes = meshes'
+                , vertexArrays = va
                 }
 
diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs
index 1054767..ff7eb44 100644
--- a/src/Importer/IQM/Types.hs
+++ b/src/Importer/IQM/Types.hs
@@ -2,18 +2,26 @@
 --   4-Byte in the documentation indicates Int32 - 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
 
 -- | 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
 
 -- | Header of IQM-Format.
 --
@@ -23,33 +31,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,11 +65,11 @@ 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 a whole IQM-File
@@ -71,5 +79,95 @@ 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)
+
+-- | 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
+                       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) ++
+                                                        ")"
+
+-- | A triangle out of the Vertices at the Indexed Positions
+data IQMTriangle = IQMTriangle Index Index Index
+                       deriving (Show, Eq)
+
+
+-- | 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 Index Index Index
+                       deriving (Show, Eq)
+
diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs
index 895fdc5..32767f7 100644
--- a/src/Map/StaticMaps.hs
+++ b/src/Map/StaticMaps.hs
@@ -23,12 +23,12 @@ mapCenterMountain :: PlayMap
 mapCenterMountain = array ((0,0),(200,200)) nodes
     where
       nodes    = water ++ beach ++ grass ++ hill ++ mountain
-      water    = [((a,b), (Full (a,b) 0.0       Ocean    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) > 95] 
+      water    = [((a,b), (Full (a,b) 0.0       Ocean    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) > 95]
       beach    = [((a,b), (Full (a,b) (g2d a b) Beach    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 95, (m2d (a,b)) > 75]
       grass    = [((a,b), (Full (a,b) (g2d a b) Grass    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 75, (m2d (a,b)) > 25]
       hill     = [((a,b), (Full (a,b) (g2d a b) Hill     BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 25, (m2d (a,b)) > 10]
       mountain = [((a,b), (Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 10]
-     
+
       g2d :: Int -> Int -> Float
       g2d x y = gauss2D (fromIntegral x) (fromIntegral y)
 

From b7fef589a93601ecfe419a24a379cd6381ee0e87 Mon Sep 17 00:00:00 2001
From: jbetzend <jbetzend@techfak.uni-bielefeld.de>
Date: Wed, 23 Apr 2014 11:23:24 +0200
Subject: [PATCH 02/17] commit

---
 src/Map/Creation.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs
index 31703ae..949fd97 100644
--- a/src/Map/Creation.hs
+++ b/src/Map/Creation.hs
@@ -30,5 +30,5 @@ type Seed = (XCoord, ZCoord)
 -- | Add lakes on generated Map from (possible) Seeds noted before.
 --
 --   TODO: implement and erode terrain on the way down.
-addLakes :: PlayMap -> [Seeds] -> PlayMap
+addLakes :: PlayMap -> [Seed] -> PlayMap
 addLakes m s = undefined

From 313992efaf6ef45987c24521bc32cebe51c26c51 Mon Sep 17 00:00:00 2001
From: Jonas Betzendahl <jbetzend@techfak.uni-bielefeld.de>
Date: Wed, 23 Apr 2014 12:11:45 +0200
Subject: [PATCH 03/17] Merged Types with PioneerTypes

---
 src/Map/Types.hs    |  2 +-
 src/PioneerTypes.hs | 62 ---------------------------------------------
 src/Types.hs        | 62 ++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 62 insertions(+), 64 deletions(-)
 delete mode 100644 src/PioneerTypes.hs

diff --git a/src/Map/Types.hs b/src/Map/Types.hs
index 2599f5c..d3fe76c 100644
--- a/src/Map/Types.hs
+++ b/src/Map/Types.hs
@@ -1,7 +1,7 @@
 module Map.Types
 where
 
-import PioneerTypes
+import Types
 
 import Data.Array
 
diff --git a/src/PioneerTypes.hs b/src/PioneerTypes.hs
deleted file mode 100644
index 1e28802..0000000
--- a/src/PioneerTypes.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module PioneerTypes
-where
-
-data Structure = Flag           -- Flag
-               | Woodcutter     -- Huts
-               | Forester
-               | Stonemason
-               | Fisher
-               | Hunter
-               | Barracks
-               | Guardhouse
-               | LookoutTower
-               | Well
-               | Sawmill        -- Houses
-               | Slaughterhouse
-               | Mill
-               | Bakery
-               | IronSmelter
-               | Metalworks
-               | Armory
-               | Mint
-               | Shipyard
-               | Brewery
-               | Storehouse
-               | Watchtower
-               | Catapult
-               | GoldMine       -- Mines
-               | IronMine
-               | GraniteMine
-               | CoalMine
-               | Farm           -- Castles
-               | PigFarm
-               | DonkeyBreeder
-               | Harbor
-               | Fortress
-               deriving (Show, Eq)
-
-data Amount    = Infinite   -- Neverending supply
-               | Finite Int -- Finite supply
-
--- Extremely preliminary, expand when needed
-data Commodity = WoodPlank
-               | Sword
-               | Fish
-               deriving Eq
-
-data Resource  = Coal
-               | Iron
-               | Gold
-               | Granite
-               | Water
-               | Fishes
-               deriving (Show, Eq)
-
-instance Show Amount where
-    show (Infinite) = "inexhaustable supply"
-    show (Finite n) = show n ++ " left"
-
-instance Show Commodity where
-    show WoodPlank = "wooden plank"
-    show Sword     = "sword"
-    show Fish      = "fish"
diff --git a/src/Types.hs b/src/Types.hs
index c22735b..475953f 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -139,5 +139,65 @@ $(makeLenses ''Position)
 $(makeLenses ''Env)
 $(makeLenses ''UIState)
 
-
 type Pioneers = RWST Env () State IO
+
+data Structure = Flag           -- Flag
+               | Woodcutter     -- Huts
+               | Forester
+               | Stonemason
+               | Fisher
+               | Hunter
+               | Barracks
+               | Guardhouse
+               | LookoutTower
+               | Well
+               | Sawmill        -- Houses
+               | Slaughterhouse
+               | Mill
+               | Bakery
+               | IronSmelter
+               | Metalworks
+               | Armory
+               | Mint
+               | Shipyard
+               | Brewery
+               | Storehouse
+               | Watchtower
+               | Catapult
+               | GoldMine       -- Mines
+               | IronMine
+               | GraniteMine
+               | CoalMine
+               | Farm           -- Castles
+               | PigFarm
+               | DonkeyBreeder
+               | Harbor
+               | Fortress
+               deriving (Show, Eq)
+
+data Amount    = Infinite   -- Neverending supply
+               | Finite Int -- Finite supply
+
+-- Extremely preliminary, expand when needed
+data Commodity = WoodPlank
+               | Sword
+               | Fish
+               deriving Eq
+
+data Resource  = Coal
+               | Iron
+               | Gold
+               | Granite
+               | Water
+               | Fishes
+               deriving (Show, Eq)
+
+instance Show Amount where
+    show (Infinite) = "inexhaustable supply"
+    show (Finite n) = show n ++ " left"
+
+instance Show Commodity where
+    show WoodPlank = "wooden plank"
+    show Sword     = "sword"
+    show Fish      = "fish"
+

From fa9bda5e7ad464ac0423826a6de8963a8b77154d Mon Sep 17 00:00:00 2001
From: Jonas Betzendahl <jbetzend@techfak.uni-bielefeld.de>
Date: Wed, 23 Apr 2014 13:52:43 +0200
Subject: [PATCH 04/17] Added apply-by functions

---
 src/Map/Creation.hs   | 9 ++++++++-
 src/Map/StaticMaps.hs | 1 -
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs
index 949fd97..0f2c60f 100644
--- a/src/Map/Creation.hs
+++ b/src/Map/Creation.hs
@@ -2,15 +2,22 @@ module Map.Creation
 where
 
 import Map.Types
+import Data.Array
 
 -- | Generate a new Map of given Type and Size
 --
 --   TODO:
 --   1. Should take Size -> Type -> Playmap
 --   2. plug together helper-functions for that terraintype
-newMap :: Int -> Int -> PlayMap
+newMap :: MapType -> (Int, Int) -> PlayMap
 newMap = undefined
 
+aplByPlace :: (Node -> Node) -> ((Int,Int) -> Bool) -> PlayMap -> PlayMap
+aplByPlace f g mp = array (bounds mp) (map (\(ab,c) -> if g ab then (ab, f c) else (ab,c)) (assocs mp))
+
+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)) 
+
 
 -- | Basic Terrain-Generator. Will not implement "abnormal" Stuff for given Biome
 --   (like Deserts on Grass-Islands or Grass on Deserts)
diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs
index 34c6136..abe047e 100644
--- a/src/Map/StaticMaps.hs
+++ b/src/Map/StaticMaps.hs
@@ -32,7 +32,6 @@ mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
 mapEmpty :: PlayMap
 mapEmpty = array ((0,0), (199,199)) [((a,b), (Minimal (a,b))) | a <- [0..199], b <- [0..199]]
 
--- TODO: Stripify
 mapCenterMountain :: PlayMap
 mapCenterMountain = array ((0,0),(199,199)) nodes
     where

From 2b435b7cb20758f8357e521325f2f229445c60ee Mon Sep 17 00:00:00 2001
From: Jonas Betzendahl <jbetzend@techfak.uni-bielefeld.de>
Date: Thu, 24 Apr 2014 02:45:55 +0200
Subject: [PATCH 05/17] Added first primitive groundwork for map generation
 combinators. This is gonna be fun! :o)

---
 src/Map/Creation.hs   | 56 ++++++++++++++++++++++++++++++++++++++++++-
 src/Map/Graphics.hs   |  5 +++-
 src/Map/Map.hs        | 43 ++++++++++++++++++++++++++++-----
 src/Map/StaticMaps.hs | 25 +------------------
 4 files changed, 97 insertions(+), 32 deletions(-)

diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs
index 0f2c60f..8f302c2 100644
--- a/src/Map/Creation.hs
+++ b/src/Map/Creation.hs
@@ -2,7 +2,19 @@ module Map.Creation
 where
 
 import Map.Types
+import Map.Map
+
 import Data.Array
+import System.Random
+
+-- Orphan instance since this isn't where either Random nor Tuples are defined
+instance (Random x, Random y) => Random (x, y) where
+  randomR ((x1, y1), (x2, y2)) gen1 = let (a, gen2) = randomR (x1, x2) gen1
+                                          (b, gen3) = randomR (y1, y2) gen2
+                                      in ((a, b), gen3)
+
+  random                       gen1 = let (a, gen2) = random gen1
+                                          (b, gen3) = random gen2 in ((a,b), gen3)
 
 -- | Generate a new Map of given Type and Size
 --
@@ -18,6 +30,32 @@ aplByPlace f g mp = array (bounds mp) (map (\(ab,c) -> if g ab then (ab, f c) el
 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
+
+-- general 3D-Gaussian
+gauss3Dgeneral :: Floating q =>
+                  q    -- ^ Amplitude
+                  -> q -- ^ Origin on X-Achsis
+                  -> q -- ^ Origin on Z-Achsis
+                  -> q -- ^ Sigma on X
+                  -> q -- ^ Sigma on Z
+                  -> q -- ^ Coordinate in question on X
+                  -> q -- ^ Coordinate in question on Z
+                  -> q -- ^ elevation on coordinate in question
+gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((z-z0)^(2 :: Integer)/(2 * sZ^(2 :: Integer)))))
+
+-- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15
+gauss3D :: Floating q =>
+           q     -- ^ X-Coordinate
+           -> q  -- ^ Z-Coordinate
+           -> q  -- ^ elevation on coordinate in quesion
+gauss3D = gauss3Dgeneral 15 100.0 100.0 15.0 15.0
+
+-- 2D Manhattan distance
+mnh2D :: (Int,Int) -> (Int,Int) -> Int
+mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
 
 -- | Basic Terrain-Generator. Will not implement "abnormal" Stuff for given Biome
 --   (like Deserts on Grass-Islands or Grass on Deserts)
@@ -38,4 +76,20 @@ type Seed = (XCoord, ZCoord)
 --
 --   TODO: implement and erode terrain on the way down.
 addLakes :: PlayMap -> [Seed] -> PlayMap
-addLakes m s = undefined
+addLakes = undefined
+
+gaussMountain :: Int -> PlayMap -> PlayMap
+gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
+  where
+    g   = mkStdGen seed
+    c   = head $ randomRs (bounds mp) g
+    fi  = fromIntegral
+    htt = heightToTerrain
+
+    -- 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)
+      where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z)
+    liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain []
+      where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z)
diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs
index d551790..2a35ea9 100644
--- a/src/Map/Graphics.hs
+++ b/src/Map/Graphics.hs
@@ -30,6 +30,7 @@ import Linear
 
 import Map.Types
 import Map.StaticMaps
+import Map.Creation
 
 type Height = Float
 
@@ -88,7 +89,9 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
 
 getMapBufferObject :: IO (BufferObject, NumArrayIndices)
 getMapBufferObject = do
-        myMap'  <- return $ convertToGraphicsMap $ convertToStripeMap mapNoise
+        let mountains = [(gaussMountain 123456), (gaussMountain 31415926), 
+                         (gaussMountain 101514119), (gaussMountain 0)]
+        myMap'  <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty
         ! myMap <- return $ generateTriangles myMap'
         len <- return $ fromIntegral $ P.length myMap `div` numComponents
         putStrLn $ P.unwords ["num verts in map:",show len]
diff --git a/src/Map/Map.hs b/src/Map/Map.hs
index 0abaf38..b88a3b8 100644
--- a/src/Map/Map.hs
+++ b/src/Map/Map.hs
@@ -2,12 +2,43 @@ module Map.Map where
 
 import Map.Types
 
--- potentially to be expanded to Nodes
-giveNeighbours :: (Int, Int) -> [(Int,Int)]
-giveNeighbours (x,y) = filter (not . negative) all
+import Data.Array (bounds)
+import Data.List  (sort, group)
+
+-- WARNING: Does NOT Check for neighbours exceeding maximum map coordinates yet.
+unsafeGiveNeighbours :: (Int, Int)  -- ^ original coordinates
+                     -> [(Int,Int)] -- ^ list of neighbours
+unsafeGiveNeighbours (x,z) = filter (not . negative) allNs
   where
-    all = if even y then [(x+1,y), (x-1,y), (x,y+1), (x,y-1), (x+1,y+1), (x+1,y-1)]
-                    else [(x+1,y), (x-1,y), (x,y+1), (x,y-1), (x-1,y+1), (x-1,y-1)]
+    allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)]
+                      else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)]
 
     negative :: (Int, Int) -> Bool
-    negative (x,y) = x < 0 || y < 0
+    negative (a,b) = a < 0 || b < 0
+
+giveNeighbours :: PlayMap      -- ^ Map on which to find neighbours
+               -> (Int, Int)   -- ^ original coordinates
+               -> [(Int, Int)] -- ^ list of neighbours
+giveNeighbours mp (x,z) = filter (not . outOfBounds mp) allNs
+  where
+    allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)]
+                      else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)]
+
+    outOfBounds :: PlayMap -> (Int, Int) -> Bool
+    outOfBounds mp' (a,b) = let (lo,hi) = bounds mp' in
+                            a < fst lo || b < snd lo || a > fst hi || b > snd hi
+
+giveNeighbourhood :: PlayMap      -- ^ map on which to find neighbourhood
+                  -> Int          -- ^ iterative
+                  -> (Int, Int)   -- ^ original coordinates
+                  -> [(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)
+
+-- removing duplicates in O(n log n), losing order and adding Ord requirement
+remdups :: Ord a => [a] -> [a]
+remdups = map head . group . sort
+
+prop_rd_idempot :: Ord a => [a] -> Bool
+prop_rd_idempot xs = remdups xs == (remdups . remdups) xs
diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs
index abe047e..9507a82 100644
--- a/src/Map/StaticMaps.hs
+++ b/src/Map/StaticMaps.hs
@@ -3,30 +3,7 @@ where
 
 import Map.Types
 import Data.Array
-import Map.Creation (heightToTerrain)
-
--- general 3D-Gaussian
-gauss3Dgeneral :: Floating q =>
-                  q    -- ^ Amplitude
-                  -> q -- ^ Origin on X-Achsis
-                  -> q -- ^ Origin on Z-Achsis
-                  -> q -- ^ Sigma on X
-                  -> q -- ^ Sigma on Z
-                  -> q -- ^ Coordinate in question on X
-                  -> q -- ^ Coordinate in question on Z
-                  -> q -- ^ elevation on coordinate in question
-gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((z-z0)^(2 :: Integer)/(2 * sZ^(2 :: Integer)))))
-
--- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15
-gauss3D :: Floating q =>
-           q     -- ^ X-Coordinate
-           -> q  -- ^ Z-Coordinate
-           -> q  -- ^ elevation on coordinate in quesion
-gauss3D = gauss3Dgeneral 15 100.0 100.0 15.0 15.0
-
--- 2D Manhattan distance
-mnh2D :: (Int,Int) -> (Int,Int) -> Int
-mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
+import Map.Creation
 
 -- entirely empty map, only uses the minimal constructor
 mapEmpty :: PlayMap

From 0a7a882f8fd6b02d2cb521a79a73e0f100e13801 Mon Sep 17 00:00:00 2001
From: Jonas Betzendahl <jbetzend@techfak.uni-bielefeld.de>
Date: Thu, 24 Apr 2014 12:44:58 +0200
Subject: [PATCH 06/17] Now generates a different unique map each time.

---
 src/Map/Creation.hs | 24 ------------------------
 src/Map/Graphics.hs |  6 +++---
 src/Map/Types.hs    |  2 +-
 3 files changed, 4 insertions(+), 28 deletions(-)

diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs
index 8f302c2..04d018d 100644
--- a/src/Map/Creation.hs
+++ b/src/Map/Creation.hs
@@ -69,27 +69,3 @@ heightToTerrain GrassIslandMap y
                 | y < 10    = Hill
                 | otherwise = Mountain
 heightToTerrain _ _ = undefined
-
-type Seed = (XCoord, ZCoord)
-
--- | Add lakes on generated Map from (possible) Seeds noted before.
---
---   TODO: implement and erode terrain on the way down.
-addLakes :: PlayMap -> [Seed] -> PlayMap
-addLakes = undefined
-
-gaussMountain :: Int -> PlayMap -> PlayMap
-gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
-  where
-    g   = mkStdGen seed
-    c   = head $ randomRs (bounds mp) g
-    fi  = fromIntegral
-    htt = heightToTerrain
-
-    -- 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)
-      where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z)
-    liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain []
-      where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z)
diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs
index 2a35ea9..bf1dcfe 100644
--- a/src/Map/Graphics.hs
+++ b/src/Map/Graphics.hs
@@ -31,6 +31,7 @@ import Linear
 import Map.Types
 import Map.StaticMaps
 import Map.Creation
+import Map.Combinators
 
 type Height = Float
 
@@ -58,7 +59,7 @@ convertToGraphicsMap :: PlayMap -> GraphicsMap
 convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
     where
       graphicsyfy :: Node -> MapEntry
-      graphicsyfy (Minimal _               ) = (0, Grass)
+      graphicsyfy (Minimal _               ) = (1.0, Grass)
       graphicsyfy (Full    _ y t _ _ _ _ _ ) = (y, t)
 
 lineHeight :: GLfloat
@@ -89,8 +90,7 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
 
 getMapBufferObject :: IO (BufferObject, NumArrayIndices)
 getMapBufferObject = do
-        let mountains = [(gaussMountain 123456), (gaussMountain 31415926), 
-                         (gaussMountain 101514119), (gaussMountain 0)]
+        mountains <- mnt
         myMap'  <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty
         ! myMap <- return $ generateTriangles myMap'
         len <- return $ fromIntegral $ P.length myMap `div` numComponents
diff --git a/src/Map/Types.hs b/src/Map/Types.hs
index d3fe76c..66ddb4a 100644
--- a/src/Map/Types.hs
+++ b/src/Map/Types.hs
@@ -68,5 +68,5 @@ data TileType   = Ocean
 
 -- TODO: Record Syntax
 data Node = Full    (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
-          | Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 0
+          | Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 1
           deriving (Show)

From f76da4b5f6152ae749031dfeaffa7ad3bd5adf64 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Thu, 24 Apr 2014 14:21:25 +0200
Subject: [PATCH 07/17] moved generation of GLMapState

GLMapState now get generated inside the renderer and takes the
map-data as argument

GLMapState got extended by (up to now) uninitialized and unused textures.
---
 src/Main.hs          | 23 ++-----------------
 src/Render/Render.hs | 54 ++++++++++++++++++++++++++------------------
 src/Types.hs         | 23 ++++++++++++++++++-
 3 files changed, 56 insertions(+), 44 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index a361524..e00587e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -82,9 +82,7 @@ main =
         (Size fbWidth fbHeight) <- glGetDrawableSize window'
         initRendering
         --generate map vertices
-        (mapBuffer, vert) <- getMapBufferObject
-        (mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo, mapTex) <- initMapShader
-        overTex <- GL.genObjectName
+        glMap' <- initMapShader 4 =<< getMapBufferObject
         print window'
         eventQueue <- newTQueueIO :: IO (TQueue Event)
         putStrLn "foo"
@@ -109,23 +107,6 @@ main =
                 , _left     = False
                 , _right    = False
             }
-            glMap' = GLMapState
-                { _shdrVertexIndex      = vi
-                , _shdrNormalIndex      = ni
-                , _shdrColorIndex       = ci
-                , _shdrProjMatIndex     = pri
-                , _shdrViewMatIndex     = vii
-                , _shdrModelMatIndex    = mi
-                , _shdrNormalMatIndex   = nmi
-                , _shdrTessInnerIndex   = tli
-                , _shdrTessOuterIndex   = tlo
-                , _stateTessellationFactor = 4
-                , _stateMap             = mapBuffer
-                , _mapVert              = vert
-                , _mapProgram           = mapprog
-                , _mapTexture           = mapTex
-                , _overviewTexture      = overTex
-                }
             env = Env
               { _eventsChan      = eventQueue
               , _windowObject    = window'
@@ -302,7 +283,7 @@ adjustWindow = do
 
 
                    let hudtexid = state ^. gl.glHud.hudTexture
-                       maptexid = state ^. gl.glMap.mapTexture
+                       maptexid = state ^. gl.glMap.renderedMapTexture
                    allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do
                                                                --default to ugly pink to see if
                                                                --somethings go wrong.
diff --git a/src/Render/Render.hs b/src/Render/Render.hs
index 66702aa..6b3e4d3 100644
--- a/src/Render/Render.hs
+++ b/src/Render/Render.hs
@@ -50,22 +50,11 @@ initBuffer varray =
            checkError "initBuffer"
            return bufferObject
 
-initMapShader :: IO (
-                      Program           -- the GLSL-Program
-                      , AttribLocation  -- color
-                      , AttribLocation  -- normal
-                      , AttribLocation  -- vertex
-                      , UniformLocation -- ProjectionMat
-                      , UniformLocation -- ViewMat
-                      , UniformLocation -- ModelMat
-                      , UniformLocation -- NormalMat
-                      , UniformLocation -- TessLevelInner
-                      , UniformLocation -- TessLevelOuter
-                      , TextureObject   -- Texture where to draw into
-                      ) -- ^ (the GLSL-Program, color, normal, vertex, ProjectionMat, ViewMat,
-                        --    ModelMat, NormalMat, TessLevelInner, TessLevelOuter,
-                        --    Texture where to draw into)
-initMapShader = do
+initMapShader ::
+                Int                                -- ^ initial Tessallation-Factor
+                -> (BufferObject,NumArrayIndices)  -- ^ Buffer with Data and DataDescriptor
+                -> IO GLMapState
+initMapShader tessFac (buf, vertDes) = do
    ! vertexSource <- B.readFile mapVertexShaderFile
    ! tessControlSource <- B.readFile mapTessControlShaderFile
    ! tessEvalSource <- B.readFile mapTessEvalShaderFile
@@ -120,9 +109,30 @@ initMapShader = do
    putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
 
    tex <- genObjectName
+   overTex <- genObjectName
+
+   texts <- genObjectNames 6
+   
 
    checkError "initShader"
-   return (program, colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter, tex)
+   return GLMapState
+        { _mapProgram         = program
+        , _shdrColorIndex     = colorIndex
+        , _shdrNormalIndex    = normalIndex
+        , _shdrVertexIndex    = vertexIndex
+        , _shdrProjMatIndex   = projectionMatrixIndex
+        , _shdrViewMatIndex   = viewMatrixIndex
+        , _shdrModelMatIndex  = modelMatrixIndex
+        , _shdrNormalMatIndex = normalMatrixIndex
+        , _shdrTessInnerIndex = tessLevelInner
+        , _shdrTessOuterIndex = tessLevelOuter
+        , _renderedMapTexture = tex
+        , _stateTessellationFactor = tessFac
+        , _stateMap           = buf
+        , _mapVert            = vertDes
+        , _overviewTexture    = overTex
+        , _mapTextures        = texts
+        }
 
 initHud :: IO GLHud
 initHud = do
@@ -193,13 +203,13 @@ renderOverview = do
                 DepthAttachment
                 Renderbuffer
                 (state ^. gl.glRenderbuffer)
-        textureBinding Texture2D $= Just (state ^. gl.glMap.mapTexture)
+        textureBinding Texture2D $= Just (state ^. gl.glMap.renderedMapTexture)
 
         framebufferTexture2D
                 Framebuffer
                 (ColorAttachment 0)
                 Texture2D
-                (state ^. gl.glMap.mapTexture)
+                (state ^. gl.glMap.renderedMapTexture)
                 0
 
         -- Render to FrameBufferObject
@@ -285,13 +295,13 @@ render = do
                 DepthAttachment
                 Renderbuffer
                 (state ^. gl.glRenderbuffer)
-        textureBinding Texture2D $= Just (state ^. gl.glMap.mapTexture)
+        textureBinding Texture2D $= Just (state ^. gl.glMap.renderedMapTexture)
 
         framebufferTexture2D
                 Framebuffer
                 (ColorAttachment 0)
                 Texture2D
-                (state ^. gl.glMap.mapTexture)
+                (state ^. gl.glMap.renderedMapTexture)
                 0
 
         -- Render to FrameBufferObject
@@ -371,7 +381,7 @@ render = do
         uniform (hud ^. hudTexIndex) $= Index1 (0::GLint)
 
         activeTexture  $= TextureUnit 1
-        textureBinding Texture2D $= Just (state ^. gl.glMap.mapTexture)
+        textureBinding Texture2D $= Just (state ^. gl.glMap.renderedMapTexture)
         uniform (hud ^. hudBackIndex) $= Index1 (1::GLint)
 
         bindBuffer ArrayBuffer $= Just (hud ^. hudVBO)
diff --git a/src/Types.hs b/src/Types.hs
index 64e7f17..22329f8 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -74,6 +74,26 @@ data KeyboardState = KeyboardState
     { _arrowsPressed        :: !ArrowKeyState
     }
 
+-- | State in which all map-related Data is stored
+--
+--   The map itself is rendered with mapProgram and the shaders given here directly
+--   This does not include any objects on the map - only the map itself
+--
+--   _mapTextures must contain the following Textures (in this ordering) after initialisation:
+--
+--     1. Grass
+--
+--     2. Sand
+--
+--     3. Water
+--
+--     4. Stone
+--
+--     5. Snow
+--
+--     6. Dirt (blended on grass)
+
+
 data GLMapState = GLMapState
     { _shdrVertexIndex      :: !GL.AttribLocation
     , _shdrColorIndex       :: !GL.AttribLocation
@@ -88,8 +108,9 @@ data GLMapState = GLMapState
     , _stateMap             :: !GL.BufferObject
     , _mapVert              :: !GL.NumArrayIndices
     , _mapProgram           :: !GL.Program
-    , _mapTexture           :: !TextureObject
+    , _renderedMapTexture   :: !TextureObject --TODO: Probably move to UI?
     , _overviewTexture      :: !TextureObject
+    , _mapTextures          :: ![TextureObject] --TODO: Fix size on list?
     }
 
 data GLHud = GLHud

From a727131f13f36d0fa7958b9db80c01a092e4ebb2 Mon Sep 17 00:00:00 2001
From: Jonas Betzendahl <jbetzend@techfak.uni-bielefeld.de>
Date: Thu, 24 Apr 2014 14:24:20 +0200
Subject: [PATCH 08/17] Forgot Combinator module

---
 src/Map/Combinators.hs | 46 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 src/Map/Combinators.hs

diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs
new file mode 100644
index 0000000..3e143c2
--- /dev/null
+++ b/src/Map/Combinators.hs
@@ -0,0 +1,46 @@
+module Map.Combinators where
+
+import Map.Types
+import Map.Creation
+
+import Data.Array
+import System.Random
+
+-- preliminary
+infix 5 ->-
+(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap)
+f ->- g = (g . f)
+
+-- also preliminary
+infix 5 -<-
+(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap)
+f -<- g = (f . g)
+
+lake :: Int -> PlayMap -> PlayMap
+lake = undefined
+
+river :: Int -> PlayMap -> PlayMap
+river = undefined
+
+mnt :: IO [PlayMap -> PlayMap]
+mnt = do g <- newStdGen
+         let seeds = take 10 $ randoms g
+         return $ map gaussMountain seeds
+
+gaussMountain :: Int -> PlayMap -> PlayMap
+gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
+  where
+    g   = mkStdGen seed
+    c   = head $ randomRs (bounds mp) g
+    amp = head $ randomRs (5.0, 20.0) g
+    sig = head $ randomRs (5.0, 25.0) g
+    fi  = fromIntegral
+    htt = heightToTerrain
+
+    -- 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)
+      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)

From 60fd2172337ff6a8c7c54a120e33bd36b1c00878 Mon Sep 17 00:00:00 2001
From: Jonas Betzendahl <jbetzend@techfak.uni-bielefeld.de>
Date: Fri, 25 Apr 2014 15:58:25 +0200
Subject: [PATCH 09/17] hlint all around

---
 src/Map/Combinators.hs | 10 +++++-----
 src/Map/Creation.hs    |  3 +--
 src/Map/Graphics.hs    |  5 +++--
 src/Map/Map.hs         |  2 +-
 src/Map/StaticMaps.hs  | 33 ++++++++++++++++-----------------
 src/Map/Types.hs       |  6 +++---
 6 files changed, 29 insertions(+), 30 deletions(-)

diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs
index 3e143c2..9dabb89 100644
--- a/src/Map/Combinators.hs
+++ b/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)
diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs
index 04d018d..d677cdd 100644
--- a/src/Map/Creation.hs
+++ b/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 =>
diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs
index bf1dcfe..5cc198a 100644
--- a/src/Map/Graphics.hs
+++ b/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
diff --git a/src/Map/Map.hs b/src/Map/Map.hs
index b88a3b8..e358cee 100644
--- a/src/Map/Map.hs
+++ b/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]
diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs
index 9507a82..74ea371 100644
--- a/src/Map/StaticMaps.hs
+++ b/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)
-                            (height a b)
-                            (heightToTerrain GrassIslandMap $ height a b)
-                            BNothing
-                            NoPlayer
-                            NoPath
-                            Plain
-                            [])) | a <- [0..199], b <- [0..199]]
+      nodes    = [((a,b), Full (a,b)
+                               (height a b)
+                               (heightToTerrain GrassIslandMap $ height a b)
+                               BNothing
+                               NoPlayer
+                               NoPath
+                               Plain
+                               []) | a <- [0..199], b <- [0..199]]
                  where
-                    height a b = (_noisyMap (fromIntegral a) (fromIntegral b))
+                    height a b = _noisyMap (fromIntegral a) (fromIntegral b)
diff --git a/src/Map/Types.hs b/src/Map/Types.hs
index 66ddb4a..c62837f 100644
--- a/src/Map/Types.hs
+++ 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"

From 64d542adf37032ebf7894ddd7268d29affdd3d70 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Fri, 25 Apr 2014 21:21:19 +0200
Subject: [PATCH 10/17] more parsing ... -.-

---
 Pioneers.cabal              |  12 +--
 shaders/map/tessEval.shader |  98 +++++++++++++++++++++-
 src/Importer/IQM/Parser.hs  | 158 +++++++++++++++++++++---------------
 src/Importer/IQM/Types.hs   |  98 +++++++++++-----------
 src/Main.hs                 |  17 ++--
 5 files changed, 256 insertions(+), 127 deletions(-)

diff --git a/Pioneers.cabal b/Pioneers.cabal
index 0c2be9b..916f8bd 100644
--- a/Pioneers.cabal
+++ b/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,6 +46,7 @@ executable Pioneers
                    SDL2 >= 0.1.0,
                    time >=1.4.0,
                    GLUtil >= 0.7,
-                   attoparsec >= 0.11.2
+                   attoparsec >= 0.11.2,
+                   attoparsec-binary >= 0.1
   Default-Language: Haskell2010
 
diff --git a/shaders/map/tessEval.shader b/shaders/map/tessEval.shader
index 09f6483..35afc5d 100644
--- a/shaders/map/tessEval.shader
+++ b/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[];
@@ -37,6 +132,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);
 
     //COLOR-BLENDING
@@ -48,4 +144,4 @@ void main()
     //mix gravel based on incline (sin (normal,up))
     gmix = length(cross(tessNormal, vec3(0,1,0)));
 
-}
\ No newline at end of file
+}
diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index 9fe8bfd..278ba76 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -8,8 +8,11 @@ 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.Attoparsec (parse, takeByteString)
 import Data.ByteString.Char8 (pack)
-import Data.ByteString (split, null)
+import Data.ByteString (split, null, ByteString)
+import qualified Data.ByteString as B
 import Data.Word
 import Data.Int
 import Unsafe.Coerce
@@ -20,12 +23,12 @@ import Control.Monad
 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
 --
@@ -35,55 +38,62 @@ _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 Word32
-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")
          modify (+16)
-         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
+         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              = fromIntegral flags'
@@ -116,12 +126,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
@@ -144,11 +154,11 @@ readMeshes n = do
 -- | Parser for Mesh-Structure
 readVAF :: CParser IQMVertexArray
 readVAF = do
-        vat <- rawEnumToVAT =<< int32
-        flags' <- int32
-        format <- rawEnumToVAF =<< int32
-        size <- int32
-        offset <- int32
+        vat <- rawEnumToVAT =<< w32leCParser
+        flags' <- w32leCParser
+        format <- rawEnumToVAF =<< w32leCParser
+        size <- w32leCParser
+        offset <- w32leCParser
         return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset
 
 -- | helper to read n consecutive Meshes tail-recursive
@@ -166,7 +176,7 @@ readVAFs n = do
 (.-) :: 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 .-
 
@@ -183,21 +193,35 @@ 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
-        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
-        skipToCounter $ ofs_vertexarrays h                      --skip 0-n byots to get to vertexarray definition
-        va <- readVAFs (fromIntegral (num_vertexarrays h))      --read them
-        return IQM
-                { header = h
-                , texts = filter (not.null) (split (unsafeCoerce '\0') text)
-                , meshes = meshes'
-                , vertexArrays = va
-                }
+parseIQM :: String -> IO IQM
+parseIQM a =
+	do
+	f <- B.readFile a
+	Done _ raw <- return $ parse doIQMparse f
+	
+	let ret = raw
+	return ret
 
+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
+		skipToCounter $ ofs_vertexarrays h
+                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
diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs
index ff7eb44..cc7e940 100644
--- a/src/Importer/IQM/Types.hs
+++ b/src/Importer/IQM/Types.hs
@@ -1,5 +1,6 @@
--- | Int32 or Int64 - depending on implementation. Format just specifies "uint".
---   4-Byte in the documentation indicates Int32 - but not specified!
+{-# LANGUAGE 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)
@@ -31,33 +32,33 @@ type IQMData = Ptr IQMVertexArrayFormat
 --
 --   ofs_* fields are aligned at 4-byte-boundaries
 data IQMHeader = IQMHeader
-                { 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
+                { 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.
@@ -72,6 +73,22 @@ data IQMMesh = IQMMesh
                 , 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!
@@ -151,23 +168,10 @@ data IQMVertexArray = IQMVertexArray
                         Offset
                        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) ++
+    show (IQMVertexArray t fl fo nc off) = "IQMVertexArray (Type: " ++ show t ++
+                                                        ", Flags: " ++ show fl ++
+                                                        ", Format: " ++ show fo ++
+                                                        ", NumComponents: " ++ show nc ++
+                                                        ", Offset: " ++ show off ++
                                                         ")"
 
--- | A triangle out of the Vertices at the Indexed Positions
-data IQMTriangle = IQMTriangle Index Index Index
-                       deriving (Show, Eq)
-
-
--- | 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 Index Index Index
-                       deriving (Show, Eq)
-
diff --git a/src/Main.hs b/src/Main.hs
index 73279e8..833042b 100644
--- a/src/Main.hs
+++ b/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.Distributive                    (distribute, collect)
 import           Data.Monoid                          (mappend)
@@ -51,17 +50,21 @@ import           Render.Render                        (initRendering,
 import           UI.Callbacks
 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-}
 
 --------------------------------------------------------------------------------
 

From e6a56b84097b7a97b8da8cf4bbe5d0ca76033801 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Fri, 25 Apr 2014 23:58:20 +0200
Subject: [PATCH 11/17] more iqm - not tested, but typechecks and builds.

---
 src/Importer/IQM/Parser.hs | 22 +++++++++++++++++++---
 src/Importer/IQM/Types.hs  | 25 ++++++++++++++++++++++---
 2 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index 278ba76..e332df8 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -9,9 +9,9 @@ import Importer.IQM.Types
 import Data.Attoparsec.ByteString.Char8
 import Data.Attoparsec.ByteString
 import Data.Attoparsec.Binary
-import Data.Attoparsec (parse, takeByteString)
 import Data.ByteString.Char8 (pack)
 import Data.ByteString (split, null, ByteString)
+import Data.ByteString.Unsafe (unsafeUseAsCString)
 import qualified Data.ByteString as B
 import Data.Word
 import Data.Int
@@ -19,6 +19,9 @@ 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)
 
@@ -159,7 +162,7 @@ readVAF = do
         format <- rawEnumToVAF =<< w32leCParser
         size <- w32leCParser
         offset <- w32leCParser
-        return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset
+        return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset nullPtr
 
 -- | helper to read n consecutive Meshes tail-recursive
 readVAFs :: Int -> CParser [IQMVertexArray]
@@ -198,10 +201,23 @@ parseIQM a =
 	do
 	f <- B.readFile a
 	Done _ raw <- return $ parse doIQMparse f
-	
+		
 	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
diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs
index cc7e940..3558660 100644
--- a/src/Importer/IQM/Types.hs
+++ b/src/Importer/IQM/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# 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
@@ -11,6 +11,9 @@ import Data.Attoparsec.ByteString.Char8
 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 Word32 deriving (Show, Eq)
@@ -22,7 +25,7 @@ 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
+type IQMData = Ptr IQMVertexArrayFormat -- ^ Pointer for Data
 
 -- | Header of IQM-Format.
 --
@@ -138,6 +141,21 @@ data IQMVertexArrayFormat = IQMbyte
 --                            | 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
@@ -166,9 +184,10 @@ data IQMVertexArray = IQMVertexArray
                         IQMVertexArrayFormat
                         NumComponents
                         Offset
+			IQMData
                        deriving (Eq)
 instance Show IQMVertexArray where
-    show (IQMVertexArray t fl fo nc off) = "IQMVertexArray (Type: " ++ show t ++
+    show (IQMVertexArray t fl fo nc off _) = "IQMVertexArray (Type: " ++ show t ++
                                                         ", Flags: " ++ show fl ++
                                                         ", Format: " ++ show fo ++
                                                         ", NumComponents: " ++ show nc ++

From a81418bf40e5a5b65b7fb9e597c2a5c2f2192cb3 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 26 Apr 2014 00:15:36 +0200
Subject: [PATCH 12/17] iqm does not work .. :(

---
 src/Importer/IQM/Parser.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index e332df8..e330f19 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -200,8 +200,13 @@ parseIQM :: String -> IO IQM
 parseIQM a =
 	do
 	f <- B.readFile a
-	Done _ raw <- return $ parse doIQMparse f
-		
+	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
 
@@ -228,7 +233,7 @@ doIQMparse =
 	       	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
-		skipToCounter $ ofs_vertexarrays h
+		skipToCounter $ ofs_vertexarrays h			--skip 0-n bytes to get to Vertex-Arrays
                 vaf <- readVAFs $ fromIntegral $ num_vertexarrays h     --read Vertex-Arrays
 
 		_ <- lift takeByteString

From 2e22e77d7552d7e0b708dff63468ef4bd5d43d9b Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 26 Apr 2014 16:52:32 +0200
Subject: [PATCH 13/17] memory gets allocated and written.

No garantuee for correctness....
---
 src/Importer/IQM/Parser.hs | 32 ++++++++++++++++----------------
 src/Importer/IQM/Types.hs  |  8 ++++----
 2 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index e330f19..0295516 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -200,28 +200,30 @@ 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
+	-- Parse Headers/Offsets
+	let result = parse doIQMparse f
+	raw <- case result of
 		Done _ x -> return x
-		y -> error $ show y	
-	let ret = raw
-	return ret
+		y -> error $ show y
+	-- Fill Vertex-Arrays with data of Offsets
+	let 	va = vertexArrays raw
+	va' <- mapM (readInVAO f) va
+	return $ raw {
+		vertexArrays = va'
+		}
 
-readInVAO :: IQMVertexArray -> ByteString -> IO IQMVertexArray
-readInVAO (IQMVertexArray type' a format num offset ptr) d = 
+readInVAO :: ByteString -> IQMVertexArray -> IO IQMVertexArray
+readInVAO d (IQMVertexArray type' a format num offset ptr) = 
 		do
 		let 
-			byteLen = (fromIntegral num)*(vaSize format)
+			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'
+		unless (ptr == nullPtr) $ error $ "Error reading Vertex-Array: Double Read of " ++ show type'
 		p <- mallocBytes byteLen
+		putStrLn $ concat ["Allocating ", show byteLen, " Bytes at ", show p]
 		unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
-		p' <- unsafeCoerce p
-		return (IQMVertexArray type' a format num offset p')
+		return $ IQMVertexArray type' a format num offset $ castPtr p
 		
 doIQMparse :: Parser IQM
 doIQMparse = 
@@ -235,8 +237,6 @@ doIQMparse =
 	        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)
diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs
index 3558660..01ec020 100644
--- a/src/Importer/IQM/Types.hs
+++ b/src/Importer/IQM/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, RankNTypes, CPP, BangPatterns #-}
+-- {-# 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
@@ -13,7 +13,6 @@ 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 Word32 deriving (Show, Eq)
@@ -148,7 +147,7 @@ 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 IQMhalf 		= sizeOf (undefined :: Word16) --TODO: Find 16-Bit-Float-Datatype FIXME!
 vaSize IQMfloat 	= sizeOf (undefined :: CFloat)
 vaSize IQMdouble 	= sizeOf (undefined :: CDouble)
 
@@ -187,10 +186,11 @@ data IQMVertexArray = IQMVertexArray
 			IQMData
                        deriving (Eq)
 instance Show IQMVertexArray where
-    show (IQMVertexArray t fl fo nc off _) = "IQMVertexArray (Type: " ++ show t ++
+    show (IQMVertexArray t fl fo nc off dat) = "IQMVertexArray (Type: " ++ show t ++
                                                         ", Flags: " ++ show fl ++
                                                         ", Format: " ++ show fo ++
                                                         ", NumComponents: " ++ show nc ++
                                                         ", Offset: " ++ show off ++
+							", Data at: " ++ show dat ++ 
                                                         ")"
 

From 5223c34da2f24d1f217863df33826affd757ba8c Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 26 Apr 2014 17:12:19 +0200
Subject: [PATCH 14/17] 100% Haddock

---
 src/Importer/IQM/Parser.hs | 16 ++++++++++++++++
 src/Importer/IQM/Types.hs  | 13 ++++++++++---
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index 0295516..1d5b9fe 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -196,6 +196,9 @@ skipToCounter a = do
                         put d
 
 -- | Parses an IQM-File and handles back the Haskell-Structure
+--
+--   Does a 2-Pass-Parsing. Reads in Structure on first pass (O(n))and
+--   fills the Structure in a 2nd Pass from Offsets (O(memcpy'd bytes)).
 parseIQM :: String -> IO IQM
 parseIQM a =
 	do
@@ -212,6 +215,11 @@ parseIQM a =
 		vertexArrays = va'
 		}
 
+-- | Allocates memory for the Vertex-data and copies it over there
+--   from the given input-String
+--
+--   Note: The String-Operations are O(1), so only O(numberOfCopiedBytes)
+--   is needed in term of computation.
 readInVAO :: ByteString -> IQMVertexArray -> IO IQMVertexArray
 readInVAO d (IQMVertexArray type' a format num offset ptr) = 
 		do
@@ -225,6 +233,10 @@ readInVAO d (IQMVertexArray type' a format num offset ptr) =
 		unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
 		return $ IQMVertexArray type' a format num offset $ castPtr p
 		
+-- | Real internal Parser.
+--
+--   Consumes the String only once, thus in O(n). But all Data-Structures are
+--   not allocated and copied. readInVAO has to be called on each one.
 doIQMparse :: Parser IQM
 doIQMparse = 
 	flip evalStateT 0 $ --evaluate parser with state starting at 0
@@ -244,5 +256,9 @@ doIQMparse =
 			, vertexArrays = vaf
 	                }
 
+-- | Helper-Function for Extracting a random substring out of a Bytestring
+--   by the Offsets provided.
+--
+--   O(1).
 skipDrop :: Int -> Int -> ByteString -> ByteString
 skipDrop a b= B.drop b . B.take a
diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs
index 01ec020..847320f 100644
--- a/src/Importer/IQM/Types.hs
+++ b/src/Importer/IQM/Types.hs
@@ -20,10 +20,19 @@ newtype Mesh = Mesh Word32 deriving (Show, Eq)
 --   Bytes read for offset-gap reasons
 type CParser a = StateT Int64 Parser a
 
+-- | Alias
 type Flags = GLbitfield      -- ^ Alias for UInt32
+
+-- | Alias
 type Offset = Word32         -- ^ Alias for UInt32
+
+-- | Alias
 type Index = GLuint          -- ^ Alias for UInt32
+
+-- | Alias
 type NumComponents = GLsizei -- ^ Alias for UInt32
+
+-- | Data-BLOB inside IQM
 type IQMData = Ptr IQMVertexArrayFormat -- ^ Pointer for Data
 
 -- | Header of IQM-Format.
@@ -104,7 +113,6 @@ data IQM = IQM
 -- | Different Vertex-Array-Types in IQM
 --
 --   Custom Types have to be > 0x10 as of specification
-
 data IQMVertexArrayType = IQMPosition
                        | IQMTexCoord
                        | IQMNormal
@@ -116,7 +124,6 @@ data IQMVertexArrayType = IQMPosition
                        deriving (Show, Eq)
 
 -- | Lookup-Function for internal enum to VertexArrayFormat
-
 rawEnumToVAT :: Word32 -> CParser IQMVertexArrayType
 rawEnumToVAT 0 = return IQMPosition
 rawEnumToVAT 1 = return IQMTexCoord
@@ -140,6 +147,7 @@ data IQMVertexArrayFormat = IQMbyte
 --                            | Unknown Word32
                        deriving (Show, Eq)
 
+-- | Get the Size (in Bytes) of the given IQMVertexArrayFormat-Struct
 vaSize :: IQMVertexArrayFormat -> Int
 vaSize IQMbyte 		= sizeOf (undefined :: CSChar)
 vaSize IQMubyte 	= sizeOf (undefined :: CUChar)
@@ -156,7 +164,6 @@ vaSize IQMdouble 	= sizeOf (undefined :: CDouble)
 --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

From 160c6e3ae85bcbdeddc796e7ecd9bc2d80380bcc Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 26 Apr 2014 17:33:17 +0200
Subject: [PATCH 15/17] rewrote readme, enhanced .gitignore

---
 .gitignore |  8 ++++++++
 README     |  4 ----
 README.md  | 21 +++++++++++++++++++++
 3 files changed, 29 insertions(+), 4 deletions(-)
 delete mode 100644 README
 create mode 100644 README.md

diff --git a/.gitignore b/.gitignore
index 925f33a..0df715f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,11 @@
 /.dist-buildwrapper
 /.project
 /.settings
+.cabal-sandbox
+*.trace
+cabal.sandbox.config
+deps/hsSDL2*
+deps/*.deb
+dist/*
+*.swp
+
diff --git a/README b/README
deleted file mode 100644
index a831599..0000000
--- a/README
+++ /dev/null
@@ -1,4 +0,0 @@
-Pioneers
-========
-
-A Settlers II inspired game written in Haskell
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..4832f95
--- /dev/null
+++ b/README.md
@@ -0,0 +1,21 @@
+# Pioneers
+
+A Settlers II inspired game written in Haskell
+
+## Development-Status
+
+Bugtracker/Wiki: http://redmine.pwning.de/projects/pioneers
+
+## Features
+
+Note, that most of it is just planned and due to change.
+
+- modern OpenGL3.x-Engine
+- themeable with different Cultures
+- rock-solid Multiplayer (no desync, just slightly more lag in case of resync)
+
+## Why Haskell?
+
+- There are not enough good games written in functional languages.
+- More robust and easier to reason about lateron
+

From 8a3597f754c15c67dddf93e56fa5683f09f3ad2b Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 26 Apr 2014 17:40:08 +0200
Subject: [PATCH 16/17] moooaaar Readme

---
 README.md | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/README.md b/README.md
index 4832f95..e80b7a2 100644
--- a/README.md
+++ b/README.md
@@ -6,6 +6,24 @@ A Settlers II inspired game written in Haskell
 
 Bugtracker/Wiki: http://redmine.pwning.de/projects/pioneers
 
+## Compiling
+
+1. Clone this repository
+2. Set up cabal-sandbox
+```
+$ cabal sandbox init
+$ cd deps
+$ ./getDeps.sh
+$ cd ..
+$ cabal sandbox add-source deps/hsSDL2
+```
+3. install libraries `sudo apt-get install libsdl2` - make sure libsdl2 is in version 2.0.1+ (shipped with Ubuntu since 14.04)
+4. install dependencies `cabal install --only-dependencies`
+5. build `cabal build`
+6. run `./Pioneers`
+
+Step 2 is likely to break in the future due to restructuring in hsSDL2. This will be updated accordingly then.
+
 ## Features
 
 Note, that most of it is just planned and due to change.

From 93018173f6e6ff2cd493559d460720517dea307f Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sat, 26 Apr 2014 17:42:35 +0200
Subject: [PATCH 17/17] readme

---
 README.md | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/README.md b/README.md
index e80b7a2..39048e9 100644
--- a/README.md
+++ b/README.md
@@ -8,19 +8,19 @@ Bugtracker/Wiki: http://redmine.pwning.de/projects/pioneers
 
 ## Compiling
 
-1. Clone this repository
-2. Set up cabal-sandbox
-```
-$ cabal sandbox init
-$ cd deps
-$ ./getDeps.sh
-$ cd ..
-$ cabal sandbox add-source deps/hsSDL2
-```
-3. install libraries `sudo apt-get install libsdl2` - make sure libsdl2 is in version 2.0.1+ (shipped with Ubuntu since 14.04)
-4. install dependencies `cabal install --only-dependencies`
-5. build `cabal build`
-6. run `./Pioneers`
+1. 	Clone this repository
+2. 	Set up cabal-sandbox
+	```
+	$ cabal sandbox init
+	$ cd deps
+	$ ./getDeps.sh
+	$ cd ..
+	$ cabal sandbox add-source deps/hsSDL2
+	```
+3. 	install libraries `sudo apt-get install libsdl2` - make sure libsdl2 is in version 2.0.1+ (shipped with Ubuntu since 14.04)
+4. 	install dependencies `cabal install --only-dependencies`
+5. 	build `cabal build`
+6. 	run `./Pioneers`
 
 Step 2 is likely to break in the future due to restructuring in hsSDL2. This will be updated accordingly then.