gloss-examples-1.2.0.0: Occlusion/Main.hs

{-# LANGUAGE PatternGuards #-}

import World
import Data
import State
import Cell
import Graphics.Gloss.Interface.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
 = do	let gameState	= initState world
	gameInWindow 
		"Occlusion"
		(windowSizeOfWorld world)
		(10, 10)
		black 
		10
		gameState
		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)