Add tilemap floors to rooms

src/Data/Tile.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Data.Tile
+    where
+import Geometry.Data
+
+import Control.Lens
+data Tile = Tile
+    { _tilePoly :: [Point2]
+    , _tileCenter :: Point2
+    , _tileX :: Point2
+    , _tileY :: Point2
+    , _tileZ :: Float
+    }
+makeLenses ''Tile

src/Dodge/Creature/State/Data.hs

@@ -2,7 +2,8 @@
 {-# LANGUAGE StrictData #-}
 module Dodge.Creature.State.Data
   where
-import Geometry
+--import Geometry
+import Geometry.Data
 import Dodge.Data.DamageType
 --import Dodge.Creature.Stance.Data
 import Picture.Data

src/Dodge/Data/DamageType.hs

@@ -6,7 +6,8 @@ creatures.
 -}
 module Dodge.Data.DamageType
     where
-import Geometry
+--import Geometry
+import Geometry.Data
 
 import Control.Lens
 

src/Dodge/Default/Room.hs

@@ -0,0 +1,13 @@
+module Dodge.Default.Room
+    where
+import Dodge.Room.Data
+
+defaultRoom :: Room
+defaultRoom = Room
+    { _rmPolys = []
+    , _rmLinks = []
+    , _rmPath = []
+    , _rmPS = []
+    , _rmBound = []
+    , _rmFloor = []
+    }

src/Dodge/Default/World.hs

@@ -10,6 +10,8 @@ import Dodge.Item.Data
 import Picture
 import Geometry
 import Picture.Texture
+import Data.Tile
+import Tile
 
 import System.Random
 import qualified Data.IntMap.Strict as IM
@@ -37,17 +39,23 @@ defaultWorld = World
     , _wallsZone = IM.empty
     , _forceFields = IM.empty
     , _floorItems = IM.empty
-    , _floorTiles = 
+    , _floorTiles = tToRender $ Tile
-        let x = 200
+        { _tilePoly = rectNSWE 200 0 0 200
-            y = 0.9
+        , _tileCenter = (0,0)
-            z = 16
+        , _tileX = (100,0)
-            r = 4
+        , _tileY = (0,100)
-        in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)]
+        , _tileZ = 16
-            [(20,100 + 20,y)
+        } 
-            ,( x,100 + 20,y)
+--        let x = 200
-            ,( x,100 +  x,y)
+--            y = 0.9
-            ,(20,100 +  x,y)
+--            z = 16
-            ]
+--            r = 8
+--        in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)]
+--            [(20,100 + 20,y)
+--            ,( x,100 + 20,y)
+--            ,( x,100 +  x,y)
+--            ,(20,100 +  x,y)
+--            ]
     , _randGen = mkStdGen 2
     , _mousePos = (0,0)
     , _testString = []

src/Dodge/Layout.hs

@@ -14,6 +14,8 @@ import Geometry
 import Dodge.Room.Link
 import qualified IntMapHelp as IM
 --import Dodge.Debug.LinkDecoration
+import Picture.Data
+import Tile
 
 import Control.Monad.State
 import Control.Lens
@@ -30,6 +32,7 @@ generateLevelFromRoomList gr w = updateWallZoning
 --    . addRoomPolyDecorations rs
 --    . addRoomLinkDecorations rs
     $ w { _walls = wallsFromRooms rs
+        , _floorTiles = floorsFromRooms rs
         }
   where
     plmnts = concatMap _rmPS rs
@@ -89,6 +92,9 @@ wallsFromRooms =
   where
     f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
 
+floorsFromRooms :: [Room] -> [RenderType]
+floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
+
 divideWall :: Wall -> [Wall]
 divideWall wl
     = let (a,b) = _wlLine wl

src/Dodge/Layout/Tree/Shift.hs

@@ -9,6 +9,7 @@ import Dodge.Room.Data
 import Dodge.Room.Link
 import Dodge.Layout.Tree.Polymorphic
 import Geometry
+import Geometry.Data
 
 import Data.Tree
 import Data.Sequence hiding (zipWith)

src/Dodge/Picture.hs

