packages feed

gloss-examples-1.9.3.1: picture/Occlusion/Main.hs

{-# LANGUAGE PatternGuards #-}

import World
import Data
import State
import Cell
import Graphics.Gloss.Interface.Pure.Game
import Graphics.Gloss.Data.QuadTree
import Graphics.Gloss.Data.Extent
import System.Environment
import Data.Maybe
import Data.List
import Data.Function

main 
 = do   args    <- getArgs
        case args of
         [fileName]     
          -> do world   <- loadWorld fileName
                mainWithWorld world
                
         _ -> do
                let world = readWorld worldData
                mainWithWorld world
        
        
mainWithWorld world
 = play (InWindow "Occlusion"
                 (windowSizeOfWorld world) (10, 10))
        black 
        10
        (initState world)
        drawState
        (handleInput world)
        (\_ -> id)
                                
                                
-- | Convert the state to a picture.
drawState :: State -> Picture
drawState state
 = let  world           = stateWorld state

        -- The ray cast by the user.
        p1              = stateLineStart state
        p2              = stateLineEnd   state
        picRay          = drawRay world p1 p2

        -- The cell hit by the ray (if any)
        mHitCell        = castSegIntoWorld world p1 p2
        hitCells        = maybeToList mHitCell
        picCellsHit     = Pictures $ map (drawHitCell world) hitCells

        -- All the cells in the world.
        cellsAll        = flattenQuadTree (worldExtent world) (worldTree world)
        picCellsAll     = Pictures $ map (uncurry (drawCell False world)) cellsAll

        -- The cells visible from the designated point.
        cellsVisible    
          = [ (coord, cell)
                | (coord, cell) <- flattenQuadTree (worldExtent world) (worldTree world)
                , cellAtCoordIsVisibleFromPoint world p1 coord ]

        picCellsVisible = Pictures $ map (uncurry (drawCell True world)) cellsVisible

        -- How big to draw the cells.
        scale           = fromIntegral $ worldCellSize world

        (windowSizeX, windowSizeY)      
                = windowSizeOfWorld
                $ stateWorld state
                
        -- Shift the cells so they are centered in the window.
        offsetX = - (fromIntegral $ windowSizeX `div` 2)
        offsetY = - (fromIntegral $ windowSizeY `div` 2)

   in   Translate offsetX offsetY
                $ Scale scale scale
                $ Pictures [ picCellsAll, picCellsVisible, picCellsHit, picRay ]


-- | Draw the cell hit by the ray defined by the user.
drawHitCell :: World -> (Point, Extent, Cell) -> Picture
drawHitCell world (pos@(px, py), extent, cell)
 = let  (n, s, e, w)    = takeExtent extent
        x               = w
        y               = s

        posX    = fromIntegral x 
        posY    = fromIntegral y
        
   in   Pictures [ Color blue $ cellShape 1 posX posY ]


-- | Draw the ray defined by the user.
drawRay :: World -> Point -> Point -> Picture 
drawRay world p1@(x, y) p2
 = Pictures
        [ Color red $ Line [p1, p2]
        , Color cyan 
                $ Translate x y 
                $ Pictures 
                        [ Line [(-0.3, -0.3), (0.3,  0.3)]
                        , Line [(-0.3,  0.3), (0.3, -0.3)] ] ]


-- | Draw a cell in the world.
drawCell :: Bool -> World -> Coord -> Cell -> Picture
drawCell visible world (x, y) cell 
 = let  cs      = fromIntegral (worldCellSize world)
        cp      = fromIntegral (worldCellSpace world)

        posX    = fromIntegral x 
        posY    = fromIntegral y

   in   if visible
          then pictureOfCell (worldCellSize world) posX posY cell
          else Color (greyN 0.4) (cellShape cs posX posY)