packages feed

gloss-examples-1.0.0.0: Styrene/World.hs

{-# LANGUAGE PatternGuards #-}

-- The world contains a map of all the actors, along with the current
--	quadtree so we can also draw it on the screen.
module World where

import QuadTree
import Actor
import Config

import qualified Data.Map	as Map
import Data.Map			(Map)

-- The world ---------------------------------------------------------------------------------------
data World	
	= World (Map Index Actor)	-- actors
		(QuadTree Actor)	-- tree

-- | The initial world
worldInit :: World
worldInit	
  	= World actorMapInit treeInit

actorMapInit	
	= Map.fromList 
	$ map (\a -> (actorIx a, a))
	$ (walls ++ beads)

treeInit = treeZero treeSize


-- Walls ------------------
walls :: [Actor]
walls	= zipWith actorSetIndex (box ++ splitter) [10000 ..]

box :: [Actor]
box
 = let 	bs	= boxSize
   in	[ Wall  0 (- bs, -bs) (bs, -bs)		-- bot
 	, Wall  0 (- bs,  bs) (bs,  bs)		-- top

 	, Wall  0 (- bs, -bs) (-bs, bs)		-- left
 	, Wall  0 (  bs, -bs) ( bs, bs)] 	-- right

splitter :: [Actor]
splitter
 =	[ Wall	0 (-15, -100) (-200, 0) 
 	, Wall  0 ( 15, -100) ( 200, 0) ]


-- Beads ------------------
beads :: [Actor]
beads	
 = let	-- beads start off with their index just set to 0
	beads_raw
		= [Bead 0 0 beadRadius (beadPos ix iy) (0, 0)
			| ix <- [0 .. beadCountX - 1]
			, iy <- [0 .. beadCountY - 1 ] ]
	
	-- set the unique index on the beads before returning them
   in	zipWith actorSetIndex beads_raw [0..]
			 
beadPos ix iy	
 = 	( (ix * beadBoxSize) - (beadBoxSize * beadCountX / 2)
	, (iy * beadBoxSize)  )


-- QuadTree ----------------------------------------------------------------------------------------

-- | insert an actor into the tree
insertActor :: Actor -> QuadTree Actor -> QuadTree Actor

insertActor actor tree
	-- insert a bead into the tree
	| bead@(Bead ix _ radius pos@(x, y) vel) 	<- actor
	= let
		-- the bottom left and top right of the bead's bounding box.
		p0	= (x - radius, y - radius)
 		p1	= (x + radius, y + radius)

   	  in	treeInsert treeMaxDepth 0 p0 p1 bead tree

	| wall@(Wall ix (x0, y0) (x1, y1))		<- actor
	= let
		-- the bottom left and top right of the wall's bounding box.
		p0	= (min x0 x1, min y0 y1)
 		p1	= (max x0 x1, max y0 y1)
   	
	  in	treeInsert treeMaxDepth 0 p0 p1 wall tree