Raincat-1.1.1: src/Level/Level.hs
module Level.Level
(Level(Level),
LevelData(LevelData),
levelData,
levelWidth,
levelHeight,
levelItemCounts,
levelEnd,
levelCat,
levelFireHydrantsL,
levelFireHydrantsR,
levelPuddles,
levelRects,
levelPolys,
levelBackgrounds,
openLevel) where
import Nxt.Types
import System.IO
import qualified Error.Error as E
import Settings.DisplaySettings
import Nxt.Graphics hiding (end)
import Control.Arrow (second)
data LevelData = LevelData
{
levelEnd :: Rect,
levelCat :: Rect,
levelFireHydrantsL :: [Rect],
levelFireHydrantsR :: [Rect],
levelPuddles :: [Rect],
levelRects :: [Rect],
levelPolys :: [Poly],
levelBackgrounds :: [(Vector2d, Nxt.Types.Texture)]
}
data Level = Level
{
levelWidth :: Int,
levelHeight :: Int,
levelItemCounts :: [Int],
levelData :: LevelData
}
-- readInt
readInt' :: String -> Int
readInt' = read
-- readDouble
readDouble' :: String -> Double
readDouble' = read
-- openLevel
openLevel :: String -> IO Level
openLevel file = do
inh <- openFile file ReadMode
level <- parseLevel inh
hClose inh
return level
-- parseLevel
parseLevel :: Handle -> IO Level
parseLevel inh = do
levelDimensionS <- hGetLine inh
let levelDimension = map readInt' (words levelDimensionS)
itemCountsS <- hGetLine inh
let itemCountsList = map readInt' (words itemCountsS)
--itemCounts = initItemCount itemCountsList
numObjectS <- hGetLine inh
let numObject = readInt' numObjectS
let dummyData = LevelData (Rect 0 0 0 0) (Rect 0 0 0 0) [] [] [] [] [] []
lvlData <- parseShape numObject inh dummyData
let levelDataT = transformCoord lvlData
let level = Level (head levelDimension) (last levelDimension) itemCountsList levelDataT
return level
-- transform coordinates from using top left as (0,0) to bottom left as (0,0)
transformCoord :: LevelData -> LevelData
transformCoord (LevelData end cat fireHydrantsL fireHydrantsR puddles rects polys bgTex) =
LevelData (transformR end) (transformR cat) (map transformR fireHydrantsL) (map transformR fireHydrantsR) (map transformR puddles) (map transformR rects) (map transformP polys) bgTex
where transformR (Rect rx ry rw rh) = let sh' = fromGLdouble screenResHeight
in Rect rx (sh' - ry) rw (-rh)
transformP (Poly polyS polyVs) = let sh' = fromGLdouble screenResHeight
in Poly polyS (map (second (sh' -)) polyVs)
-- parseShape
parseShape :: Int -> Handle -> LevelData -> IO LevelData
parseShape numShapes inh (leveldata@(LevelData _ _ fireHydrantsL fireHydrantsR puddles rects polys _)) = do
ineof <- hIsEOF inh
if ineof || numShapes <= 0
then return leveldata
else
do
coordS <- hGetLine inh
let toks = words coordS
let coord = map readDouble' (tail $ words coordS)
let verts = parseVerts coord
let poly = Poly (length verts) verts
let obj = head toks
let newLevelData = case obj of
"rectangle" -> leveldata {levelRects = parseRect coord : rects}
"cat" -> leveldata {levelCat = parseRect coord}
"end" -> leveldata {levelEnd = parseRect coord}
"firehydrantLeft" -> leveldata {levelFireHydrantsL = parseRect coord : fireHydrantsL}
"firehydrantRight" -> leveldata {levelFireHydrantsR = parseRect coord : fireHydrantsR}
"puddle" -> leveldata {levelPuddles = parseRect coord : puddles}
"polygon" -> leveldata {levelPolys = poly : polys}
_ -> E.throwEx (E.BadLevelData obj)
parseShape (numShapes-1) inh newLevelData
-- parseVerts
parseVerts :: [Double] -> [Vector2d]
parseVerts [] = []
parseVerts (_x:[]) = E.throwEx E.BadVerticesData
parseVerts (x:y:vs) = (x,y):parseVerts vs
-- parseRect
parseRect :: [Double] -> Rect
parseRect coords =
if length coords /= 8
then E.throwEx E.BadRectData
else Rect bottomLX bottomLY width height
where bottomLX = head coords
bottomLY = coords !! 1
width = (coords !! 2) - bottomLX
height = (coords !! 7) - bottomLY