{-# OPTIONS_HADDOCK hide #-}
{- | 
This FunGEn module contains the map (game background) routines.
-}
{- 

FunGEN - Functional Game Engine
http://www.cin.ufpe.br/~haskell/fungen
Copyright (C) 2002  Andre Furtado <awbf@cin.ufpe.br>

This code is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

-}

module Graphics.UI.Fungen.Map (
  GameMap, Tile, TileMatrix,
  -- ** creating

  colorMap, textureMap, tileMap, multiMap,
  -- ** map attributes

  isTileMap, isMultiMap, getMapSize, getTileMapTileMatrix, getTileMapScroll, getTileMapSize, getTileMapTileSize,
  -- ** map tiles

  getTilePictureIndex, getTileBlocked, getTileMoveCost, getTileSpecialAttribute,
  -- ** setting the current map

  getCurrentMap, updateCurrentMap, updateCurrentIndex,
  -- ** drawing

  drawGameMap, clearGameScreen,
) where

import Graphics.UI.Fungen.Types
import Graphics.UI.Fungen.Util
import Graphics.Rendering.OpenGL

type Tile t = (Int,Bool,Float,t) -- ^ index of picture, possibility to move, cost to move, additional params

type TileMatrix t = [[(Tile t)]]
type TileLine t = [(Tile t)]

-- | A game background (flat color, scrollable texture, or tile map), or several of them.

data GameMap t
        = ColorMap (Color4 GLclampf) Point2D -- ^ color of the map, size of the map

        | TextureMap Int Point2D Point2D Point2D Point2D  -- ^ texture id, size of texture, present scroll (visible window bottom & left), scroll speed (X,Y),size of the map

        | TileMap (TileMatrix t)  Point2D Point2D Point2D Point2D  -- ^ texture handles, tiles matrix, size of tile, present scroll (visible window bottom & left), scroll speed (X,Y), size of the map

        | MultiMap [(GameMap t)] Int -- ^ list of maps, current map

--      | PolygMap [Primitive]


getMapSize :: GameMap t -> Point2D
getMapSize :: GameMap t -> Point2D
getMapSize (ColorMap Color4 GLclampf
_ Point2D
s) = Point2D
s
getMapSize (TextureMap Int
_ Point2D
_ Point2D
_ Point2D
_ Point2D
s) = Point2D
s
getMapSize (TileMap TileMatrix t
_ Point2D
_ Point2D
_ Point2D
_ Point2D
s) = Point2D
s
getMapSize (MultiMap [GameMap t]
_ Int
_) = [Char] -> Point2D
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.getMapSize error: getMapSize cannot be applied with MultiMaps!"

----------------------------

-- * special TileMap routines

----------------------------


isTileMap ::  GameMap t -> Bool
isTileMap :: GameMap t -> Bool
isTileMap (TileMap TileMatrix t
_ Point2D
_ Point2D
_ Point2D
_ Point2D
_) = Bool
True
isTileMap GameMap t
_ = Bool
False

getTileMapTileMatrix :: GameMap t -> TileMatrix t
getTileMapTileMatrix :: GameMap t -> TileMatrix t
getTileMapTileMatrix (TileMap TileMatrix t
m Point2D
_ Point2D
_ Point2D
_ Point2D
_) = TileMatrix t
m
getTileMapTileMatrix GameMap t
_ = [Char] -> TileMatrix t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.getTileMapTileMatrix error: game map is not a tile map!"

getTileMapTileSize :: GameMap t -> Point2D
getTileMapTileSize :: GameMap t -> Point2D
getTileMapTileSize (TileMap TileMatrix t
_ Point2D
ts Point2D
_ Point2D
_ Point2D
_) = Point2D
ts
getTileMapTileSize GameMap t
_ = [Char] -> Point2D
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.getTileMapTileSize error: game map is not a tile map!"

getTileMapScroll :: GameMap t -> Point2D
getTileMapScroll :: GameMap t -> Point2D
getTileMapScroll (TileMap TileMatrix t
_ Point2D
_ Point2D
s Point2D
_ Point2D
_) = Point2D
s
getTileMapScroll GameMap t
_ = [Char] -> Point2D
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.getTileMapScroll error: game map is not a tile map!"

getTileMapSize :: GameMap t -> Point2D
getTileMapSize :: GameMap t -> Point2D
getTileMapSize (TileMap TileMatrix t
_ Point2D
_ Point2D
_ Point2D
_ Point2D
s) = Point2D
s
getTileMapSize GameMap t
_ = [Char] -> Point2D
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.getTileMapSize error: game map is not a tile map!"


------------------------------

-- * get routines for a Tile

------------------------------


getTilePictureIndex :: Tile t -> Int
getTilePictureIndex :: Tile t -> Int
getTilePictureIndex (Int
i,Bool
_,GLclampf
_,t
_) = Int
i

getTileBlocked :: Tile t -> Bool
getTileBlocked :: Tile t -> Bool
getTileBlocked (Int
_,Bool
b,GLclampf
_,t
_) = Bool
b

getTileMoveCost :: Tile t -> Float
getTileMoveCost :: Tile t -> GLclampf
getTileMoveCost (Int
_,Bool
_,GLclampf
m,t
_) = GLclampf
m

getTileSpecialAttribute:: Tile t -> t
getTileSpecialAttribute :: Tile t -> t
getTileSpecialAttribute (Int
_,Bool
_,GLclampf
_,t
t) = t
t


-------------------------------

-- * get routines for a MultiMap

-------------------------------


getCurrentMap :: GameMap t -> GameMap t
getCurrentMap :: GameMap t -> GameMap t
getCurrentMap (MultiMap [GameMap t]
l Int
i) = ([GameMap t]
l [GameMap t] -> Int -> GameMap t
forall a. [a] -> Int -> a
!! Int
i)
getCurrentMap GameMap t
_ = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.getCurrentMap error: getCurrentMap can only be applied with MultiMaps!"

updateCurrentMap :: GameMap t -> GameMap t -> GameMap t
updateCurrentMap :: GameMap t -> GameMap t -> GameMap t
updateCurrentMap (MultiMap [GameMap t]
l Int
i) GameMap t
newMap = [GameMap t] -> Int -> GameMap t
forall t. [GameMap t] -> Int -> GameMap t
MultiMap ([GameMap t] -> GameMap t -> Int -> [GameMap t]
forall t. [GameMap t] -> GameMap t -> Int -> [GameMap t]
newMapList [GameMap t]
l GameMap t
newMap Int
i) Int
i
updateCurrentMap GameMap t
_ GameMap t
_ = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.updateCurrentMap error: updateCurrentMap can only be applied with MultiMaps!"

-- internal use only!

newMapList :: [(GameMap t)] -> GameMap t -> Int -> [(GameMap t)]
newMapList :: [GameMap t] -> GameMap t -> Int -> [GameMap t]
newMapList [] GameMap t
_ Int
_ = [Char] -> [GameMap t]
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.newMapList error: please report this bug to awbf@uol.com.br"
newMapList (GameMap t
_:[GameMap t]
ms) GameMap t
newMap Int
0 = GameMap t
newMapGameMap t -> [GameMap t] -> [GameMap t]
forall a. a -> [a] -> [a]
:[GameMap t]
ms
newMapList (GameMap t
m:[GameMap t]
ms) GameMap t
newMap Int
n = GameMap t
mGameMap t -> [GameMap t] -> [GameMap t]
forall a. a -> [a] -> [a]
:([GameMap t] -> GameMap t -> Int -> [GameMap t]
forall t. [GameMap t] -> GameMap t -> Int -> [GameMap t]
newMapList [GameMap t]
ms GameMap t
newMap (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

isMultiMap :: GameMap t -> Bool
isMultiMap :: GameMap t -> Bool
isMultiMap (MultiMap [GameMap t]
_ Int
_) = Bool
True
isMultiMap GameMap t
_ = Bool
False

updateCurrentIndex :: GameMap t -> Int -> GameMap t
updateCurrentIndex :: GameMap t -> Int -> GameMap t
updateCurrentIndex (MultiMap [GameMap t]
mapList Int
_) Int
i | (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ([GameMap t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GameMap t]
mapList)) = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.updateMultiMapIndex error: map index out of range!"
                                          | Bool
otherwise = ([GameMap t] -> Int -> GameMap t
forall t. [GameMap t] -> Int -> GameMap t
MultiMap [GameMap t]
mapList Int
i)
updateCurrentIndex GameMap t
_ Int
_ = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.updateCurrentIndex error: the game map is not a MultiMap!"

-----------------------------

-- * creation of maps

-----------------------------


-- | creates a PreColorMap

colorMap :: GLclampf -> GLclampf -> GLclampf -> GLdouble -> GLdouble -> GameMap t
colorMap :: GLclampf
-> GLclampf -> GLclampf -> GLdouble -> GLdouble -> GameMap t
colorMap GLclampf
r GLclampf
g GLclampf
b GLdouble
sX GLdouble
sY = Color4 GLclampf -> Point2D -> GameMap t
forall t. Color4 GLclampf -> Point2D -> GameMap t
ColorMap (GLclampf -> GLclampf -> GLclampf -> GLclampf -> Color4 GLclampf
forall a. a -> a -> a -> a -> Color4 a
Color4 GLclampf
r GLclampf
g GLclampf
b GLclampf
1.0) (GLdouble
sX,GLdouble
sY)

-- | creates a PreTextureMap

textureMap :: Int -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameMap t
textureMap :: Int -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GameMap t
textureMap Int
texId GLdouble
tX GLdouble
tY GLdouble
sX GLdouble
sY = Int -> Point2D -> Point2D -> Point2D -> Point2D -> GameMap t
forall t.
Int -> Point2D -> Point2D -> Point2D -> Point2D -> GameMap t
TextureMap Int
texId (GLdouble
tX,GLdouble
tY) (GLdouble
0,GLdouble
0) (GLdouble
0,GLdouble
0) (GLdouble
sX,GLdouble
sY)

-- | creates a PreTileMap, cheking if the tileMatrix given is valid and automatically defining the map size

tileMap :: TileMatrix t -> GLdouble -> GLdouble -> GameMap t
tileMap :: TileMatrix t -> GLdouble -> GLdouble -> GameMap t
tileMap TileMatrix t
matrix GLdouble
tX GLdouble
tY | TileMatrix t -> Bool
forall t. TileMatrix t -> Bool
matrixOk TileMatrix t
matrix = TileMatrix t
-> Point2D -> Point2D -> Point2D -> Point2D -> GameMap t
forall t.
TileMatrix t
-> Point2D -> Point2D -> Point2D -> Point2D -> GameMap t
TileMap TileMatrix t
matrix (GLdouble
tX,GLdouble
tY) (GLdouble
0,GLdouble
0) (GLdouble
0,GLdouble
0) (GLdouble
sX,GLdouble
sY)
                     | Bool
otherwise = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.tileMap error: each line of your TileMap must have the same number of tiles!"
                   where sX :: GLdouble
sX = ((Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> GLdouble)
-> (TileMatrix t -> Int) -> TileMatrix t -> GLdouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Tile t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length([Tile t] -> Int)
-> (TileMatrix t -> [Tile t]) -> TileMatrix t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TileMatrix t -> [Tile t]
forall a. [a] -> a
head) TileMatrix t
matrix) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
* GLdouble
tX
                         sY :: GLdouble
sY = ((Int -> GLdouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> GLdouble)
-> (TileMatrix t -> Int) -> TileMatrix t -> GLdouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TileMatrix t -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) TileMatrix t
matrix) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
* GLdouble
tY

-- | creates a multimap

multiMap :: [(GameMap t)] -> Int -> GameMap t
multiMap :: [GameMap t] -> Int -> GameMap t
multiMap [] Int
_ = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.multiMap  error: the MultiMap map list should not be empty!"
multiMap [GameMap t]
mapList Int
currentMap | (Int
currentMap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ([GameMap t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GameMap t]
mapList)) = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.multiMap error: map index out of range!"
                            | ([GameMap t] -> Bool
forall t. [GameMap t] -> Bool
mapListContainsMultiMap [GameMap t]
mapList) = [Char] -> GameMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.multiMap error: a MultiMap should not contain another MultiMap!"
                            | Bool
otherwise = [GameMap t] -> Int -> GameMap t
forall t. [GameMap t] -> Int -> GameMap t
MultiMap [GameMap t]
mapList Int
currentMap

-- checks if a GameMap list contains a multimap (internal use only!)

mapListContainsMultiMap :: [(GameMap t)] -> Bool
mapListContainsMultiMap :: [GameMap t] -> Bool
mapListContainsMultiMap [] = Bool
False
mapListContainsMultiMap (GameMap t
a:[GameMap t]
as) | (GameMap t -> Bool
forall t. GameMap t -> Bool
isMultiMap GameMap t
a) = Bool
True
                               | Bool
otherwise = [GameMap t] -> Bool
forall t. [GameMap t] -> Bool
mapListContainsMultiMap [GameMap t]
as

-- checks if the tile matrix is a square matrix

matrixOk :: TileMatrix t -> Bool
matrixOk :: TileMatrix t -> Bool
matrixOk [] = Bool
False
matrixOk ([Tile t]
m:TileMatrix t
ms) = Int -> TileMatrix t -> Bool
forall t. Int -> TileMatrix t -> Bool
matrixOkAux ([Tile t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tile t]
m) TileMatrix t
ms

matrixOkAux :: Int -> TileMatrix t -> Bool
matrixOkAux :: Int -> TileMatrix t -> Bool
matrixOkAux Int
_ [] = Bool
True
matrixOkAux Int
s ([Tile t]
m:TileMatrix t
ms) | ([Tile t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tile t]
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s = Int -> TileMatrix t -> Bool
forall t. Int -> TileMatrix t -> Bool
matrixOkAux Int
s TileMatrix t
ms
                     | Bool
otherwise = Bool
False


----------------------------------------

-- * map drawing

----------------------------------------


-- | clear the screen

clearGameScreen :: GLclampf -> GLclampf -> GLclampf -> IO ()
clearGameScreen :: GLclampf -> GLclampf -> GLclampf -> IO ()
clearGameScreen GLclampf
r GLclampf
g GLclampf
b = do
        StateVar (Color4 GLclampf)
clearColor StateVar (Color4 GLclampf) -> Color4 GLclampf -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (GLclampf -> GLclampf -> GLclampf -> GLclampf -> Color4 GLclampf
forall a. a -> a -> a -> a -> Color4 a
Color4 GLclampf
r GLclampf
g GLclampf
b GLclampf
1.0)
        [ClearBuffer] -> IO ()
clear [ClearBuffer
ColorBuffer]

-- | draw the background map

drawGameMap :: GameMap t -> Point2D -> [TextureObject] -> IO ()
drawGameMap :: GameMap t -> Point2D -> [TextureObject] -> IO ()
drawGameMap (ColorMap Color4 GLclampf
c Point2D
_) Point2D
_ [TextureObject]
_ = do
        StateVar (Color4 GLclampf)
clearColor StateVar (Color4 GLclampf) -> Color4 GLclampf -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Color4 GLclampf
c
        [ClearBuffer] -> IO ()
clear [ClearBuffer
ColorBuffer]
        StateVar (Color4 GLclampf)
clearColor StateVar (Color4 GLclampf) -> Color4 GLclampf -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (GLclampf -> GLclampf -> GLclampf -> GLclampf -> Color4 GLclampf
forall a. a -> a -> a -> a -> Color4 a
Color4 GLclampf
0 GLclampf
0 GLclampf
0 GLclampf
0) -- performance drawback?

drawGameMap (TextureMap Int
texId (GLdouble
tX,GLdouble
tY) (GLdouble
vX,GLdouble
vY) Point2D
_ Point2D
_) Point2D
winSize [TextureObject]
texList = do
        TextureTarget2D -> StateVar Capability
forall t. ParameterizedTextureTarget t => t -> StateVar Capability
texture TextureTarget2D
Texture2D StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Enabled
        TextureTarget2D -> TextureObject -> IO ()
bindTexture TextureTarget2D
Texture2D ([TextureObject]
texList [TextureObject] -> Int -> TextureObject
forall a. [a] -> Int -> a
!! Int
texId)
        Point2D
-> Point2D -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTextureMap (GLdouble
tX,GLdouble
tY) (GLdouble
new_winX, GLdouble
new_winY) Point2D
winSize GLdouble
new_winY [TextureObject]
texList
        TextureTarget2D -> StateVar Capability
forall t. ParameterizedTextureTarget t => t -> StateVar Capability
texture TextureTarget2D
Texture2D StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Disabled
        where new_winX :: GLdouble
new_winX | (GLdouble
vX GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
>= GLdouble
0) = - GLdouble
vX
                       | Bool
otherwise = - GLdouble
vX GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- GLdouble
tX
              new_winY :: GLdouble
new_winY | (GLdouble
vY GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
>= GLdouble
0) = - GLdouble
vY
                       | Bool
otherwise = - GLdouble
vY GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- GLdouble
tY
drawGameMap (TileMap TileMatrix t
matrix Point2D
size Point2D
visible Point2D
_ Point2D
_) Point2D
winSize [TextureObject]
texList = do
        TextureTarget2D -> StateVar Capability
forall t. ParameterizedTextureTarget t => t -> StateVar Capability
texture TextureTarget2D
Texture2D StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Enabled
        TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
forall t.
TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMap (TileMatrix t -> TileMatrix t
forall a. [a] -> [a]
reverse TileMatrix t
matrix) Point2D
size Point2D
visible Point2D
winSize GLdouble
0.0 [TextureObject]
texList
        TextureTarget2D -> StateVar Capability
forall t. ParameterizedTextureTarget t => t -> StateVar Capability
texture TextureTarget2D
Texture2D StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Disabled
drawGameMap (MultiMap [GameMap t]
_ Int
_) Point2D
_ [TextureObject]
_ = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Map.drawGameMap error: drawGameMap cannot be applied with MultiMaps!"

-- size of texture, drawing position relative to (X,Y) axis of window, lowest Y drawing position

drawTextureMap :: Point2D -> Point2D -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTextureMap :: Point2D
-> Point2D -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTextureMap (GLdouble
tX,GLdouble
tY) (GLdouble
winX,GLdouble
winY) (GLdouble
winWidth,GLdouble
winHeight) GLdouble
baseY [TextureObject]
texList
        | (GLdouble
winY GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
> GLdouble
winHeight) = Point2D
-> Point2D -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTextureMap (GLdouble
tX,GLdouble
tY) (GLdouble
winX GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
tX, GLdouble
baseY) (GLdouble
winWidth,GLdouble
winHeight) GLdouble
baseY [TextureObject]
texList
        | (GLdouble
winX GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
> GLdouble
winWidth) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
                IO ()
loadIdentity
                Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
winX GLdouble
winY (GLdouble
0 :: GLdouble) )
                Color3 GLclampf -> IO ()
forall a. Color a => a -> IO ()
color (GLclampf -> GLclampf -> GLclampf -> Color3 GLclampf
forall a. a -> a -> a -> Color3 a
Color3 GLclampf
1.0 GLclampf
1.0 GLclampf
1.0 :: Color3 GLfloat)
                PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Quads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
0.0 (GLdouble
0.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0.0 GLdouble
0.0 (GLdouble
0.0 :: GLdouble)
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
1.0 (GLdouble
0.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3  GLdouble
tX GLdouble
0.0 (GLdouble
0.0 :: GLdouble)
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
1.0 (GLdouble
1.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3  GLdouble
tX  GLdouble
tY (GLdouble
0.0 :: GLdouble)
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
0.0 (GLdouble
1.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0.0  GLdouble
tY (GLdouble
0.0 :: GLdouble)
                Point2D
-> Point2D -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTextureMap (GLdouble
tX,GLdouble
tY) (GLdouble
winX,GLdouble
winY GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
tY) (GLdouble
winWidth,GLdouble
winHeight) GLdouble
baseY [TextureObject]
texList
                
-- textures handles, tile matrix, size of texture, (X,Y) scroll, drawing position relative to Y axis of window

drawTileMap :: TileMatrix t -> Point2D -> Point2D -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTileMap :: TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMap [] Point2D
_ Point2D
_ Point2D
_ GLdouble
_ [TextureObject]
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no more tile lines to drawn, so we're done here!

drawTileMap ([Tile t]
a:TileMatrix t
as) (GLdouble
tX,GLdouble
tY) (GLdouble
sX,GLdouble
sY) (GLdouble
winWidth,GLdouble
winHeight) GLdouble
winY [TextureObject]
texList
        | (GLdouble
sY GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
>= GLdouble
tY) = TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
forall t.
TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMap TileMatrix t
as (GLdouble
tX,GLdouble
tY) (GLdouble
sX,GLdouble
sYGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
-GLdouble
tY) (GLdouble
winWidth,GLdouble
winHeight) GLdouble
winY [TextureObject]
texList -- scrolls in the Y axis

        | (GLdouble
winY GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
> GLdouble
winHeight) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- drawing position is higher than the Y window coordinate

        | Bool
otherwise = do
                [Tile t]
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
forall t.
TileLine t
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMapLine [Tile t]
a (GLdouble
tX,GLdouble
tY) GLdouble
sX (GLdouble
0.0,GLdouble
winYGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
-GLdouble
sY) GLdouble
winWidth [TextureObject]
texList
                TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
forall t.
TileMatrix t
-> Point2D
-> Point2D
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMap TileMatrix t
as (GLdouble
tX,GLdouble
tY) (GLdouble
sX,GLdouble
sY) (GLdouble
winWidth,GLdouble
winHeight) (GLdouble
winY GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- GLdouble
sY GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
tY) [TextureObject]
texList

-- textures handles, tile line, size of texture, X scroll, drawing position relative to (X,Y) axis of window            

drawTileMapLine :: TileLine t -> Point2D -> GLdouble -> Point2D -> GLdouble -> [TextureObject] -> IO ()
drawTileMapLine :: TileLine t
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMapLine [] Point2D
_ GLdouble
_ Point2D
_ GLdouble
_ [TextureObject]
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no more tiles to drawn, so we're done here!

drawTileMapLine (Tile t
a:TileLine t
as) (GLdouble
tX,GLdouble
tY) GLdouble
sX (GLdouble
winX,GLdouble
winY) GLdouble
winWidth [TextureObject]
texList
        | (GLdouble
sX GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
>= GLdouble
tX) = TileLine t
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
forall t.
TileLine t
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMapLine TileLine t
as (GLdouble
tX,GLdouble
tY) (GLdouble
sXGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
-GLdouble
tX) (GLdouble
winX,GLdouble
winY) GLdouble
winWidth [TextureObject]
texList -- scrolls in the X axis

        | (GLdouble
winX GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
> GLdouble
winWidth) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- drawing position is higher than the X window coordinate

        | Bool
otherwise = do
                TextureTarget2D -> TextureObject -> IO ()
bindTexture TextureTarget2D
Texture2D ([TextureObject]
texList [TextureObject] -> Int -> TextureObject
forall a. [a] -> Int -> a
!! (Tile t -> Int
forall t. Tile t -> Int
getTilePictureIndex Tile t
a))
                IO ()
loadIdentity
                Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 (GLdouble
new_winX) GLdouble
winY (GLdouble
0 :: GLdouble) )
                Color3 GLclampf -> IO ()
forall a. Color a => a -> IO ()
color (GLclampf -> GLclampf -> GLclampf -> Color3 GLclampf
forall a. a -> a -> a -> Color3 a
Color3 GLclampf
1.0 GLclampf
1.0 GLclampf
1.0 :: Color3 GLfloat)
                PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Quads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
0.0 (GLdouble
0.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0.0 GLdouble
0.0 (GLdouble
0.0 :: GLdouble)
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
1.0 (GLdouble
0.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3  GLdouble
tX GLdouble
0.0 (GLdouble
0.0 :: GLdouble)
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
1.0 (GLdouble
1.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3  GLdouble
tX  GLdouble
tY (GLdouble
0.0 :: GLdouble)
                        TexCoord2 GLdouble -> IO ()
forall a. TexCoord a => a -> IO ()
texCoord (TexCoord2 GLdouble -> IO ()) -> TexCoord2 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> TexCoord2 GLdouble
forall a. a -> a -> TexCoord2 a
TexCoord2 GLdouble
0.0 (GLdouble
1.0 :: GLdouble);  Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0.0  GLdouble
tY (GLdouble
0.0 :: GLdouble)
                TileLine t
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
forall t.
TileLine t
-> Point2D
-> GLdouble
-> Point2D
-> GLdouble
-> [TextureObject]
-> IO ()
drawTileMapLine TileLine t
as (GLdouble
tX,GLdouble
tY) GLdouble
sX (GLdouble
new_winX GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
sX GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
tX,GLdouble
winY) GLdouble
winWidth [TextureObject]
texList
                where new_winX :: GLdouble
new_winX | (GLdouble
sX GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
>= GLdouble
0) = GLdouble
winX GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
sX
                               | Bool
otherwise = GLdouble
winX GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
sX