@@ -4,6 +4,7 @@ Creates uniform sizes and commands for the Dodge modules. -}
 module Dodge.Picture
     where
 import Geometry
+import Geometry.Data
 import Picture
 
 

src/Dodge/RandomHelp.hs

@@ -3,7 +3,7 @@ Helpers for random generation.
 -}
 module Dodge.RandomHelp where
 import Geometry
---import Geometry.Data
+import Geometry.Data
 
 import System.Random
 import Control.Monad.State

src/Dodge/Render.hs

@@ -11,7 +11,8 @@ import Dodge.Base
 --import Dodge.Render.MenuScreen
 import Dodge.Render.Picture
 --import Dodge.Render.PerspectiveMatrix
-import Geometry
+--import Geometry
+import Geometry.Data
 --import Picture
 import Picture.Render
 import Data.Preload.Render

src/Dodge/Render/Picture.hs

@@ -7,6 +7,7 @@ import Dodge.Picture.Layer
 import Dodge.Render.HUD
 import Dodge.Render.MenuScreen
 import Geometry
+import Geometry.Data
 import Picture
 
 --import Dodge.Creature.YourControl

src/Dodge/Room.hs

@@ -6,6 +6,7 @@ module Dodge.Room
     , module Dodge.Room.Corridor
     ) where
 import Dodge.Data
+import Dodge.Default.Room
 import Dodge.Item.Weapon
 import Dodge.Item.Weapon.AutoGun
 import Dodge.Item.Weapon.Launcher
@@ -43,7 +44,7 @@ import Data.Tree
 --import qualified Data.IntMap.Strict as IM
 
 roomC :: Float -> Float -> Room
-roomC x y = Room
+roomC x y = defaultRoom
     { _rmPolys = [rectNSWE y 0 0 x]
     , _rmLinks = lnks
     , _rmPath  = []
@@ -59,7 +60,7 @@ roomC x y = Room
         ]
 
 roomPadCut :: [Point2] -> Point2 -> Room
-roomPadCut ps p = Room
+roomPadCut ps p = defaultRoom
     { _rmPolys = [ps]
     , _rmLinks = [(p,0),((0,0),pi)]
     , _rmPath  = [((0,0),p)]
@@ -212,7 +213,7 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
         ]
 
 roomOctogon :: Room
