Draw.hs

{-# LANGUAGE PatternGuards #-}
module Draw
        ( drawState
        , drawWorld)
where
import State
import World
import Geometry.Segment
import Graphics.Gloss
import Graphics.Gloss.Geometry.Line
import qualified Data.Vector.Unboxed    as V
import Data.Maybe


drawState :: State -> Picture
drawState state
        | ModeDisplayWorld      <- stateModeDisplay state
        = drawWorldWithViewPos 
                (stateModeOverlay state)
                (stateViewPos     state) 
                (stateTargetPos   state)
                (stateWorld       state)

        | ModeDisplayNormalised <- stateModeDisplay state
        = drawWorldWithViewPos 
                (stateModeOverlay state)
                (0, 0) 
                Nothing
                $ normaliseWorld (stateViewPos state)
                $ stateWorld state

        | otherwise
        = Blank
        

drawWorldWithViewPos :: ModeOverlay -> Point -> Maybe Point -> World -> Picture
drawWorldWithViewPos 
        modeOverlay
        pView@(vx, vy) 
        mTarget
        world
 = let  
        -- the world 
        picWorld        = Color white
                        $ drawWorld world

        -- view position indicator
        picView         = Color red
                        $ Translate vx vy
                        $ ThickCircle 2 4

        -- target position indicator
        picTargets
                | Just pTarget@(px, py) <- mTarget
                = let   picTarget       = Translate px py $ ThickCircle 2 4

                        -- line between view and target pos
                        picLine         = Line [pView, pTarget]
                        
                        picSegsHit      = Pictures
                                        $ [ Line [p1, p2]
                                                | (_, p1, p2)   <- V.toList $ worldSegments world
                                                , isJust $ intersectSegSeg p1 p2 pView pTarget ]
                  in    Color red $ Pictures [picTarget, picLine, picSegsHit]

                | otherwise
                = blank

        -- overlay
        picOverlay
                | ModeOverlayVisApprox  <- modeOverlay
                = drawVisGrid 10 pView world

                | otherwise
                = blank

   in   Pictures [picOverlay, picWorld, picView, picTargets]


-- | Draw a grid of points showing what is visible from a view position
drawVisGrid :: Float -> Point -> World -> Picture
drawVisGrid cellSize pView world
 = let  
        visible pTarget = not $ any isJust
                        $ map (\(_, p1, p2) -> intersectSegSeg pView pTarget p1 p2)
                        $ V.toList 
                        $ worldSegments world
                        
        picGrid         = Pictures
                        $ [ if visible (x, y) 
                                then Color (dim green) $ Translate x y $ rectangleSolid cellSize cellSize
                                else Color (greyN 0.2) $ Translate x y $ rectangleSolid cellSize cellSize
                                | x     <- [-400, -400 + cellSize .. 400]
                                , y     <- [-400, -400 + cellSize .. 400] ]

   in   picGrid


-- | Draw the segments in the world.
drawWorld :: World -> Picture
drawWorld world
        = drawSegments
        $ worldSegments world


-- | Draw an array of segments.
drawSegments :: V.Vector Segment -> Picture
drawSegments segments
        = Pictures
        $ map drawSegment
        $ V.toList 
        $ segments


-- | Draw a single segment.
drawSegment :: Segment -> Picture
drawSegment (_, (x1, y1), (x2, y2))
        = Line [(f x1, f y1), (f x2, f y2)]
        where   f       = fromRational . toRational