haskanoid-0.1.5.4: src/Levels.hs
-- | Level definition
--
-- This module includes the definition of the levels.
--
-- Each level has:
--
-- - Logical properties (defined in 'blockPosS').
--
-- - Multimedia properties (a background and audio file).
--
-- Together they form 'levels'.
module Levels where
import Control.Arrow((***))
import Data.List (nub)
import Physics.TwoDimensions.Dimensions
import Constants
import Resources
-- * Levels
-- ** Level specification
data LevelSpec = LevelSpec
{ blockPoss :: [Pos2D] -- ^ Block positions
, levelBg :: ImageResource -- ^ Background image
, levelMusic :: MusicResource -- ^ Background music
}
-- | Number of levels. Change this in the code to finish
-- in a different level.
numLevels :: Int
numLevels = length levels
-- * Concrete levels
levels :: [LevelSpec]
levels = [ -- Level 0
LevelSpec { blockPoss = blockPosS 0
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level0.mp3"
}
,
-- Level 1
LevelSpec { blockPoss = blockPosS 1
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level1.mp3"
}
,
-- Level 2
LevelSpec { blockPoss = blockPosS 2
, levelBg = Resource "data/level2.png"
, levelMusic = Resource "data/level2.mp3"
}
,
-- Level 3
LevelSpec { blockPoss = blockPosS 3
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level0.mp3"
}
,
-- Level 4
LevelSpec { blockPoss = blockPosS 4
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level1.mp3"
}
,
-- Level 5
LevelSpec { blockPoss = blockPosS 5
, levelBg = Resource "data/level2.png"
, levelMusic = Resource "data/level2.mp3"
}
,
-- Level 6
LevelSpec { blockPoss = blockPosS 6
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level0.mp3"
}
,
-- Level 7
LevelSpec { blockPoss = blockPosS 7
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level1.mp3"
}
,
-- Level 8
LevelSpec { blockPoss = blockPosS 8
, levelBg = Resource "data/level2.png"
, levelMusic = Resource "data/level2.mp3"
}
,
-- Level 9
LevelSpec { blockPoss = blockPosS 9
, levelBg = Resource "data/level0.png"
, levelMusic = Resource "data/level1.mp3"
}
,
-- Level 10
LevelSpec { blockPoss = blockPosS 10
, levelBg = Resource "data/level1.png"
, levelMusic = Resource "data/level1.mp3"
}
,
-- Level 11
LevelSpec { blockPoss = blockPosS 11
, levelBg = Resource "data/level2.png"
, levelMusic = Resource "data/level2.mp3"
}
,
-- Level 12
LevelSpec { blockPoss = blockPosS 12
, levelBg = Resource "data/level0.png"
, levelMusic = Resource "data/level1.mp3"
} ]
-- | Level block specification (positions)
-- Level 0
-- %%%%%%%%
-- % XXXXXXXX
-- % XXXXXXXX
-- % XXXXXXXX
-- % XXXXXXXX
blockPosS :: Int -> [Pos2D]
blockPosS 0 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns-1], y <- [0..blockRows-1]]
blockRows :: Num a => a
blockRows = 4
-- Level 1
-- %%%%%%%%
-- % XXXX
-- % XXXXX
-- % XXXXXX
-- % XXXXXX
-- % XXXXX
-- % XXXX
--
blockPosS 1 = map adjustPos allBlocks
where
allBlocks :: (Enum a, Num a, Eq a, Ord a) => [(a,a)]
allBlocks = [ (x,y) | x <- [0..blockColumns-1], y <- [0..blockRows-1]
, (x + y > 2) && (x + y < 10)
]
blockRows :: Num a => a
blockRows = 6
-- Level 2
blockPosS 2 = map adjustPos allBlocks
where
allBlocks :: (Enum a, Num a, Eq a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns - 1], y <- [0..blockRows-1]
, x /= y && (blockColumns - 1 - x) /= y]
blockRows :: Num a => a
blockRows = 4
-- Level 3
-- %%%%%%%%
-- % X X X X
-- % X X X X
-- % X X X X
-- % X X X X
blockPosS 3 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns-1], y <- [0..blockRows-1],
((even x) && (odd y) || (odd x) && (even y))]
blockRows :: Num a => a
blockRows = 4
-- Level 4
-- %%%%%%%%
-- % XXXXXXXX
-- %
-- % X X X X
-- %
-- % X X X X
-- %
-- % XXXXXXXX
blockPosS 4 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns-1], y <- [0,blockRows-1]] ++
[(x,y) | x <- [0..blockColumns-1], y <- [2], odd x] ++
[(x,y) | x <- [0..blockColumns-1], y <- [4], even x]
blockRows :: Num a => a
blockRows = 7
-- Level 5
-- %%%%%%%%
-- % X
-- % X X
-- % X X
-- % XXXXXXX
blockPosS 5 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = nub $
[(3,0),(blockColumns-4,1)] ++
[(2,1),(blockColumns-3,1)] ++
[(1,2),(blockColumns-2,2)] ++
[(x,y) | x <- [0..blockColumns-1], y <- [3]]
-- Level 6
-- %%%%%%%%
-- % XXXXXX
-- % X X
-- % X X
-- % X X
-- % XXXXXX
blockPosS 6 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [1..blockColumns-2], y <- [0,blockRows-1]] ++
[(x,y) | x <- [0,blockColumns-1], y <- [1..blockRows-2]]
blockRows :: Num a => a
blockRows = 5
-- Level 7
-- %%%%%%%%
-- % XXXXXX
-- % X X
-- % XX
-- % XX
-- % X X
-- % XXXXXX
blockPosS 7 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [1..blockColumns-2], y <- [0,blockRows-1]] ++
[(x,y) | x <- [0,blockColumns-1], y <- [1,blockRows-2]] ++
[(x,y) | x <- [3,4], y <- [2..4]]
blockRows :: Num a => a
blockRows = 7
-- Level 8
-- %%%%%%%%
-- % XX XXXXX
-- % XX XXXXX
-- %
-- % XX XXXXX
-- % XX XXXXX
-- % XX XXXXX
-- % XX XXXXX
-- % XX XXXXX
-- % XX XXXXX
-- % XX XXXXX
blockPosS 8 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns-1]
, y <- [0..blockRows-1]
, x /= 2, y /= 2 ]
blockRows :: Num a => a
blockRows = 9
-- Level 9
-- %%%%%%%%
-- % X
-- % XXX
-- % X X X
-- % XXXXXXX
-- % X X X
-- % XXX
-- % X
blockPosS 9 = map ((adjustHPos *** adjustVPos) . fI2) allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [3], y <- [0..6]] ++
[(x,y) | x <- [0..6], y <- [3]] ++
[(x,y) | x <- [2,4], y <- [1,5]] ++
[(x,y) | x <- [1,5], y <- [2,4]]
adjustHPos :: Double -> Double
adjustHPos = (leftMargin +) . ((blockWidth + blockSeparation) *)
leftMargin :: Num a => a
leftMargin = round' ((gameWidth - (blockWidth + blockSeparation) * 7)/2)
where round' = fromIntegral . floor
-- Level 10
-- %%%%%%%%
-- % X X X
-- % X X X
-- % X X X
-- % X X X
-- % XXXXXXX
-- % X X X
-- % X X X
-- % X X X
-- % X X X
blockPosS 10 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns-1]
, y <- [0..blockRows-1], odd x] ++
[(x,y) | x <- [0..blockColumns-1], y <- [midRow], even x]
blockRows :: Num a => a
blockRows = 9
midRow :: Integral a => a
midRow = blockRows `div` 2
-- Level 11
-- %%%%%%%%
-- % XX
-- % XXXX
-- % XXXXXX
-- % XXXXXXXX
-- % XXXXXX
-- % XXXX
-- % XX
blockPosS 11 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | y <- [0..blockRows-1]
, x <- [0..(blockColumns-1) - 2 * abs (y - midRow)]]
blockRows :: Num a => a
blockRows = 7
midRow :: Integral a => a
midRow = blockRows `div` 2
-- Level 12
-- %%%%%%%%
-- % XXXXXXX
-- % X X
-- % X X
-- %
-- % X X
-- % X X
blockPosS 12 = map adjustPos allBlocks
where allBlocks :: (Enum a, Num a, Eq a, Integral a) => [(a,a)]
allBlocks = [(x,y) | x <- [0..blockColumns-1], y <- [0]] ++
[(x,y) | x <- [2, blockColumns-3], y <- [1,2]] ++
[(1,4), (blockColumns-2,4), (0,5), (blockColumns-1,5)]
blockRows :: Num a => a
blockRows = 9
blockPosS _ = error "No more levels"
-- Dynamic positioning/level size
adjustPos :: Integral a => (a,a) -> (Double, Double)
adjustPos = ((adjustHPos *** adjustVPos) . fI2)
adjustVPos :: Double -> Double
adjustVPos = (topMargin +) . ((blockHeight + blockSeparation) *)
adjustHPos :: Double -> Double
adjustHPos = (leftMargin +) . ((blockWidth + blockSeparation) *)
-- Fit as many as possible
blockColumns :: Num a => a
blockColumns =
1 + round' ( (gameWidth - blockWidth - 2 * leftMargin)
/ (blockWidth + blockSeparation)
)
where round' = fromIntegral . floor
-- * Testing constants
--
-- These constans are used by the game, and can be mofidied on order to test
-- different levels.
--
-- TODO: should this be moved to the module Constants?
-- | Initial level. Change this in the code to start
-- from a different level.
initialLevel :: Int
initialLevel = 0
-- * Constants
topMargin :: Num a => a
topMargin = 10
leftMargin :: Num a => a
leftMargin = 25
-- * Auxiliary functions
fI2 :: Integral a => (a,a) -> (Double, Double)
fI2 (x,y) = (fromIntegral x, fromIntegral y)