-roomOctogon = Room
+roomOctogon = defaultRoom
     { _rmPolys = [[(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
                  ]
     , _rmLinks = lnks
@@ -338,7 +339,7 @@ critInDeadEnd :: Room
 critInDeadEnd = set rmPS [sPS (0,0) 0 randC1] deadEndRoom
 
 deadEndRoom :: Room
-deadEndRoom = Room
+deadEndRoom = defaultRoom
     { _rmPolys = [rectNSWE 40 (-20) (-20) 20
                  ]
     , _rmLinks = lnks

src/Dodge/Room/Airlock.hs

@@ -5,6 +5,7 @@ module Dodge.Room.Airlock
     where
 import Dodge.Room.Data
 import Dodge.Room.Placement
+import Dodge.Default.Room
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.LevelGen.Switch
@@ -18,7 +19,7 @@ import Control.Monad.State
 import Control.Lens
 
 airlockOneWay :: Int -> Room
-airlockOneWay n = Room
+airlockOneWay n = defaultRoom
     { _rmPolys = [rectNSWE 90 0 0 40]
     , _rmLinks = lnks
     , _rmPath  = []
@@ -49,7 +50,7 @@ Straight airlock -}
 airlock0 
     :: Int -- ^ Door id
     -> Room
-airlock0 n = Room
+airlock0 n = defaultRoom
     { _rmPolys =
         [ rectNSWE 100 0 0 40
         , rectNSWE 65 35 (-40) 20
@@ -78,7 +79,7 @@ airlock0 n = Room
 airlock90 
     :: Int -- ^ Door id
     -> Room
-airlock90 n = Room
+airlock90 n = defaultRoom
     { _rmPolys =
         [ rectNSWE 100 10 10 100
         , rectNSWE 20  0  20 60
@@ -120,7 +121,7 @@ airlock90 n = Room
 airlockCrystal
     :: Int -- ^ Door id
     -> Room
-airlockCrystal n = Room
+airlockCrystal n = defaultRoom
     { _rmPolys =
         [ rectNSWE 140 0 0 40
         , orderPolygon

src/Dodge/Room/Boss.hs

@@ -4,6 +4,7 @@ Rooms containing particularly challenging creatures, that may drop useful loot.
 module Dodge.Room.Boss
   where
 import Dodge.Data
+import Dodge.Default.Room
 import Dodge.Room.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Placement
@@ -23,7 +24,7 @@ import System.Random
 roomGlassOctogon
     :: Float    -- ^ Size
     -> Room
-roomGlassOctogon x = Room
+roomGlassOctogon x = defaultRoom
     { _rmPolys = [rectNSWE x (-x) (-x) x
                  ,rectNSWE 0 (-(x + 40)) (-20) 20
                  ]
@@ -74,7 +75,7 @@ roomCross
     :: Float -- ^ First width/2
     -> Float -- ^ Second width/2
     -> Room
-roomCross x y = Room
+roomCross x y = defaultRoom
     { _rmPolys = [rectNSWE y (-y) (-x) x
                  ,rectNSWE (-x) x y (-y)
                  ]
@@ -112,7 +113,7 @@ roomShuriken x y =
             , (x,y)
             , (0,x)
             ]   ]
-        corner = Room
+        corner = defaultRoom
             { _rmPolys  = ps
             , _rmLinks  = [((x-1,y-20),negate $ pi/2)]
             , _rmPath   = []
@@ -136,7 +137,7 @@ roomTwistCross x y z =
                 ]   
             , rectNSWE (x-5) 0 0 (x-5)
             ]
-        corner = Room
+        corner = defaultRoom
             { _rmPolys  = ps
             , _rmLinks  = [((z,y-20), pi/2)]
             , _rmPath   = []

src/Dodge/Room/Corridor.hs

@@ -1,11 +1,12 @@
 module Dodge.Room.Corridor
     where
 import Dodge.Room.Data
+import Dodge.Default.Room
 import Geometry
 {- | First exit due north, two other exits at angles next to this.
  Entrance from south.  -}
 corridor :: Room
-corridor = Room
+corridor = defaultRoom
     { _rmPolys = [rectNSWE 80 0 0 40
     --{ _rmPolys = [rectNSWE 90 (-10) 0 40
 --                 ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
@@ -25,7 +26,7 @@ corridor = Room
         ]
 {- | Debug drop-in copy of corridor  -}
 corridorDebug :: Room
-corridorDebug = Room
+corridorDebug = defaultRoom
     { _rmPolys = 
         [   rectNSWE 80 0 0 40
         --,   [ (0,0), (0,200) , (200,100)]
@@ -44,7 +45,7 @@ corridorDebug = Room
         ,((20,10)    ,pi)
         ]
 corridorN :: Room
-corridorN = Room
+corridorN = defaultRoom
     { _rmPolys = [rectNSWE 80 0 0 40
                  ]
     , _rmLinks = lnks
@@ -58,7 +59,7 @@ corridorN = Room
           pth = doublePair ((20,70),(20,10))
 
 tEast :: Room
-tEast = Room
+tEast = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]
@@ -72,7 +73,7 @@ tEast = Room
                  ,((0,10),pi)
                  ]
 tWest :: Room
-tWest = Room
+tWest = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]

src/Dodge/Room/Data.hs

@@ -3,7 +3,9 @@
 module Dodge.Room.Data
   where
 import Dodge.LevelGen.Data
-import Geometry
+--import Geometry
+import Geometry.Data
+import Data.Tile
 
 import Control.Lens
 
@@ -22,5 +24,6 @@ data Room = Room
     , _rmPath :: [(Point2, Point2)]
     , _rmPS :: [Placement]
     , _rmBound :: [ [Point2] ]
+    , _rmFloor :: [Tile]
     }
 makeLenses ''Room

src/Dodge/Room/Door.hs

@@ -6,12 +6,13 @@ module Dodge.Room.Door
 import Geometry
 import Dodge.Room.Data
 import Dodge.LevelGen.Data
+import Dodge.Default.Room
 
 --import Control.Monad.State
 --import System.Random
 
 door :: Room
-door = Room
+door = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
     , _rmLinks = lnks
     , _rmPath  = [((20,35),(20,5))]

src/Dodge/Room/Link.hs

@@ -12,6 +12,8 @@ import Dodge.LevelGen.Data
 import Dodge.Room.Data
 import Dodge.RandomHelp
 import Geometry
+import Geometry.Data
+import Data.Tile
 
 import System.Random
 import Control.Monad.State
@@ -64,13 +66,18 @@ shiftRoomToLink l r
     (p,a) = last $ _rmLinks r
 
 shiftRoomBy :: (Point2,Float) -> Room -> Room
-shiftRoomBy shift r = 
+shiftRoomBy shift r = r
-   over rmPolys (fmap (map (shiftPointBy shift)))
+    & rmPolys %~ fmap (map (shiftPointBy shift))
-   $ over rmLinks (fmap (shiftLinkBy shift))
+    & rmLinks %~ fmap (shiftLinkBy shift)
-   $ over rmPath (map (shiftPathPointBy shift))
+    & rmPath  %~ map (shiftPathPointBy shift)
-   $ over rmPS (fmap (shiftPSBy shift))
+    & rmPS    %~ fmap (shiftPSBy shift)
-   $ over rmBound (fmap (map (shiftPointBy shift)))
+    & rmBound %~ fmap (map (shiftPointBy shift))
-   r
+    & rmFloor %~ map 
+        ( (tilePoly %~ map (shiftPointBy shift))
+        . (tileCenter %~ shiftPointBy shift    )
+        . (tileX %~ shiftPointBy shift         )
+        . (tileY %~ shiftPointBy shift         )
+        )
 
 shiftLinkBy 
     :: (Point2,Float) 

src/Dodge/Room/LongDoor.hs

@@ -4,6 +4,7 @@
 module Dodge.Room.LongDoor
     where
 import Dodge.Data
+import Dodge.Default.Room
 import Dodge.Room.Data
 import Dodge.Room.Placement
 import Dodge.Room.Link
@@ -29,7 +30,7 @@ twinSlowDoorRoom
     -> Float    -- ^ Half height
     -> Float    -- ^ Inner width
     -> Room
-twinSlowDoorRoom drID w h x = Room
+twinSlowDoorRoom drID w h x = defaultRoom
     { _rmPolys  = ps
     , _rmLinks  =
         [ ((w,h/2) , negate $ pi/2)

src/Dodge/Room/Procedural.hs

@@ -11,6 +11,7 @@ import Dodge.Data
 import Dodge.Room.Data
 import Dodge.Room.Placement
 import Dodge.Room.Link
+import Dodge.Default.Room
 import Dodge.Item.Consumable
 import Dodge.Item.Equipment
 import Dodge.Item.Weapon
@@ -21,6 +22,7 @@ import Dodge.Creature
 --import Dodge.Default
 import Geometry
 import Picture
+import Data.Tile
 
 import Data.List
 import Data.Function (on)
@@ -40,12 +42,19 @@ roomRect
     -> Int      -- ^ Number of links on vertical walls
     -> Int      -- ^ Number of links on horizontal walls
     -> Room
-roomRect x y xn yn = Room
+roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
     , _rmPS    = [sPS (x/2,y/2) 0 putLamp]
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
+    , _rmFloor = [Tile 
+            { _tilePoly = rectNSWE y 0 0 x
+            , _tileCenter = (0,0)
+            , _tileX = (50,0)
+            , _tileY = (0,50)
+            , _tileZ = 16
+            } ]
     }
   where 
     yd = (y - 40) / fromIntegral yn
@@ -88,7 +97,7 @@ linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
 {- Combines two rooms into one room.
 Combines into one big bound, concatenates the rest.  -}
 combineRooms :: Room -> Room -> Room
-combineRooms r r' = Room
+combineRooms r r' = defaultRoom
     { _rmPolys = _rmPolys r ++ _rmPolys r'
     , _rmLinks = _rmLinks r ++ _rmLinks r'
     , _rmPath  = _rmPath  r ++ _rmPath  r'
@@ -130,7 +139,7 @@ fourthWall w = do
             , blockLine (-29,w) (0,w/2)
             ]
         ]
-    pure $ Room
+    pure $ defaultRoom
         { _rmPolys  = [ [(0,0),(w,w),(-w,w)] ]
         , _rmLinks  = [((0,w), 0)]
         , _rmPath   = [((0,w),(0,0)),((0,0),(0,w))]
@@ -175,7 +184,7 @@ fourthCornerWall w = do
             , blockLine (0,w) (0,w*2)
             ]
         ]
-    pure $ Room
+    pure $ defaultRoom
         { _rmPolys  = [ [(0,0),(w,w),(0,2*w),(-w,w)] ]
         , _rmLinks  = 
             [((w/2,3*w/2), negate $ pi/4)
@@ -233,7 +242,7 @@ centerVaultRoom n w h d = do
         weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) 
         centerPoly = rectWdthHght (d - 20) (d - 20)
         polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
-    return $ Room
+    return $ defaultRoom
         { _rmPolys  = polys
         , _rmLinks  = 
             [((0,h),0)

src/Dodge/Room/RoadBlock.hs

@@ -4,6 +4,7 @@ Connecting rooms designed with a pass-through technique in mind.
 module Dodge.Room.RoadBlock
     where
 import Geometry
+import Dodge.Default.Room
 import Dodge.Room.Data
 import Dodge.Room.Link
 import Dodge.Room.Placement
@@ -29,7 +30,7 @@ litCorridor90 = do
     h <- state $ randomR (500,800)
     let poly = rectNSWE h 0 0 40
         poly2 = rectNSWE (h-60) (h-100) (-60) 5
-    pure $ Room
+    pure $ defaultRoom
         { _rmPolys = [poly,poly2]
         , _rmLinks = [ ((40,h - 80), -pi/2)
                      , ((20,     0), pi)

src/Dodge/Room/Treasure.hs

@@ -4,11 +4,12 @@ Typically dead ends.
 -}
 module Dodge.Room.Treasure
     where
-import Geometry
 import Dodge.Data
 import Dodge.Room.Data
 import Dodge.Room.Placement
+import Dodge.Default.Room
 import Dodge.LevelGen.Data
+import Geometry
 
 --import Data.List
 import Control.Monad.State
@@ -21,7 +22,7 @@ triLootRoom
     :: Float    -- Width
     -> Float    -- Height
     -> State g Room
-triLootRoom w h = pure $ Room
+triLootRoom w h = pure $ defaultRoom
     { _rmPolys  = [ tri
                   , base
                     ]

src/Geometry.hs

@@ -10,7 +10,7 @@ Line refers to a line defined by two points, and extends beyond the two points.
 -}
 module Geometry
     ( module Geometry
-    , module Geometry.Data
+--    , module Geometry.Data
     , module Geometry.Intersect
     , module Geometry.Bezier
     , module Geometry.Vector
@@ -225,6 +225,13 @@ polysOverlap _ _ = False
 -- a second list.
 anyPolyssIntersect :: [[Point2]] -> [[Point2]] -> Bool
 anyPolyssIntersect x y = or $ polysIntersect <$> x <*> y
+
+-- split a list into triples, forms triangles from a polygon
+polyToTris :: [s] -> [s]
+{-# INLINE polyToTris #-}
+polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
+polyToTris _ = []
+
 -- | Return n equidistant points on a circle with a radius of 600.
 nRays :: Int -> [Point2]
 nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (600,0)

src/Geometry/Vector.hs

@@ -149,4 +149,8 @@ projV
     :: Point2
     -> Point2
     -> Point2
-projV fromv onv = (fromv `dotV` onv) / (onv `dotV` onv) *.* onv
+projV fromv onv 
+    | den == 0  = error "tried projecting onto zero vector"
+    | otherwise = (fromv `dotV` onv) / den *.* onv
+  where
+    den = onv `dotV` onv

src/MatrixHelper.hs

@@ -2,7 +2,8 @@ module MatrixHelper
     ( perspectiveMatrix
     , isoMatrix
     ) where
-import Geometry
+--import Geometry
+import Geometry.Data
 
 import Linear.Matrix
 import Linear.V4

src/Picture.hs

@@ -46,7 +46,7 @@ module Picture
     )
   where
 import Geometry
---import Geometry.Data
+import Geometry.Data
 import Picture.Data
 
 --import Data.Bifunctor

src/Picture/Render.hs

@@ -4,14 +4,14 @@ Rendering of a picture.
 -}
 module Picture.Render
     where
-
 import Shader
 import Shader.Data
 import Shader.Poke
 --import MatrixHelper
 import Data.Preload.Render
 import Picture.Data
-import Geometry
+--import Geometry
+import Geometry.Data
 
 --import Control.Lens
 import Control.Monad

src/Picture/Texture.hs

@@ -1,7 +1,9 @@
 module Picture.Texture
     where
 import Geometry.Data
+--import Geometry
 import Picture.Data
+--import Data.Tile
 
 tileToRender :: [Point3] -> [Point3] -> [RenderType]
 tileToRender [a,b,c,d] [x,y,z,w] = 
@@ -13,3 +15,4 @@ tileToRender [a,b,c,d] [x,y,z,w] =
     , Render3x3 (w,d)
     ]
 tileToRender _ _ = undefined
+

src/Picture/Tree.hs

@@ -5,6 +5,7 @@ module Picture.Tree
     where
 import Picture.Data
 import Geometry
+import Geometry.Data
 
 import Data.Bifunctor
 import Data.List
@@ -68,11 +69,6 @@ white, black :: Color
 white = (1,1,1,1)
 black = (0,0,0,1)
 
-polyToTris :: [s] -> [s]
-{-# INLINE polyToTris #-}
-polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
-polyToTris _ = []
-
 scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3)
 {-# INLINE scaleT #-}
 scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))

src/Shader/AuxAddition.hs

@@ -37,7 +37,7 @@ addTextureArray texturePath shad = do
     let tex = convertRGBA8 cmap
     textureOb <- genObjectName
     textureBinding Texture2DArray $= Just textureOb
-    let texData = tilesToLine 128 32 8 . 
+    let texData = tilesToLine 128 8 . 
             V.toList $ imageData tex
         --wtex = fromIntegral $ imageWidth  tex
         --htex = fromIntegral $ imageHeight tex
@@ -50,12 +50,11 @@ addTextureArray texturePath shad = do
 
 -- I am completely unclear on why this works with its current parameters
 tilesToLine 
-    :: Int -- ^ Tile width
+    :: Int -- ^ Parameter a
-    -> Int -- ^ Tile height
+    -> Int -- ^ Parameter b
-    -> Int -- ^ Number of tiles per line
     -> [a]
     -> [a]
-tilesToLine w h n = concat . concat . transpose . chunksOf n . chunksOf w
+tilesToLine w n = concat . concat . transpose . chunksOf n . chunksOf w
 
 addUniforms :: [String] -> FullShader -> IO (FullShader)
 addUniforms uniStrings shad = do

src/Tile.hs

@@ -0,0 +1,31 @@
+module Tile
+    where
+import Data.Tile
+import Geometry
+import Geometry.Data
+import Picture.Data
+
+tToRender :: Tile -> [RenderType]
+tToRender t = map Render3x3 $ polyToTris $ zip ps3 coords3
+  where
+    ps = _tilePoly t
+    coords = map (calcTexCoord (_tileCenter t) (_tileX t) (_tileY t)) ps
+    ps3 = map (mkTrip (0.9)) ps
+    coords3 = map (mkTrip (_tileZ t)) coords
+
+mkTrip :: c -> (a,b) -> (a,b,c)
+mkTrip z (x,y) = (x,y,z)
+
+calcTexCoord
+    :: Point2   -- ^ tile (0,0)
+    -> Point2   -- ^ tile (1,0)
+    -> Point2   -- ^ tile (0,1)
+    -> Point2   -- ^ world point
+    -> Point2
+calcTexCoord cen x' y' p = 
+    ( magV (projV (p -.- cen) x) / magV x
+    , magV (projV (p -.- cen) y) / magV y
+    )
+  where
+    x = x' -.- cen
+    y = y' -.- cen