gloss-examples-1.3.1.1: Visibility/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