diff --git a/Clock/Main.hs b/Clock/Main.hs
new file mode 100644
--- /dev/null
+++ b/Clock/Main.hs
@@ -0,0 +1,92 @@
+
+-- A fractal consisting of circles and lines which looks a bit like
+--	the workings of a clock.
+import Graphics.Gloss
+
+main
+ =	animateInWindow
+ 		"Clock"
+		(600, 600)
+		(20, 20)
+		black
+		frame
+
+
+-- Build the fractal, scale it so it fits in the window
+-- and rotate the whole thing as time moves on.
+frame :: Float -> Picture
+frame	time
+ 	= Color white
+	$ Scale 120 120
+	$ Rotate (time * 2*pi)
+	$ clockFractal 5 time
+		
+
+-- The basic fractal consists of three circles offset from the origin
+-- as follows.
+--
+--   	   1
+--         |
+--         .
+--       /   \
+--      2     3
+--
+-- The direction of rotation switches as n increases.
+-- Components at higher iterations also spin faster.
+--
+clockFractal :: Int -> Float -> Picture
+clockFractal 0 s	= Blank
+clockFractal n s	= Pictures [circ1, circ2, circ3, lines]
+ where
+ 	-- y offset from origin to center of circle 1.
+	a	= 1 / sin (2 * pi / 6)
+
+	-- x offset from origin to center of circles 2 and 3.
+ 	b	= a * cos (2 * pi / 6)
+
+	nf	= fromIntegral n
+	rot	= if n `mod` 2 == 0
+			then   50 * s * (log (1 + nf))
+			else (-50 * s * (log (1 + nf)))
+
+	-- each element contains a copy of the (n-1) iteration contained
+	--	within a larger circle, and some text showing the time since 
+	--	the animation started.
+	--
+	circNm1 
+	 = Pictures
+		[ circle 1 50
+		, Scale (a/2.5) (a/2.5) $ clockFractal (n-1) s
+		, if n > 2
+		    then Color cyan	
+				$ Translate (-0.15) 1
+				$ Scale 0.001 0.001 
+				$ Text (show s) 
+		    else Blank
+		]
+
+	circ1	= Translate 0 a		$ Rotate rot	circNm1
+	circ2 	= Translate 1 (-b)	$ Rotate (-rot)	circNm1
+	circ3	= Translate (-1) (-b)	$ Rotate rot	circNm1
+	
+	-- join each iteration to the origin with some lines.
+	lines	
+	 = Pictures
+		[ Line [(0, 0), ( 0,  a)]
+		, Line [(0, 0), ( 1, -b)]
+		, Line [(0, 0), (-1, -b)] ]
+
+
+-- Make a circle of radius r consisting of n lines.
+circle :: Float -> Float -> Picture
+circle r n
+ 	= Scale r r
+	$ Line (circlePoints n)
+	
+	
+-- A list of n points spaced equally around the unit circle.
+circlePoints :: Float -> [(Float, Float)]
+circlePoints n
+ =	map 	(\d -> (cos d, sin d))
+		[0, 2*pi / n .. 2*pi]
+
diff --git a/Easy/Main.hs b/Easy/Main.hs
new file mode 100644
--- /dev/null
+++ b/Easy/Main.hs
@@ -0,0 +1,3 @@
+
+import Graphics.Gloss
+main = displayInWindow "My Window" (200, 200) (10, 10) white (Circle 80)
diff --git a/Eden/Cell.hs b/Eden/Cell.hs
new file mode 100644
--- /dev/null
+++ b/Eden/Cell.hs
@@ -0,0 +1,38 @@
+module Cell where
+
+import Graphics.Gloss
+
+data Cell 
+	= Cell	Point    -- centre
+             	Float    -- radius
+		Int	
+              	deriving Show
+
+-- Produce a new cell of a certain relative radius at a certain angle.
+-- 	The factor argument is in the range [0..1] so spawned cells are
+-- 	smaller than their parent.
+-- The check whether it fits in the community is elsewhere.
+offspring :: Cell -> Float -> Float -> Cell
+offspring (Cell (x,y) r gen) alpha factor 
+	= Cell 	(x + (childR+r) * cos alpha, y + (childR+r) * sin alpha) 
+		childR 
+		(gen + 1)
+
+    	where childR = factor * r
+
+-- Do two cells overlap?         
+-- Used to decide if newly spawned cells can join the community.
+overlap :: Cell -> Cell -> Bool
+overlap (Cell (x1,y1) r1 _) (Cell (x2,y2) r2 _) 
+	= centreDist < (r1 + r2) * 0.999
+    	where 	centreDist = sqrt(xdiff*xdiff + ydiff*ydiff)
+          	xdiff = x1 - x2
+          	ydiff = y1 - y2
+
+render :: Cell -> Picture
+render (Cell (x,y) r gen) 
+ = let 	z	= fromIntegral gen * 0.1
+	color	= makeColor 0.0 z 0.5 1.0
+   in	Color color
+		$ Translate x y
+		$ Circle r
diff --git a/Eden/Community.hs b/Eden/Community.hs
new file mode 100644
--- /dev/null
+++ b/Eden/Community.hs
@@ -0,0 +1,55 @@
+module Community where
+
+import Cell
+import Graphics.Gloss
+
+type Community = [Cell]
+
+-- does a (newly spawned) cell fit in the community?
+-- that is, does it overlap with any others?
+fits :: Cell -> Community -> Bool
+fits cell cells 
+	= not $ any (overlap cell) cells
+
+-- For each member of a community, produce one offspring
+-- The lists of Floats are the (random) parameters that determine size
+-- and location of each offspring.
+spawn :: Community -> [Float] -> [Float] -> [Cell]
+spawn 	= zipWith3 offspring
+
+-- Given a collection of cells (one spawned by each member of the
+-- community) check if it fits, and if so add it to the community.
+-- That check must include new cells that have been added to the
+-- community in this process.
+survive :: [Cell] -> Community -> Community
+survive [] comm = comm
+survive (cell:cells) comm
+	| fits cell comm  = survive cells (cell:comm)
+	| otherwise       = survive cells comm
+
+-- The next generation of a community
+generation :: Community ->  [Float] -> [Float] -> Community
+generation comm angles scales 
+	= survive (spawn comm angles scales) comm
+
+render :: Community -> Picture
+render comm 
+	= Pictures $ map Cell.render comm
+
+initial :: Community
+initial = [Cell (0,0) 50 0]
+
+
+-- thread the random lists for testing outside IO()
+--
+life :: Community -> [Float] -> [Float] -> (Community, [Float], [Float])
+life comm randomAngles randomScales =
+    (generation comm angles scales, randomAngles', randomScales')
+    where population = length comm
+          (angles, randomAngles') = splitAt population randomAngles
+          (scales, randomScales') = splitAt population randomScales
+
+evolution :: Community -> [Float] -> [Float] -> [Community]
+evolution comm randomAngles randomScales = comm1 : comms
+    where (comm1, ras, rss) = life comm randomAngles randomScales
+          comms = evolution comm1 ras rss
diff --git a/Eden/Main.hs b/Eden/Main.hs
new file mode 100644
--- /dev/null
+++ b/Eden/Main.hs
@@ -0,0 +1,21 @@
+
+-- Adapted from ANUPlot version by Clem Baker-Finch
+module Main where
+import World
+import Graphics.Gloss
+import System.Random
+
+-- varying prng sequence
+main 
+ = do 	gen <- getStdGen
+	simulateInWindow
+		"Eden"          -- window name
+		(800, 600)      -- window size
+		(10, 10)	-- window position
+		(greyN 0.1)	-- background color
+		2               -- number of steps per second
+		(genesis' gen)  -- initial world
+		render          -- function to convert world to a Picture
+		evolve          -- function to step the world one iteration
+
+
diff --git a/Eden/World.hs b/Eden/World.hs
new file mode 100644
--- /dev/null
+++ b/Eden/World.hs
@@ -0,0 +1,47 @@
+module World where
+
+
+import Graphics.Gloss
+import System.Random
+import Community
+import Cell
+
+maxSteps	= 30
+
+-- The World consists of a Community and a random number generator.
+-- (The RNG is a model of chaos or hand-of-god.)
+data World 
+	= World Community StdGen Int
+	deriving (Show)
+
+-- The initial world
+genesis :: World
+genesis 
+	= World [Cell (0,0) 30 0] (mkStdGen 1023) 0
+
+-- Seeding the prng means every run is identical.
+-- To get different runs, need to use gen <- getStdGen in main :: IO()
+-- and pass gen in as an argument.  Edit Main.hs accordingly.
+genesis' :: StdGen -> World
+genesis' gen 
+	= World [Cell (0,0) 30 0] gen 0
+
+
+-- Consume some random numbers to advance the simulation
+evolve :: ViewPort -> Float -> World -> World
+evolve vp step world@(World comm gen steps) 
+	| steps < maxSteps	
+	= let	(genThis, genNext) = split gen
+          	(genA, genS)       = split genThis
+          	angles             = randomRs (0.0, 2*pi) genA
+          	scales             = randomRs (0.7, 0.9) genS
+    	  in  	World (generation comm angles scales) genNext (steps + 1)
+
+	| otherwise
+	= world
+
+-- Converting the world to a picture is just converting the community component
+render :: World -> Picture
+render (World comm gen steps) 
+	= Color (makeColor 0.3 0.3 0.6 1.0)
+	$ Community.render comm
diff --git a/Flake/Main.hs b/Flake/Main.hs
new file mode 100644
--- /dev/null
+++ b/Flake/Main.hs
@@ -0,0 +1,50 @@
+
+-- | Snowflake Fractal.
+--	Based on ANUPlot code by Clem Baker-Finch.
+--
+import Graphics.Gloss
+
+main =	displayInWindow
+       		"Snowflake"
+       		(500, 500)
+       		(20,  20)
+		black
+       		(picture 3)
+
+
+-- Fix a starting edge length of 360
+edge = 360 :: Float
+
+
+-- Move the fractal into the center of the window and colour it nicely
+picture :: Int -> Picture
+picture degree 
+	= Color aquamarine
+	$ Translate (-edge/2) (-edge * sqrt 3/6)
+	$ snowflake degree
+	
+
+-- The fractal function
+side :: Int -> Picture
+side 0 = Line [(0, 0), (edge, 0)]
+side n 
+ = let	newSide = Scale (1/3) (1/3) 
+		$ side (n-1)
+   in	Pictures
+		[ newSide
+		, Translate (edge/3) 0 			  $ Rotate 60    newSide 
+		, Translate (edge/2) (-(edge * sqrt 3)/6) $ Rotate (-60) newSide 
+		, Translate (2 * edge/3) 0		  $ newSide ]
+
+
+-- Put 3 together to form the snowflake
+snowflake :: Int -> Picture
+snowflake n 
+ = let	oneSide	= side n
+   in 	Pictures
+		[ oneSide 
+		, Translate edge 0 			$ Rotate (-120) $ oneSide
+		, Translate (edge/2) (edge * sqrt 3/2)	$ Rotate 120	$ oneSide]
+
+
+
diff --git a/Hello/Main.hs b/Hello/Main.hs
new file mode 100644
--- /dev/null
+++ b/Hello/Main.hs
@@ -0,0 +1,16 @@
+
+-- | Display "Hello World" in a window.
+--
+import Graphics.Gloss
+
+main 	= displayInWindow 
+		"Hello World" 		-- window title
+		(400, 150) 		-- window size
+		(10, 10) 		-- window position
+		white			-- background color
+		picture			-- picture to display
+
+picture	
+	= Translate (-170) (-20) 	-- shift the text to the middle of the window
+	$ Scale 0.5 0.5			-- display it half the original size
+	$ Text "Hello World"		-- text to display
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,13 @@
+Copyright (c) 2010 Benjamin Lippmeier 
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the "Software"), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ condition:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
diff --git a/Lifespan/Cell.hs b/Lifespan/Cell.hs
new file mode 100644
--- /dev/null
+++ b/Lifespan/Cell.hs
@@ -0,0 +1,36 @@
+module Cell where
+
+import Graphics.Gloss
+
+data Cell = Cell Point    -- centre
+                 Float    -- radius
+                 Int      -- remaining lifetime
+                 deriving Show
+
+-- Produce a new cell of a certain relative radius at a certain angle.
+-- The factor argument is in the range [0..1] so spawned cells are
+-- smaller than their parent.
+-- The check whether it fits in the community is elsewhere.
+offspring :: Cell -> Float -> Float -> Int -> Cell
+offspring (Cell (x,y) r _) alpha factor lifespan =
+    Cell (x + (childR+r) * cos alpha, y + (childR+r) * sin alpha)
+         childR 
+         lifespan
+    where childR = factor * r
+
+-- Do two cells overlap?         
+-- Used to decide if newly spawned cells can join the community.
+overlap :: Cell -> Cell -> Bool
+overlap (Cell (x1,y1) r1 _) (Cell (x2,y2) r2 _) = centreDist < (r1 + r2) *0.999
+    where centreDist = sqrt(xdiff*xdiff + ydiff*ydiff)
+          xdiff = x1 - x2
+          ydiff = y1 - y2
+
+-- thickness of circle is determined by lifespan
+render :: Cell -> Picture
+render (Cell (x,y) r life) 
+	= Color (makeColor 0.6 z 0.6 1.0)
+	$ Translate x y
+	$ ThickCircle (r - thickness / 2) thickness
+	where	z 		= fromIntegral life * 0.12
+		thickness	= fromIntegral life
diff --git a/Lifespan/Community.hs b/Lifespan/Community.hs
new file mode 100644
--- /dev/null
+++ b/Lifespan/Community.hs
@@ -0,0 +1,58 @@
+module Community where
+
+import Cell
+import Graphics.Gloss
+
+type Community = [Cell]
+
+-- does a (newly spawned) cell fit in the community?
+-- that is, does it overlap with any others?
+fits :: Cell -> Community -> Bool
+fits cell cells = not $ any (overlap cell) cells
+
+-- For each member of a community, produce one offspring
+-- The lists of Floats are the (random) parameters that determine size
+
+-- and location of each offspring.
+spawn :: Community -> [Float] -> [Float] -> [Int] -> [Cell]
+spawn = zipWith4 offspring
+
+zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
+zipWith4 f [] _ _ _ = []
+zipWith4 f _ [] _ _ = []
+zipWith4 f _ _ [] _ = []
+zipWith4 f _ _ _ [] = []
+zipWith4 f (b:bs) (c:cs) (d:ds) (e:es) =
+    f b c d e : zipWith4 f bs cs ds es
+
+
+-- Given a collection of cells (one spawned by each member of the
+-- community) check if it fits, and if so add it to the community.
+-- That check must include new cells that have been added to the
+-- community in this process.
+survive :: [Cell] -> Community -> Community
+survive [] comm = comm
+survive (cell:cells) comm
+    | fits cell comm  = survive cells (cell:comm)
+    | otherwise       = survive cells comm
+
+age :: Community -> Community
+age [] = []
+age (Cell c r 0 : cells) = age cells
+age (Cell c r life : cells) = Cell c r (life-1) : age cells
+
+
+-- The next generation of a community
+generation :: Community ->  [Float] -> [Float] -> Community
+generation comm angles scales =
+    survive (spawn comm angles scales (repeat 5)) (age comm)
+
+render :: Community -> Picture
+render comm 
+	= Pictures 
+	$ map Cell.render comm
+
+initial :: Community
+initial = [Cell (0,0) 50 5]
+
+
diff --git a/Lifespan/Main.hs b/Lifespan/Main.hs
new file mode 100644
--- /dev/null
+++ b/Lifespan/Main.hs
@@ -0,0 +1,22 @@
+
+-- Adapted from ANUPlot version by Clem Baker-Finch
+module Main where
+import World
+import Graphics.Gloss
+import System.Random
+
+-- varying prng sequence
+main 
+ = do 	gen <- getStdGen
+	simulateInWindow
+		"Lifespan"          -- window name
+		(800, 600)      -- window size
+		(10, 10)	-- window position
+		(greyN 0.1)	-- background color
+		2               -- number of steps per second
+		(genesis' gen)  -- initial world
+		render          -- function to convert world to a Picture
+		evolve          -- function to step the world one iteration
+
+
+
diff --git a/Lifespan/World.hs b/Lifespan/World.hs
new file mode 100644
--- /dev/null
+++ b/Lifespan/World.hs
@@ -0,0 +1,43 @@
+module World where
+
+import Graphics.Gloss
+import System.Random
+import Community
+import Cell
+
+stepsMax	= 20
+
+-- The World consists of a Community and a random number generator.
+-- (The RNG is a model of chaos or hand-of-god.)
+data World 
+	= World Community StdGen Int
+        deriving (Show)
+
+-- The initial world
+genesis :: World
+genesis 
+	= World [Cell (0,0) 50 5] (mkStdGen 1023) 0
+
+-- Seeding the prng means every run is identical.
+-- To get different runs, need to use gen <- getStdGen in main :: IO()
+-- and pass gen in as an argument.  Edit Main.hs accordingly.
+genesis' :: StdGen -> World
+genesis' gen 
+	= World [Cell (0,0) 50 5] gen 0
+
+-- Consume some random numbers to advance the simulation
+evolve :: ViewPort -> Float -> World -> World
+evolve _ _ world@(World comm gen step) 
+ 	| step > stepsMax	= world
+	| otherwise
+	= World (generation comm angles scales) genNext (step + 1)
+    	where	(genThis, genNext) = split gen
+          	(genA, genS)       = split genThis
+		angles             = randomRs (0.0, 2*pi) genA
+		scales             = randomRs (0.7, 0.9) genS
+
+-- Converting the world to a picture is just converting the community component
+render :: World -> Picture
+render (World comm gen _) 
+	= Color (makeColor 0.3 0.3 0.6 1.0)
+	$ Community.render comm
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Styrene/Actor.hs b/Styrene/Actor.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/Actor.hs
@@ -0,0 +1,73 @@
+
+module Actor where
+
+-- | 2D position on the screen.
+type Position	= (Float, Float)
+
+-- | Force and velocity vectors.
+type Force	= (Float, Float)
+type Velocity	= (Float, Float)
+
+-- | Time in seconds
+type Time	= Float
+
+-- | Radius of a bead
+type Radius	= Float
+
+-- | Each actor has its own unique index.
+type Index	= Int
+
+-- | The actors in the world.
+data Actor
+	= Wall 	!Index 		-- ^ unique index of this actor
+		!Position 	-- ^ wall starting point
+		!Position	-- ^ wall ending point
+
+	| Bead 	!Index 		-- ^ unique index of this actor 
+		!Int 		-- ^ whether the bead is stuck
+		!Radius 	-- ^ radius of bead
+		!Position 	-- ^ position of bead
+		!Velocity	-- ^ velocity of bead
+
+	deriving Show
+
+-- | Equality and ordering of actors will consider their index only.
+--	We need Ord so we can put them in Maps and Sets.
+instance Eq Actor where
+ a1 == a2	= actorIx a1 == actorIx a2
+	
+instance Ord Actor where
+ compare a1 a2	= compare (actorIx a1) (actorIx a2)
+
+-- | Check whether an actor is a bead.
+isBead :: Actor -> Bool
+isBead (Bead _ _ _ _ _)	= True
+isBead _		= False
+
+
+-- | Check whether an actor is a wall.
+isWall :: Actor -> Bool
+isWall (Wall _ _ _)	= True
+isWall _		= False
+
+
+-- | Take the index of an actor
+actorIx :: Actor -> Index
+actorIx actor
+ = case actor of
+	Wall ix _ _	-> ix
+ 	Bead ix _ _ _ _	-> ix
+
+
+-- | Set the index of an actor
+actorSetIndex :: Actor -> Index -> Actor
+actorSetIndex actor ix
+ = case actor of
+ 	Bead _ m r pos vel 	-> Bead ix m r pos vel 
+	Wall _ p1 p2		-> Wall ix p1 p2
+
+
+-- | Set whether a bead is stuck
+actorSetMode :: Int -> Actor -> Actor
+actorSetMode m (Bead ix _ r p v)
+	= Bead ix m r p v
diff --git a/Styrene/Advance.hs b/Styrene/Advance.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/Advance.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE PatternGuards #-}
+
+-- | Advance the world to the next time step.
+module Advance where
+import World
+import Contact
+import QuadTree
+import Collide
+import Actor
+import Config
+
+import Graphics.Gloss.Geometry
+import Graphics.Gloss.ViewPort
+import Graphics.Gloss.Picture	(Point)
+
+import Data.List
+import qualified Data.Map	as Map
+import qualified Data.Set	as Set
+import Data.Set			(Set)
+import Data.Map			(Map)
+
+
+-- Advance -------------------------------------------------------------------------------------------
+
+-- | Advance all the actors in this world by a certain time.
+advanceWorld 
+	:: ViewPort 		-- ^ current viewport
+	-> Time 		-- ^ time to advance them for.
+	-> World 		-- ^ the world to advance.
+	-> World 		-- ^ the new world.
+
+advanceWorld viewport time (World actors tree)
+ = let	
+ 	rot		= viewPortRotate viewport
+	force		= rotateV (degToRad $ negate rot) (0, negate gravityCoeff)
+
+	-- move all the actors 
+	actors_moved	= Map.map (moveActor_free time force) actors
+      
+      	-- find contacts in the world
+	(contacts, tree')	
+		= findContacts (World actors_moved tree)
+
+	-- apply contacts to each pair of actors
+	actors_bounced	
+		= Set.fold 
+			(applyContact time force) 
+			actors_moved
+			contacts
+
+   in	World actors_bounced tree'
+
+
+-- Move two actors which are known to be in contact.
+applyContact 
+	:: Time 		-- ^ time step
+	-> Force 		-- ^ ambient force on the actors
+	-> (Index, Index) 	-- ^ indicies of the the two actors in contact
+	-> Map Index Actor 	-- ^ the old world
+	-> Map Index Actor	-- ^ the new world
+
+applyContact time force (ix1, ix2) actors
+ = let	-- use the indicies to lookup the data for each actor from the map
+	Just a1	= Map.lookup ix1 actors
+ 	Just a2	= Map.lookup ix2 actors
+	
+	resultActors
+		-- handle a collision between bead and a wall
+		| Bead _ _ r1 p1 v1	<- a1
+		, Wall{}		<- a2
+		= let	a1'		= collideBeadWall a1 a2
+		  in	Map.insert ix1 a1' actors
+		
+		-- handle a collision between two beads
+		| Bead ix1 m1 r1 p1 v1	<- a1
+		, Bead ix2 m2 r2 p2 v2	<- a2
+		= let	
+			(a1', a2')
+				-- if one of the beads is stuck then do a safer, static collision.
+				--	with this method the beads don't transfer energy into each other
+				--	so there is less of a chance of lots of beads being crushed together
+				--	if there are many in the same place.
+				| m1 >= beadStuckCount || m2 >= beadStuckCount
+				= let 	a1'	= collideBeadBead_static a1 a2
+			  		a2'	= collideBeadBead_static a2 a1
+			  	  in	(a1', a2')
+
+				-- otherwise do the real elastic collision
+				--	this is much more realistic.
+				| otherwise
+				= collideBeadBead_elastic a1 a2
+
+			-- write the new data for the actors back into the map
+		  in	Map.insert ix1 a1'
+		   $ 	Map.insert ix2 a2' actors
+	  
+   in	resultActors		
+	
+
+-- | Move a bead which isn't in contact with anything else.
+moveActor_free 
+	:: Time 		-- ^ time to move it for
+	-> Force 		-- ^ ambient force on the actor during this time
+	-> Actor 		-- ^ the bead to move
+	-> Actor		-- ^ the new bead
+
+moveActor_free time force actor
+	-- move a bead
+	| Bead ix stuck radius pos vel	<- actor
+	= let 	-- assume all beads have the same mass.
+		beadMass	= 1
+		
+		-- calculate the new position and velocity of the bead.
+		pos'		= (pos + time  `mulSV` vel)
+		vel'		= (vel + (time / beadMass) `mulSV` force)
+
+		-- if the bead is travelling slowly then set it as being stuck.
+		stuck'		
+		 | magV vel' < 20
+		 = min beadStuckCount (stuck + 1)
+
+		 | otherwise				
+		 = max 0 (stuck - 2)
+
+	  in  Bead ix stuck' radius pos' vel'
+
+	-- walls don't move
+	| Wall{}			<- actor
+	= actor
diff --git a/Styrene/Collide.hs b/Styrene/Collide.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/Collide.hs
@@ -0,0 +1,166 @@
+-- | Physics for bead bouncing.
+module Collide where
+import World
+import Actor
+import Graphics.Gloss.Picture	(Point)
+import Graphics.Gloss.Geometry
+
+-- Config -----------------------------------------------------------------------------------------
+-- How bouncy the beads are
+--	at 0.2 and they look like melting plastic.
+--	at 0.8 and they look like bouncy rubber balls.
+--	at > 1 and they gain energy with each bounce and escape the box.
+--
+beadBeadLoss	= 0.95
+beadWallLoss	= 0.8
+
+
+-- | Move a bead which is in contact with a wall.
+collideBeadWall
+	:: Actor	-- ^ the bead 
+	-> Actor	-- ^ the wall that bead is in contact with
+	-> Actor	-- ^ the new bead
+
+collideBeadWall
+	bead@(Bead ix _ radius pBead vIn@(velX, velY))
+	wall@(Wall _ pWall1 pWall2)
+
+ = let	-- Take the collision point as being the point on the wall which is 
+ 	-- closest to the bead's center.
+	pCollision	= closestPointOnLine pWall1 pWall2 pBead
+ 
+	-- then do a static, non energy transfering collision.
+  in	collideBeadPoint_static 
+		bead 
+		pCollision
+		beadWallLoss
+
+
+-- | Move two beads which have bounced into each other.
+collideBeadBead_elastic
+	:: Actor -> Actor
+	-> (Actor, Actor)
+
+collideBeadBead_elastic
+	bead1@(Bead ix1 mode1 r1 p1 v1)	
+	bead2@(Bead ix2 mode2 r2 p2 v2)
+
+ = let	mass1	= 1
+	mass2	= 1
+
+	-- the axis of collision (towards p2)
+	vCollision@(cX, cY)	= normaliseV (p2 - p1)
+	vCollisionR		= (cY, -cX)
+	
+	-- the velocity component of each bead along the axis of collision
+	s1	= dotV v1 vCollision
+	s2	= dotV v2 vCollision
+
+	-- work out new velocities along the collision
+	s1'	= (s1 * (mass1 - mass2) + 2 * mass2 * s2) / (mass1 + mass2)
+	s2'	= (s2 * (mass2 - mass1) + 2 * mass1 * s1) / (mass1 + mass2)
+	
+	-- the velocity components at right angles to the collision
+	--	there is no friction in the collision so these don't change
+	k1	= dotV v1 vCollisionR
+	k2	= dotV v2 vCollisionR
+	
+	-- new bead velocities
+	v1'	= mulSV s1' vCollision + mulSV k1 vCollisionR
+	v2'	= mulSV s2' vCollision + mulSV k2 vCollisionR
+
+	v1_slow	= mulSV beadBeadLoss v1'
+	v2_slow	= mulSV beadBeadLoss v2'
+
+	-- work out the point of collision
+	u1	= r1 / (r1 + r2)
+	u2	= r2 / (r1 + r2)
+
+	pCollision	
+		= p1 + mulSV u1 (p2 - p1)
+
+	-- place the beads just next to each other so they are no longer overlapping.
+	p1'	= pCollision - (r1 + 0.001) `mulSV` vCollision
+	p2'	= pCollision + (r2 + 0.001) `mulSV` vCollision
+
+	bead1'	= Bead ix1 mode1 r1 p1' v1_slow
+	bead2'	= Bead ix2 mode2 r2 p2' v2_slow
+
+   in 	(bead1', bead2')
+
+
+collideBeadBead_static
+	:: Actor -> Actor 
+	-> Actor
+	
+collideBeadBead_static
+	bead1@(Bead ix1 _ radius1 pBead1 _)
+	bead2@(Bead ix2 _ radius2 pBead2 _)
+
+ = let	-- Take the collision point as being between the center's of the two beads. 
+	-- For beads which have the same radius the collision point is half way between
+	-- their centers and u == 0.5
+	u		= radius1 / (radius1 + radius2)
+	pCollision	= pBead1 + mulSV u (pBead2 - pBead1)
+		
+	bead1'		= collideBeadPoint_static
+		  		bead1
+				pCollision
+				beadBeadLoss
+   in	bead1'
+
+
+-- | Move a bead which has collided with something.
+collideBeadPoint_static
+	:: Actor	-- ^ the bead which collided with something
+	-> Point	-- ^ the point of collision (should be near the bead's surface)
+	-> Float	-- ^ velocity scaling factor (how much to slow the bead down after the collision)
+	-> Actor
+
+collideBeadPoint_static
+	bead@(Bead ix mode radius pBead vIn)	
+	pCollision
+	velLoss
+ = let
+	-- take a normal vector from the wall to the bead.
+	--	this vector is at a right angle to the wall.
+	vNormal		= normaliseV (pBead - pCollision)
+	
+	-- the bead at pBead is overlapping with what it collided with, but we don't want that.
+	-- 	place the bead so it's surface is just next to the point of collision.
+	pBead_new	= pCollision + (radius + 0.01) `mulSV` vNormal
+
+	-- work out the angle of incidence for the bounce.
+	--	this is the angle between the surface normal and
+	--	the direction of travel for the bead.
+	aInc		= angleVV vNormal (negate vIn)
+
+	-- aInc2 is the angle between the wall /surface/ and
+	--	the direction of travel.
+	aInc2		= (pi / 2) - aInc
+
+	-- take the determinant between the surface normal and the direction of travel.
+	--	This will tell us what direction the bead hit the wall. 
+	--	The diagram shows the sign of the determinant for the four possiblities.
+	--
+	--           \ +ve                                -ve /
+	--            \                                      /
+	--             \/                                  \/
+	--   pWall1 ---------- pWall2           pWall1 ---------- pWall2
+	--             /\                                  /\
+	--            /                                      \
+ 	--           / -ve                                +ve \
+	--
+	determinant	= detV vIn vNormal
+
+	-- Use the determinant to rotate the bead's velocity vector for the bounce.
+	vOut		
+	 | determinant > 0	= rotateV (2 * aInc2) vIn
+	 | otherwise		= rotateV (negate (2 * aInc2)) vIn
+
+	-- Slow down the bead when it hits the wall
+	vSlow		= velLoss `mulSV` vOut
+
+	bead1_new	= Bead ix mode radius pBead_new vSlow
+
+   in  	bead1_new
diff --git a/Styrene/Config.hs b/Styrene/Config.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/Config.hs
@@ -0,0 +1,46 @@
+
+module Config where
+import Graphics.Gloss
+
+-- Number of simulation steps per second of time.
+simResolution :: Int
+simResolution		= 300
+
+-- How strongly the beads are pulled down to the bottom of the screen.
+--	If this is too high wrt the simResoution then the simulation
+--	will be unstable and beads will escape the box.
+gravityCoeff :: Float
+gravityCoeff		= 300
+
+-- Whether to draw velocity vectors on beads.
+showBeadVelocity	= False
+
+-- Colors of things.
+beadColor 		= makeColor 0.5 0.5 1.0 1.0
+beadOutlineColor	= makeColor 1.0 1.0 1.0 1.0
+nodeColor		= makeColor 0.2 0.8 0.2 0.1
+leafColor		= makeColor 0.8 0.2 0.2 0.1
+
+-- The maximum depth of the quad tree.
+treeMaxDepth :: Int
+treeMaxDepth		= 4
+
+-- Size of quadtree. Should be > boxSize.
+treeSize :: Float
+treeSize		= 300
+
+-- Size of bead box.
+boxSize :: Float
+boxSize			= 280
+
+-- Bead setup.
+beadRadius, beadSpace, beadCountX, beadCountY, beadBoxSize :: Float
+
+beadRadius		= 5
+beadSpace		= 1
+beadBoxSize		= 2 * beadRadius + beadSpace
+beadCountX		= 20
+beadCountY		= 10
+
+beadStuckCount :: Int
+beadStuckCount		= 20
diff --git a/Styrene/Contact.hs b/Styrene/Contact.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/Contact.hs
@@ -0,0 +1,132 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+-- | Find actors in the world that are in contact with each other.
+module Contact where
+import World
+import QuadTree
+import Actor
+import Graphics.Gloss.Picture		(Point)
+import Graphics.Gloss.Geometry.Line
+import Data.Maybe
+import Data.List
+import GHC.Exts
+import GHC.Prim
+import Data.Map				(Map)
+import Data.Set				(Set)
+import qualified Data.Set		as Set
+import qualified Data.Map		as Map
+
+
+-- Find all pairs of actors in the world that are in contact with each other.
+findContacts 
+	:: World 
+	-> ( Set (Index, Index)		-- ^ a set of all pairs of actors that are in contact.
+	   , QuadTree Actor)		-- ^ also return the quadtree so we can draw it in the window.
+	   
+findContacts (World actors _)
+ = let	
+	-- the initial tree has no actors in it and has a
+	--	size of 300 (with is half the width of the box).
+   	treeInit	= treeZero 300
+
+	-- insert all the actors into the quadtree.
+	tree'		= Map.fold insertActor treeInit actors
+
+	-- the potential contacts are lists of actors
+	--	that _might_ be in contact.
+	potentialContacts
+			= treeElems tree'
+
+	-- filter the lists of potential contacts to determine the actors
+	--	which are _actually_ in contact.
+	contactSet	= makeContacts potentialContacts
+	
+   in 	(contactSet, tree')
+  	
+
+-- | Make add all these test pairs to a map
+--	normalise so the actor with the lowest ix is first in the pair.
+
+makeContacts :: [[Actor]] -> Set (Index, Index)
+makeContacts contactLists
+ 	= makeContacts' Set.empty contactLists 
+
+makeContacts' acc xx
+ = case xx of
+	-- no more potentials to add, return the current contact set
+	[]	-> acc
+
+	-- add pairs of actors that are actually in contact to the contact set
+	(list : lists)
+	 	-> makeContacts' (makeTests acc list) lists
+	
+makeTests acc []		= acc
+makeTests acc (x:xs)
+	= makeTests (makeTests1 acc x xs) xs
+	
+makeTests1 acc a1 []		= acc
+makeTests1 acc a1 (a2 : as)
+	| inContact a1 a2
+	= let	k1		= actorIx a1
+		k2		= actorIx a2
+		contact		= (min k1 k2, max k1 k2)
+		acc'		= Set.insert contact acc
+	  in	makeTests1 acc' a1 as
+	
+	| otherwise
+	= makeTests1 acc a1 as
+	
+
+-- See if these two actors are in contact
+inContact :: Actor -> Actor -> Bool
+inContact a1 a2
+	| isBead a1 && isWall a2	= inContact_beadWall a1 a2
+	| isWall a1 && isBead a2	= inContact_beadWall a2 a1
+	| isBead a1 && isBead a2	= inContact_beadBead a1 a2
+	| otherwise			= False
+
+
+-- | Check whether a bead is in contact with a wall.
+inContact_beadWall :: Actor -> Actor -> Bool
+inContact_beadWall 
+	bead@(Bead ix mode radius pBead _) 
+	wall@(Wall _  pWall1 pWall2)
+
+ = let	-- work out the point on the infinite line between pWall1 and pWall2
+	--	which is closest to the bead.
+ 	pClosest	= closestPointOnLine pWall1 pWall2 pBead
+
+	-- the distance between the bead center and pClosest 
+	--	needs to be less than the bead radius for them to touch.
+	!(F# radius#)	= radius
+	closeEnough	= distancePP_contact pBead pClosest `ltFloat#` radius#
+
+	-- uParam gives where pClosest is relative to the endponts of the wall
+	uParam		= closestPointOnLine_param pWall1 pWall2 pBead
+
+	-- pClosest needs to lie on the line segment between pWal1 and pWall2
+	inSegment	= uParam >= 0 && uParam <= 1
+
+   in	closeEnough && inSegment
+
+
+-- | Check whether a bead is in concat with another bead.
+inContact_beadBead :: Actor -> Actor -> Bool
+inContact_beadBead 
+	bead1@(Bead ix1 _ radius1 pBead1 _) 
+	bead2@(Bead ix2 _ radius2 pBead2 _)
+ =let 	!dist#	  = distancePP_contact pBead1 pBead2
+	!(F# rad) = radius1 + radius2
+   in	(dist# `ltFloat#` rad ) && (dist# `gtFloat#` 0.1#)
+
+
+-- | Return the distance between these two points.
+{-# INLINE distancePP_contact #-}
+distancePP_contact :: Point -> Point -> Float#
+distancePP_contact (F# x1, F# y1) (F# x2, F# y2)
+	= sqrtFloat# (xd2 `plusFloat#` yd2)
+	where	!xd	= x2 `minusFloat#` x1
+		!xd2	= xd `timesFloat#` xd
+
+		!yd	= y2 `minusFloat#` y1
+		!yd2	= yd `timesFloat#` yd	
diff --git a/Styrene/Main.hs b/Styrene/Main.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/Main.hs
@@ -0,0 +1,114 @@
+
+import Actor
+import Advance
+import QuadTree
+import Contact
+import Collide
+import World
+import Config
+
+import Graphics.Gloss
+import Graphics.Gloss.Geometry
+import Graphics.Gloss.Shapes 
+
+import qualified Data.Map	as Map
+import Data.Map			(Map)
+
+main 
+  = 	simulateInWindow 
+		"Polystyrene - right-click-drag rotates"
+		(600, 600)	-- x and y size of window (in pixels).
+		(10, 10)	-- position of window
+		black		-- background color
+		simResolution	-- simulation resolution  (number of steps to take for each second of time)
+		worldInit	-- the initial world.
+		drawWorld	-- a function to convert the world to a Picture.
+		advanceWorld	-- a function to advance the world to the next simulation step.
+
+-- Draw --------------------------------------------------------------------------------------------
+
+-- | Draw this world as a picture.
+drawWorld :: World -> Picture
+drawWorld (World actors tree)
+ = let 
+	-- split the list of actors into beads and walls.
+	--	this lets us draw all the beads at once without having to keep changing 
+	--	the current color (which is a bit of a performance improvement)
+	(beads, walls)	= splitActors $ Map.elems actors
+   
+	picBeads	= Color beadColor $ Pictures $ map drawActor beads
+	picWalls	= Pictures $ map drawActor walls
+	picTree		= drawQuadTree tree
+
+   in 	Scale 0.8 0.8
+	$ Pictures [picTree, picWalls, picBeads]
+
+
+-- | Split actors into beads and walls
+splitActors :: [Actor] -> ([Actor], [Actor])
+splitActors as
+	= splitActors' [] [] as
+
+splitActors' accBeads accWalls []		
+	= (accBeads, accWalls)
+
+splitActors' accBeads accWalls (a : as) 	
+ = case a of
+ 	Bead{}	-> splitActors' (a : accBeads) accWalls as
+	Wall{}	-> splitActors' accBeads (a : accWalls) as
+
+
+-- | Draw an actor as a picture.
+drawActor :: Actor -> Picture 
+drawActor actor 
+ = case actor of
+ 	Bead ix mode radius p@(posX, posY) v@(velX, velY)
+	 -> Translate posX posY $ Pictures [bead, vel]
+	 where	bead 	= circleFilled radius 10
+		vel	= if showBeadVelocity
+				then Color red $ Line [(0, 0), mulSV 0.1 v]
+				else Blank
+{-		color
+		 | mode >= beadStuckCount	= red
+		 | otherwise			= beadColor
+-}			
+	Wall _ p1 p2
+		-> Color (greyN 0.8) $ Line [p1, p2]
+
+
+-- | Draw a quadtree as a picture
+drawQuadTree :: QuadTree a -> Picture
+drawQuadTree tree 
+ = case tree of
+	QNode p size tTL tTR tBL tBR
+	 ->  Pictures
+		[ drawQuadTree tTL 
+		, drawQuadTree tTR
+		, drawQuadTree tBL
+		, drawQuadTree tBR
+		, nodeBox p size nodeColor ]
+
+	QLeaf p size elems
+	 -> nodeBox p size leafColor
+	 
+	QNil (x0, y0) size
+	 -> Blank
+
+nodeBox p@(x0, y0) size color
+ 	= Color color
+	$ Translate x0 y0
+	$ rectangleWire (size*2) (size*2)
+
+
+-- Make a circle of radius r consisting of n lines.
+circleFilled :: Float -> Float -> Picture
+circleFilled r n
+ 	= Scale r r
+	$ Polygon (circlePoints n)
+	
+	
+-- A list of n points spaced equally around the unit circle.
+circlePoints :: Float -> [(Float, Float)]
+circlePoints n
+ =	map 	(\d -> (cos d, sin d))
+		[0, 2*pi / n .. 2*pi]
diff --git a/Styrene/QuadTree.hs b/Styrene/QuadTree.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/QuadTree.hs
@@ -0,0 +1,90 @@
+
+module QuadTree 
+	( QuadTree(..)
+	, treeZero
+	, treeInsert
+	, treeElems )
+where
+import Graphics.Gloss.Picture	(Point)
+
+data QuadTree a
+	-- Nil cells take up space in the world, but don't contain any elements.
+	--	They can be at any depth in the tree.
+	= QNil	!Point		-- cell center point 
+		!Float		-- cell size
+
+	-- Leaf cells are the only ones that contain elements.
+	--	They are always at the bottom of the tree.
+	| QLeaf !Point		-- cell center point 
+		!Float 		-- cell size
+		![a]		-- elements in this cell
+
+	-- Node cells contain more sub-trees
+	| QNode	!Point		-- cell center point
+		!Float		-- cell size
+		!(QuadTree a) !(QuadTree a)	-- NW NE
+		!(QuadTree a) !(QuadTree a)	-- SW SE
+		
+	deriving (Eq, Show)
+
+
+-- Initial -----------------------------------------------------------------------------------------
+treeZero size
+	= QNil (0, 0) size
+
+-- Quadrant ----------------------------------------------------------------------------------------
+
+-- | Insert an element with a bounding box into the tree
+treeInsert 
+	:: Int		-- ^ maximum depth to place a leaf
+	-> Int		-- ^ current depth
+	-> Point	-- ^ bottom left of bounding box of new element
+	-> Point	-- ^ top right of bounding box of new element
+	-> a		-- ^ element to insert into tree
+	-> QuadTree a	-- ^ current tree
+	-> QuadTree a
+
+treeInsert depthMax depth p0@(x0, y0) p1@(x1, y1) a tree
+ = case tree of
+ 	QNode p@(x, y) size tNW tNE tSW tSE
+	 -> let	
+	 
+	 	tNW'	| y1 > y && x0 < x	= treeInsert depthMax (depth + 1) p0 p1 a tNW
+			| otherwise		= tNW
+
+		tNE'	| y1 > y && x1 > x	= treeInsert depthMax (depth + 1) p0 p1 a tNE
+			| otherwise		= tNE
+
+		tSW'	| y0 < y && x0 < x	= treeInsert depthMax (depth + 1) p0 p1 a tSW
+			| otherwise		= tSW
+
+		tSE'	| y0 < y && x1 > x	= treeInsert depthMax (depth + 1) p0 p1 a tSE
+			| otherwise		= tSE
+	 	
+	    in	QNode p size tNW' tNE' tSW' tSE'
+		
+	QLeaf p@(x, y) size elems
+	 | depth >= depthMax
+	 -> QLeaf p size (a : elems)
+	 
+	QNil p@(x, y) size
+	 | depth >= depthMax
+	 -> QLeaf p size [a]
+	 
+	 | otherwise
+	 -> treeInsert depthMax depth p0 p1 a
+	 	(let s2	= size / 2
+		 in  QNode p size 
+	 		(QNil (x - s2, y + s2) s2) (QNil (x + s2, y + s2) s2)
+			(QNil (x - s2, y - s2) s2) (QNil (x + s2, y - s2) s2))
+
+
+-- flatten a quadtree into a list of its elements.
+treeElems :: QuadTree a -> [[a]]
+treeElems tree 
+ = case tree of
+ 	QNode _ _ tNW tNE tSW tSE
+	 -> treeElems tNW ++ treeElems tNE ++ treeElems tSW ++ treeElems tSE
+	
+	QLeaf _ _ elems	 -> [elems]
+	QNil{}		 -> []
diff --git a/Styrene/World.hs b/Styrene/World.hs
new file mode 100644
--- /dev/null
+++ b/Styrene/World.hs
@@ -0,0 +1,90 @@
+{-# 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
+	
diff --git a/Tree/Main.hs b/Tree/Main.hs
new file mode 100644
--- /dev/null
+++ b/Tree/Main.hs
@@ -0,0 +1,58 @@
+
+-- | Tree Fractal.
+--	Based on ANUPlot code by Clem Baker-Finch.
+--	
+import Graphics.Gloss
+
+main =  animateInWindow
+		"Tree"
+		(500, 650) 
+		(20,  20)
+		black
+		(picture 4)
+
+
+-- The picture is a tree fractal, graded from brown to green
+picture :: Int -> Float -> Picture	
+picture degree time
+	= Translate 0 (-300)
+	$ tree degree time (dim $ dim brown)
+
+
+-- Basic stump shape
+stump :: Color -> Picture
+stump color 
+	= Color color
+	$ Polygon [(30,0), (15,300), (-15,300), (-30,0)]
+
+
+-- Make a tree fractal.
+tree 	:: Int 		-- Fractal degree
+	-> Float	-- time
+	-> Color 	-- Color for the stump
+	-> Picture
+
+tree 0 time color = stump color
+tree n time color 
+ = let	smallTree 
+		= Rotate (sin time)
+		$ Scale 0.5 0.5 
+		$ tree (n-1) (- time) (greener color)
+   in	Pictures
+		[ stump color
+		, Translate 0 300 $ smallTree
+		, Translate 0 240 $ Rotate 20	 smallTree
+		, Translate 0 180 $ Rotate (-20) smallTree
+		, Translate 0 120 $ Rotate 40 	 smallTree
+		, Translate 0  60 $ Rotate (-40) smallTree ]
+		
+
+-- A starting colour for the stump
+brown :: Color
+brown =  makeColor8 139 100 35  255
+
+
+-- Make this color a little greener
+greener :: Color -> Color
+greener c = mixColors 1 10 green c
+
diff --git a/Zen/Main.hs b/Zen/Main.hs
new file mode 100644
--- /dev/null
+++ b/Zen/Main.hs
@@ -0,0 +1,68 @@
+
+-- A nifty animated fractal of a tree, superimposed on a background 
+--	of three red rectangles.
+import Graphics.Gloss
+import Graphics.Gloss.Shapes
+
+main :: IO ()
+main 
+ = 	animateInWindow 
+		"Zen" 
+		(800, 600) 
+		(5, 5)
+		(greyN 0.2)
+		frame	
+
+
+-- Produce one frame of the animation.
+frame :: Float -> Picture
+frame timeS
+ = Pictures	
+ 	-- the red rectangles
+	[ Translate 0 150 	backRec
+	, Translate 0 0		backRec
+	, Translate 0 (-150)	backRec
+
+	-- the tree
+ 	, Translate 0 (-150) $	treeFrac 7 timeS
+	]
+
+
+-- One of the red backing rectangles, with a white outline.
+backRec :: Picture
+backRec	
+ = Pictures
+	[ Color red 	(rectangleSolid 400 100)
+ 	, Color white	(rectangleWire  400 100) ]
+
+
+-- The color for the outline of the tree's branches.
+treeOutline :: Color
+treeOutline	= makeColor 0.3 0.3 1.0 1.0
+
+
+-- The color for the shading of the tree's branches.
+--	The Alpha here is set to 0.5 so the branches are partly transparent.
+treeColor :: Color
+treeColor	= makeColor 0.0 1.0 0.0 0.5
+
+
+-- The tree fractal.
+--	The position of the branches changes depending on the animation time
+--	as well as the iteration number of the fractal.
+treeFrac :: Int -> Float -> Picture
+treeFrac 0 timeS = Blank
+treeFrac n timeS
+ = Pictures
+	[ Color treeColor 	$ rectangleUpperSolid 20 300
+	, Color treeOutline	$ rectangleUpperWire  20 300
+ 	, Translate 0 30
+		$ Rotate  (200 * sin timeS / (fromIntegral n) )
+		$ Scale   0.9 0.9 
+		$ treeFrac (n-1) timeS
+
+	, Translate 0 70
+		$ Rotate  (-200 * sin timeS / (fromIntegral n))
+		$ Scale	  0.8 0.8 
+		$ treeFrac (n-1) timeS
+	]
diff --git a/gloss-examples.cabal b/gloss-examples.cabal
new file mode 100644
--- /dev/null
+++ b/gloss-examples.cabal
@@ -0,0 +1,70 @@
+Name:                gloss-examples
+Version:             1.0.0.0
+License:             MIT
+License-file:        LICENSE
+Author:              Ben Lippmeier
+Maintainer:          gloss@ouroborus.net
+Build-Type:          Simple
+Cabal-Version:       >=1.8
+Stability:           experimental
+Category:            Graphics
+Description:         
+	Examples using the gloss graphics library.
+	A mixed bag of fractals, particle simulations and cellular automata.
+
+Synopsis:            Examples using the gloss library
+
+Executable gloss-easy
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1
+  Main-is: Easy/Main.hs
+  ghc-options: -O2
+
+Executable gloss-clock
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1
+  Main-is: Clock/Main.hs
+  ghc-options: -O2
+
+Executable gloss-eden
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1, random > 1.0 && < 2.0
+  Main-is: Main.hs
+  other-modules: Cell Community World
+  hs-source-dirs: Eden
+  ghc-options: -O2
+
+Executable gloss-flake
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1
+  Main-is: Flake/Main.hs
+  ghc-options: -O2
+
+Executable gloss-hello
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1
+  Main-is: Hello/Main.hs
+  ghc-options: -O2
+
+Executable gloss-lifespan
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1, random > 1.0 && < 2.0
+  Main-is: Main.hs
+  other-modules: Cell Community World
+  hs-source-dirs: Lifespan
+  ghc-options: -O2
+
+Executable gloss-styrene
+  Build-depends: 
+        base            >= 3 && < 5,
+        gloss           >= 1.0 && < 1.1,
+        containers      >= 0.0 && < 1.0,
+        ghc-prim        >= 0.2 && < 1.0
+  Main-is: Main.hs
+  other-modules: Actor Advance Collide Config Contact QuadTree World
+  hs-source-dirs: Styrene
+  ghc-options: -O2
+
+Executable gloss-tree
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1
+  Main-is: Tree/Main.hs
+  ghc-options: -O2
+
+Executable gloss-zen
+  Build-depends: base >= 3 && < 5, gloss >= 1.0 && < 1.1
+  Main-is: Zen/Main.hs
+  ghc-options: -O2
