{-# LANGUAGE ScopedTypeVariables #-} module World where import Cell import Graphics.Gloss.Interface.Pure.Game import Graphics.Gloss.Data.Extent import Graphics.Gloss.Data.QuadTree import Graphics.Gloss.Algorithms.RayCast -- | The game world. data World = World { worldWidth :: Int , worldHeight :: Int , worldTree :: QuadTree Cell , worldCellSize :: Int , worldCellSpace :: Int } deriving Show -- | Get the extent covering the entire world. worldExtent :: World -> Extent worldExtent world = makeExtent (worldWidth world) 0 (worldHeight world) 0 -- | Load a world from a file. loadWorld :: FilePath -> IO World loadWorld fileName = do str <- readFile fileName return $ readWorld str -- | Read a world from a string. readWorld :: String -> World readWorld str = let ("WORLD" : strWidthHeight : skip : cellLines) = lines str [width, height] = map read $ words strWidthHeight rows = take height $ cellLines cells = concat $ map (readLine width) $ reverse rows extent = makeExtent height 0 width 0 in World { worldWidth = width , worldHeight = height , worldTree = makeWorldTree extent cells , worldCellSize = 20 , worldCellSpace = 0 } readLine :: Int -> String -> [Cell] readLine width (s:str) = map readCell $ take width str -- | Get the size of the window needed to display a world. windowSizeOfWorld :: World -> (Int, Int) windowSizeOfWorld world = let cellSize = worldCellSize world cellSpace = worldCellSpace world cellPad = cellSize + cellSpace height = cellPad * (worldHeight world) + cellSpace width = cellPad * (worldWidth world) + cellSpace in (width, height) -- | Create the tree representing the world from a list of all its cells. makeWorldTree :: Extent -> [Cell] -> QuadTree Cell makeWorldTree extent cells = foldr insert' emptyTree nonEmptyPosCells where insert' (pos, cell) tree = case insertByCoord extent pos cell tree of Nothing -> tree Just tree' -> tree' (width, height) = sizeOfExtent extent posCells = zip [(x, y) | y <- [0 .. height - 1] , x <- [0 .. width - 1]] cells nonEmptyPosCells = filter (\x -> snd x /= CellEmpty) posCells -- | Get the world position coresponding to a point in the window. worldPosOfWindowPos :: World -> Point -> Point worldPosOfWindowPos world (x, y) = let (windowSizeX, windowSizeY) = windowSizeOfWorld world offsetX = fromIntegral $ windowSizeX `div` 2 offsetY = fromIntegral $ windowSizeY `div` 2 scale = fromIntegral $ worldCellSize world x' = (x + offsetX) / scale y' = (y + offsetY) / scale in (x', y') -- | Check if a the cell at a given coordinate is visible from a point. cellAtCoordIsVisibleFromCoord :: World -> Coord -> Coord -> Bool cellAtCoordIsVisibleFromCoord world cFrom cTo = let (cx, cy) = cFrom pFrom = (fromIntegral cx + 0.5 , fromIntegral cy + 0.5) in cellAtCoordIsVisibleFromPoint world pFrom cTo -- | Check if a cell at a given coordinate is visible from a point. -- We say it's visible if the center of any of its faces is visible. cellAtCoordIsVisibleFromPoint :: World -> Point -> Coord -> Bool cellAtCoordIsVisibleFromPoint world pFrom (x', y') = or $ map (cellAtPointIsVisibleFromPoint world pFrom) [pa, pb, pc, pd] where x :: Float = fromIntegral x' + 0.5 y :: Float = fromIntegral y' + 0.5 pa = (x - 0.4999, y) pb = (x + 0.4999, y) pc = (x, y - 0.4999) pd = (x, y + 0.4999) -- | Check if a point on some cell (P2) is visible from some other point (P1). cellAtPointIsVisibleFromPoint :: World -> Point -> Point -> Bool cellAtPointIsVisibleFromPoint world p1 p2 = let mOccluder = castSegIntoWorld world p1 p2 in case mOccluder of Nothing -> False Just (pos, extent, cell) -> pointInExtent extent p2 -- | Given a line segment (P1-P2) get the cell closest to P1 that intersects the segment. castSegIntoWorld :: World -> Point -> Point -> Maybe (Point, Extent, Cell) castSegIntoWorld world p1 p2 = castSegIntoCellularQuadTree p1 p2 (worldExtent world) (worldTree world) -- | Given a line segment (P1-P2) get the cell closest to P1 that intersects the segment. traceSegIntoWorld :: World -> Point -> Point -> [(Point, Extent, Cell)] traceSegIntoWorld world p1 p2 = traceSegIntoCellularQuadTree p1 p2 (worldExtent world) (worldTree world)