diff --git a/Board.hs b/Board.hs
deleted file mode 100644
--- a/Board.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-module Board where
-{- Really only want to export
-
-Board, newBoard, copyBlockToBoard, removeCompleteRows, isMoveValid
--}
-
-import Helpers
-import qualified Data.Map as M
-import Data.Maybe (fromJust, isJust, isNothing)
-import Shape
-
--- A board has a map of Position to Color
-data Board = Bd { m :: M.Map Position Color, ncol:: Int, nrow:: Int}
-           deriving (Show, Eq)
-
-
-newBoard :: Int -> Int -> Board
-newBoard x y = Bd M.empty x y
-
-copyBlockToBoard :: Block -> Board -> Board
-copyBlockToBoard block
-    = copySquares (blockPositions block) (typeColor (blockType block))
-
---See about changing this to a foldl
-copySquares :: [Position] -> Color -> Board -> Board
-copySquares [] _ b = b
-copySquares (p:ps) c b = copySquares ps c (insert p c b)
-
-insert :: Position -> Color -> Board -> Board
-insert p c (Bd m x y) = Bd (M.insert p c m) x y
-
---Returns board and number of lines cleared
-removeCompleteRows :: Board -> (Board, Int)
-removeCompleteRows board = foldl removeFullRow (board, 0) [0 .. (nrow board)]
-
-removeFullRow :: (Board, Int) -> Int -> (Board, Int)
-removeFullRow (b, ls) row = if rowIsFull b row
-                            then removeFullRow (moveEverythingDown, ls + 1) row
-                            else (b, ls)
-    where moveEverythingDown = foldl (moveColumnDown row) b [0 .. (ncol b)]
-          
-moveColumnDown :: Int -> Board -> Int -> Board
-moveColumnDown row board col 
-    | row <= (nrow board) = moveColumnDown (row + 1) (moveSquare col board row) col
-    | otherwise = board
-
-moveSquare :: Int -> Board -> Int -> Board
-moveSquare x b y = mdelete (x, y + 1) newboard
-    where abvSquare = doLookup (x, y + 1) b :: Maybe Color
-          newboard  = if isNothing abvSquare
-                      then mdelete (x, y) b
-                      else insert (x, y) (fromJust abvSquare) b
-          
-
-mdelete :: Position -> Board -> Board
-mdelete p (Bd m x y) = Bd (M.delete p m) x y
-
-rowIsFull :: Board -> Int -> Bool
-rowIsFull b row = and (map test [0 .. (ncol b)])
-    where test col = isJust $ doLookup (col, row) b
-
-isMoveValid :: Block -> Board -> Bool
-isMoveValid block board = and (map test blks)
-    where blks = blockPositions block
-          test pos@(x, y) = x >= 0 && x <= (ncol board) && isFree pos
-          isFree pos = Nothing == doLookup pos board
-          
-checkBelow :: Block -> Board -> Bool
-checkBelow block board = or (map (stopBelow board) (blockPositions block))
-
-stopBelow :: Board -> Position -> Bool
-stopBelow b (x, y) = y == 0 || Nothing /= doLookup (x, y - 1) b
-
-doLookup :: Position -> Board -> Maybe Color
-doLookup p@(x,y) (Bd b nc nr) = if x<0 || y <0 || x>nc
-                               then error ("Tried to look up " ++ show x ++ "," ++ show y)
-                               else M.lookup p b
-
---test :: M.Map (Int, Int) Color
---test = M.insert (0,0) Blue $ M.insert (1,0) Blue $ M.empty
-
-typeColor :: ShapeType -> Color
-typeColor O = Red
-typeColor I = Blue
-typeColor S = Yellow
-typeColor Z = Green
-typeColor L = Purple
-typeColor J = Cyan
-typeColor T = Orange
diff --git a/BoardTest.hs b/BoardTest.hs
deleted file mode 100644
--- a/BoardTest.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-import Board
-import Helpers
-import Shape
-
-import Test.HUnit
-import Data.Maybe (isNothing, isJust)
-
-main :: IO Counts
-main = runTestTT $ TestList [first, second, third, forth, fifth]
-
-board1 :: Board
-board1 = foldl (\b p -> insert p Red b) (newBoard 2 2) [(0,0), (1,0), (2,0), (1,1)]
-
-first :: Test
-first = TestCase $ assertBool "should remove" ((isNothing $ doLookup (0,0) b')
-                                               && (isJust $ doLookup (1,0) b'))
-    where b' = removeCompleteRows board1
-
-second :: Test
-second = TestCase $ assertBool "row is full" (rowIsFull board1 0)
-
-third :: Test
-third = TestCase $ assertBool "should move" (isNothing $ doLookup (1, 1) b')
-    where b = insert (1,1) Red (newBoard 2 2)
-          b' = moveSquare 1 b 1
-
-forth :: Test
-forth = TestCase $ assertBool "should move" (isJust $ doLookup (1, 0) b')
-    where b = insert (1,1) Red (newBoard 2 2)
-          b' = moveSquare 1 b 0
-          
-board2 :: Board
-board2 = foldl (\b p -> insert p Red b) (newBoard 2 2) 
-         [(0,0), (1,0), (2,0), (0,1), (1,1), (2,1), (2,2)]
-
-fifth :: Test
-fifth = TestCase $ assertEqual "should be same" exp b
-    where b = removeCompleteRows board2
-          exp = insert (2,0) Red (newBoard 2 2)
-
diff --git a/Game.hs b/Game.hs
deleted file mode 100644
--- a/Game.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-module Game where
-{-- put this back in
-(Game,
-             newGame,
-             Color(..),
-             addBlock,
-             move,
-             colorAt,
-             nrows, ncols,
-             activeBlock) where
---}
-import Shape
-import Board
-import Helpers
-
-import Monad (mplus)
-import Data.Maybe (fromJust, isJust, isNothing)
-
--- Score/Num lines/Level/isRunning
-type GameInfo = (Int, Int, Int, Bool)
-
--- board, current piece, next piece, game info
-data Game = Gm { board::Board,
-                 activeBlock::(Maybe Block),
-                 nextBlock::(Maybe Block),
-                 gameInfo::GameInfo }
-
-
-score (Gm _ _ _ (s, _, _, _)) = s
-numLines (Gm _ _ _ (_, l, _, _)) = l
-curLevel (Gm _ _ _ (_, _, lv, _)) = lv
-stillRunning (Gm _ _  _ (_, _, _, r)) = r
-
-newGame :: ShapeType -> ShapeType -> Game
-newGame ct nt = Gm (newBoard ncols nrows) c n (0,0, 0, True)
-    where c = Just $ makeBlock ct initPos
-          n = Just $ makeBlock nt initPos
-
-addBlock :: Game -> ShapeType -> Game
-addBlock (Gm b cur next (s, n, lv, _)) t = Gm b blockToUse newNext (s, n, lv, keepGoing)
-    where newBlock = makeBlock t initPos
-          keepGoing = isMoveValid newBlock b
-          (blockToUse, newNext) | keepGoing = (cur, Just newBlock)
-                                | otherwise = (cur, Just newBlock)
-
-move :: Game -> Move -> Game
-move g@(Gm b Nothing _ _) move = g
-move g@(Gm b _ Nothing _) move = g
-move g@(Gm board (Just block) (Just nextBlock) (s, n, lv, r)) move 
-     | not $ stillRunning g = g
-     | otherwise = Gm board' newblock newNext ((computeScore lv s ls), n + ls, level, r)
-     where potentialBlock = moveBlock block move
-           isValid = isMoveValid potentialBlock board
-           isFinalMove = (move == MoveDown) && checkBelow block board
-           (newblock, newNext) | isFinalMove = (Just nextBlock, Nothing)
-                               | not isValid = (Just block, Just nextBlock)
-                               | otherwise = (Just potentialBlock, Just nextBlock)
-           (board', ls)   | isFinalMove = 
-                              removeCompleteRows $ copyBlockToBoard block board
-                          | otherwise = (board, 0)
-           level | isFinalMove = (n + ls) `div` 10
-                 | otherwise = lv
-
-
-computeScore :: Int -> Int -> Int -> Int
-computeScore level oldScore numLines = oldScore + extra
-    where extra | numLines == 1 = 40 * (level + 1)
-                | numLines == 2 = 100 * (level + 1)
-                | numLines == 3 = 300 * (level + 1)
-                | numLines == 4 = 1200 * (level + 1)
-                | otherwise = 0 
-
-
-colorAt :: Game -> Position -> Maybe Color
-colorAt (Gm board block _ _) p = boardC `mplus` (block >>= blockC)
-    where 
-      boardC :: Maybe Color
-      boardC = doLookup p board
-      blockC :: Block -> Maybe Color
-      blockC c | elem p (blockPositions c) = Just . typeColor $ blockType c
-               | otherwise = Nothing
-
-instance Show Game where
-    show g = unlines $ reverse[ makeRow g y| y <- [0 .. nrows]]
-
-makeRow :: Game -> Int -> String
-makeRow g y = [showCol (colorAt g (x,y)) | x <- [0..ncols]]
-
-showCol :: Maybe Color -> Char
-showCol Nothing = '.'
-showCol (Just c) = head $ show c
-
-initPos :: Position
-initPos = (6, 20)
-
-nrows :: Int
-nrows = 20
-
-ncols :: Int
-ncols = 10
-
-
diff --git a/GameController.hs b/GameController.hs
deleted file mode 100644
--- a/GameController.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-module GameController where
-
-import Graphics.UI.SDL as SDL
-import Graphics.UI.SDL.TTF as TTF
-
-import Board
-import Game
-import Shape
-import Helpers
-import GameState
-import GraphicsInfo
-
--- Takes a list of events and a game state and returns a modified gamestate
-handleGameEvents :: [Event] -> GameState -> GameState
-handleGameEvents [] gs = gs
-handleGameEvents ((KeyUp (Keysym SDLK_q _ _)):es) gs = gs { keepGoing = False}
-handleGameEvents (e:es) gs = handleGameEvents es (gs' themove)
-    where gs' Nothing = gs
-          gs' (Just m) = gs { game = move (game gs) m }
-          themove = 
-              case e of 
-                (KeyDown (Keysym SDLK_LEFT _ _))  -> Just MoveLeft
-                (KeyDown (Keysym SDLK_RIGHT _ _)) -> Just MoveRight
-                (KeyDown (Keysym SDLK_UP _ _)) -> Just Rotate
-                (KeyDown (Keysym SDLK_DOWN _ _)) -> Just MoveDown
-                otherwise  -> Nothing
-         
-
--- Renders the current game state
-renderGameState:: GameState -> IO ()
-renderGameState gs = do
-  let gri = grInfo gs
-      g = game gs
-      s = screen gri
-      fnt = font gri
-
-  -- Clear the screen
-  worked <- fillRect s
-            Nothing
-            (Pixel 0)
-
-  title <- renderTextSolid (titlefont gri) "FALLING BLOCKS!" (Color 255 0 0)
-  blitSurface title Nothing s (Just (Rect 10 10 200 0))
-  
---  scoreMessage <- renderTextSolid fnt ("Score:" ++ (show (score g))) (Color 255 0 0)
---  blitSurface scoreMessage Nothing s (Just (Rect 220 45 200 0))
-
-  screenText "Score" fnt s 220 45
-  screenText (show $ score g) fnt s 220 70
-
-  screenText "Lines" fnt s 220 100
-  screenText (show $ numLines g) fnt s 220 125
-
-  screenText "Level" fnt s 220 155
-  screenText (show $ curLevel g) fnt s 220 190
-  
-  screenText "Next" fnt s 220 220
-  
-  sequence_ [drawBlock x (nrows - y) 20 60 (colorAt g (x, y)) gri s
-             | x <- [0..ncols], y <- [0..nrows]]
-
-  drawBlockRect (bkgdblock gri) s
-
-  drawNextBlock (nextBlock g) g gri
-
-  if not . stillRunning $ game gs
-   then do 
-     gameOver <- renderTextSolid (titlefont gri) "Game Over!" (Color 255 0 0)
-     blitSurface gameOver Nothing s (Just (Rect 50 200 200 0))
-   else return False
-
-  SDL.flip s
-
-screenText :: String -> Font -> Surface -> Int -> Int -> IO Bool
-screenText msg fnt s x y = do  
-  screenMessage <- renderTextSolid fnt msg (Color 255 0 0)
-  blitSurface screenMessage Nothing s (Just (Rect x y 200 0))
-
-
-drawNextBlock :: (Maybe Block) -> Game -> GraphicsInfo -> IO ()
-drawNextBlock Nothing _ _ = return ()
-drawNextBlock (Just b) g gri = sequence_ [drawBlock (-1 * x)
- y 250 260 
-                                        (Just . typeColor $ blockType b) gri s 
-                                            | (x, y) <- blockPos b]
-    where s = screen gri
-
-
---Change to take in coordinates
-drawBlockRect :: Surface -> Surface -> IO ()
-drawBlockRect block screen = do
-  sequence_ [db2 x y block screen | x <- [0, ncols + 2],  y <- [0..nrows + 2]]
-  sequence_ [db2 x y block screen | x <- [0 .. ncols + 2], y<- [0, nrows + 2]]
- 
-db2 :: Int -> Int -> Surface -> Surface -> IO Bool
-db2 x y block screen
-    = blitSurface block
-      Nothing 
-      screen
-      (Just (Rect ((x * 15) + 5) ((y * 15) + 45) 15 15))
-  
-
-drawBlock :: Int -> Int -> Int -> Int -> Maybe Helpers.Color -> GraphicsInfo -> Surface -> IO Bool
-drawBlock _ _ _ _ Nothing _ _ = return False
-drawBlock x y xoff yoff (Just c) gri screen
-    = blitSurface
-      (getBlockSurface gri c)
-      Nothing 
-      screen
-      (Just (Rect ((x * 15)+ xoff) ((y * 15) + yoff) 15 15))
diff --git a/GameState.hs b/GameState.hs
deleted file mode 100644
--- a/GameState.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module GameState where
-
-import Game
-import GraphicsInfo
-import Graphics.UI.SDL as SDL
-import Graphics.UI.SDL.Mixer as Mix
-
-data GameState = GameState { 
-      grInfo :: GraphicsInfo,
-      game   :: Game,
-      ticks   :: Int,
-      keepGoing :: Bool,
-      mus :: Music,
-      curController :: ([Event] -> GameState -> GameState),
-      curRenderer :: (GameState -> IO ()),
-      paused :: Bool
-    }
-
-doRender :: GameState -> IO ()
-doRender gs = (curRenderer gs) gs
-
-handleEvents :: [Event] -> GameState -> GameState
-handleEvents es gs = (curController gs) es gs
diff --git a/GameTest.hs b/GameTest.hs
deleted file mode 100644
--- a/GameTest.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-import Game
-import Shape
-import Helpers
-
-import Test.HUnit
-
-main :: IO Counts
-main = runTestTT $ TestList testCases
-
-assertList :: [([Position], Game)]
-assertList = [([(5,20), (6,20), (7,20), (6,19)], (addBlock newGame T)),
-              ([(5,19), (6,19), (7,19), (6,18)], move (addBlock newGame T) MoveDown)]
-
-testCases :: [Test]
-testCases = map t assertList
-    where t (poslist, game) = 
-              TestCase $ assertBool (show poslist) (hasColorsHere poslist game)      
-
-hasColorsHere :: [Position] -> Game -> Bool
-hasColorsHere ps g = and (map test ps)
-    where test p = Nothing /= colorAt g p
diff --git a/GraphicsInfo.hs b/GraphicsInfo.hs
deleted file mode 100644
--- a/GraphicsInfo.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-module GraphicsInfo where
-
-import Graphics.UI.SDL as SDL
-import Graphics.UI.SDL.TTF as TTF
-
-import Helpers
-
-makeGraphics :: IO GraphicsInfo
-makeGraphics = do
-  redblock <- loadBMP "redblock.bmp"
-  blueblock <- loadBMP "blueblock.bmp"
-  yellowblock <- loadBMP "yellowblock.bmp"
-  greenblock <- loadBMP "greenblock.bmp"
-  purpleblock <- loadBMP "purpleblock.bmp"
-  cyanblock <- loadBMP "cyanblock.bmp"
-  orangeblock <- loadBMP "orangeblock.bmp"
-
-  greyblock <- loadBMP "greyblock.bmp"
-  font <- openFont "Joystix.ttf" 16
-  titlefont <- openFont "Joystix.ttf" 20
-  screen <- getVideoSurface
-
-  return $ GraphicsInfo screen 
-             (BS redblock 
-                 blueblock
-                 yellowblock
-                 greenblock
-                 purpleblock
-                 cyanblock
-                 orangeblock
-             ) 
-             greyblock font titlefont
-
-cleanupGraphics :: GraphicsInfo -> IO ()
-cleanupGraphics gi = do
-  freeSurface $ screen gi
-  let bs = blocks gi
-           
-  freeSurface $ redBlock bs
-  freeSurface $ blueBlock bs
-  freeSurface $ yellowBlock bs
-  freeSurface $ greenBlock bs
-  freeSurface $ purpleBlock bs
-  freeSurface $ cyanBlock bs
-  freeSurface $ orangeBlock bs
-
-  closeFont $ font gi
-  closeFont $ titlefont gi
-
-data BlockSurfaces = BS {
-      redBlock :: Surface,
-      blueBlock :: Surface,
-      yellowBlock :: Surface,
-      greenBlock :: Surface,
-      purpleBlock :: Surface,
-      cyanBlock :: Surface,
-      orangeBlock :: Surface
-    }
-
-
-data GraphicsInfo = GraphicsInfo {
-      screen :: Surface,
-      blocks  :: BlockSurfaces,
-      bkgdblock :: Surface,
-      font   :: Font,
-      titlefont :: Font
-    }
-
-getBlockSurface :: GraphicsInfo -> Helpers.Color -> Surface
-getBlockSurface gi c = g $ blocks gi
-    where g | c == Red = redBlock
-            | c == Blue = blueBlock
-            | c == Yellow = yellowBlock
-            | c == Green = greenBlock
-            | c == Purple = purpleBlock
-            | c == Cyan = cyanBlock
-            | c == Orange = orangeBlock
diff --git a/Helpers.hs b/Helpers.hs
deleted file mode 100644
--- a/Helpers.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Helpers where
-
--- | The ways a piece can move
-data Move = MoveLeft | MoveRight | MoveDown | Rotate
-            deriving (Eq, Show)
-
-
--- | Position: (col, row)
-type Position = (Int, Int)
-
-data Color = Red | Blue | Yellow | Green | Purple | Cyan | Orange
-           deriving (Eq)
-instance Show Color where
-    show _ = "X"
diff --git a/Joystix.ttf b/Joystix.ttf
deleted file mode 100644
Binary files a/Joystix.ttf and /dev/null differ
diff --git a/README b/README
deleted file mode 100644
--- a/README
+++ /dev/null
@@ -1,1 +0,0 @@
-This is the readme file.  Put stuff here.
diff --git a/Shape.hs b/Shape.hs
deleted file mode 100644
--- a/Shape.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-module Shape (ShapeType(..), 
-              Block,
-              makeBlock,
-              moveBlock,
-              blockType,
-              blockPositions,
-              blockPos) where
-
-import Helpers
-
--- | The various shape types
-data ShapeType = O | I | S | Z | L | J | T
-                 deriving (Eq, Show, Enum)
-
-type ShapeConfig = [Position]
-
-rotations :: ShapeType -> [ShapeConfig]
-rotations O = [[(-1, -1), (0, -1), (-1, 0), (0,0)]]
-rotations I = [[(-2, 0), (-1, 0), (0,0), (1,0)],
-               [(0, -2), (0, -1), (0,0), (0, 1)]]
-rotations S = [[(-1, -1), (0,-1), (0,0), (1,0)],
-               [(1, -1), (1, 0), (0,0), (0,1)]]
-rotations Z = [[(-1, 0), (0,0), (0,-1), (1, -1)],
-               [(0, -1), (0,0), (1, 0), (1,1)]]
-rotations L = [[(-1, -1), (-1, 0), (0,0), (1,0)],
-               [(0,-1), (1, -1), (0,0), (0, 1)],
-               [(-1, 0), (0,0), (1,0), (1,1)],
-               [(0,-1), (0,0), (0,1), (-1,1)]]
-rotations J = [[(-1,0), (0,0), (1,0), (1,-1)],
-               [(0,-1), (0,0), (0,1), (1,1)],
-               [(-1,0), (-1,1), (0,0), (1,0)],
-               [(-1,-1), (0,-1), (0,0), (0,1)]]
-rotations T = [[(-1,0), (0,0), (0,-1), (1,0)],
-               [(0,-1), (0,0), (0,1), (1,0)],
-               [(-1,0), (0,0), (1,0), (0,1)],
-               [(-1,0), (0,0), (0,-1), (0,1)]]
-
--- | A falling block.  Knows its current shape, 
---   its current position, and the list of future shapes (rotations)
-data Block = Blk ShapeType Position [ShapeConfig]
-
-instance Show Block where
-    show (Blk t p (c:cs)) = (show t) ++ " " ++ (show p) ++ " " ++ (show c)
-
--- | Given a ShapeType and an initial position, create a new block
-makeBlock :: ShapeType -> Position -> Block
-makeBlock t p = Blk t p rots
-    where rots = cycle $ rotations t
-
--- | Move a block
-moveBlock :: Block -> Move -> Block
-moveBlock (Blk t p (c:cs)) Rotate = Blk t p cs
-moveBlock (Blk t p cs) m = Blk t p' cs
-    where p' | m == MoveLeft = addPos p (-1, 0)
-             | m == MoveRight = addPos p (1, 0)
-             | m == MoveDown = addPos p (0, -1)
-
-addPos :: Position -> Position -> Position
-addPos (x, y) (x', y') = (x + x', y + y')
-
-blockType :: Block -> ShapeType
-blockType (Blk s _ _) = s
-
--- | Given a block, get the positions it occupies
-blockPositions :: Block -> [Position]
-blockPositions (Blk _ p (c:cs)) = map (addPos p) c
-
-blockPos :: Block -> [Position]
-blockPos (Blk _ _ (c:cs)) = c
diff --git a/ShapeTest.hs b/ShapeTest.hs
deleted file mode 100644
--- a/ShapeTest.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-import Shape
-import Helpers
-
-import Test.HUnit
-import List (sort)
-import Monad (unless)
-
-main :: IO Counts
-main = runTestTT $ TestList testCases 
-
-movecases = [((makeBlock T initPos), [(20,20), (19, 20), (21, 20), (20, 19)])]
-
-testCases :: [Test]
-testCases = map t movecases
-    where t (block, ps) = 
-              TestCase (assertRightPos ("expected " ++ show ps ++ " got " ++ show block) ps block)
-
-initPos = (20, 20)
--- Helper functions
-doMoves :: ShapeType -> [Move] -> Block
-doMoves t moves = doMHelper (makeBlock t initPos) moves
-    where doMHelper block [] = block
-          doMHelper block (p:ps) = doMHelper (moveBlock block p) ps
-
-assertRightPos :: String -> [Position] -> Block -> Assertion
-assertRightPos msg exp b = assertSamePos msg exp (blockPositions b)
-
-assertSamePos :: String -> [Position] -> [Position] -> Assertion
-assertSamePos msg exp act = unless (samePos exp act) (assertFailure msg)
- 
-samePos :: [Position] -> [Position] -> Bool
-samePos exp act = (sort exp) == (sort act)
diff --git a/SplashController.hs b/SplashController.hs
deleted file mode 100644
--- a/SplashController.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module SplashController where
-
-import Graphics.UI.SDL as SDL
-import Graphics.UI.SDL.TTF as TTF
-import GameState
-import GraphicsInfo
-import GameController
-
-handleSplashEvents :: [Event] -> GameState -> GameState
-handleSplashEvents ((KeyUp _):_) gs = gs { curController = handleGameEvents, 
-                                           curRenderer = renderGameState,
-                                           paused = False}
-handleSplashEvents _ gs = gs
-
-
-renderSplashScreen :: GameState -> IO ()
-renderSplashScreen gs = do
-  let gri = grInfo gs
-      s = screen gri
-  title <- renderTextSolid (titlefont gri) "FALLING BLOCKS!" (Color 255 0 0)
-  blitSurface title Nothing s (Just (Rect 10 100 200 0))
-
-  subtext <- renderTextSolid (font gri) "press any key" (Color 255 0 0)
-  blitSurface subtext Nothing s (Just (Rect 60 150 200 0))
-
-  SDL.flip s
-  return ()
diff --git a/blueblock.bmp b/blueblock.bmp
deleted file mode 100644
Binary files a/blueblock.bmp and /dev/null differ
diff --git a/cyanblock.bmp b/cyanblock.bmp
deleted file mode 100644
Binary files a/cyanblock.bmp and /dev/null differ
diff --git a/data/Joystix.ttf b/data/Joystix.ttf
new file mode 100644
Binary files /dev/null and b/data/Joystix.ttf differ
diff --git a/data/blueblock.bmp b/data/blueblock.bmp
new file mode 100644
Binary files /dev/null and b/data/blueblock.bmp differ
diff --git a/data/cyanblock.bmp b/data/cyanblock.bmp
new file mode 100644
Binary files /dev/null and b/data/cyanblock.bmp differ
diff --git a/data/greenblock.bmp b/data/greenblock.bmp
new file mode 100644
Binary files /dev/null and b/data/greenblock.bmp differ
diff --git a/data/greyblock.bmp b/data/greyblock.bmp
new file mode 100644
Binary files /dev/null and b/data/greyblock.bmp differ
diff --git a/data/music.mp3 b/data/music.mp3
new file mode 100644
Binary files /dev/null and b/data/music.mp3 differ
diff --git a/data/orangeblock.bmp b/data/orangeblock.bmp
new file mode 100644
Binary files /dev/null and b/data/orangeblock.bmp differ
diff --git a/data/purpleblock.bmp b/data/purpleblock.bmp
new file mode 100644
Binary files /dev/null and b/data/purpleblock.bmp differ
diff --git a/data/redblock.bmp b/data/redblock.bmp
new file mode 100644
Binary files /dev/null and b/data/redblock.bmp differ
diff --git a/data/yellowblock.bmp b/data/yellowblock.bmp
new file mode 100644
Binary files /dev/null and b/data/yellowblock.bmp differ
diff --git a/fallingblocks.cabal b/fallingblocks.cabal
--- a/fallingblocks.cabal
+++ b/fallingblocks.cabal
@@ -1,5 +1,5 @@
 Name:                fallingblocks
-Version:             0.1.2
+Version:             0.1.3
 Synopsis:            A fun falling blocks game.
 Description:         A game where blocks of different shapes fall down the screen.  If you
 		     either fill an entire line or get four of the same color in a row,
@@ -9,11 +9,16 @@
 Author:              Ben Sanders
 Copyright:	     (c) 2009 by Ben Sanders
 Maintainer:          Ben Sanders <bwsanders@gmail.com>
-Build-Depends:       base, SDL, haskell98, containers, SDL-ttf, SDL-mixer >= 0.5.5
 Build-Type:	     Simple
+Cabal-Version: 	     >= 1.2
 Category:	     Game
-data-files:          music.mp3, Joystick.ttf, blueblock.bmp,  cyanblock.bmp,  greenblock.bmp,  greyblock.bmp,  orangeblock.bmp,  purpleblock.bmp,  redblock.bmp,  yellowblock.bmp
-extra-source-files:  Board.hs, GameController.hs,  GameState.hs,  GraphicsInfo.hs, Game.hs, Helpers.hs, Shape.hs,  SplashController.hs
+Data-Files:	     data/blueblock.bmp, data/cyanblock.bmp, data/greenblock.bmp, data/greyblock.bmp, 
+		     data/orangeblock.bmp, data/purpleblock.bmp, data/redblock.bmp, data/yellowblock.bmp,
+		     data/music.mp3, data/Joystix.ttf
 
-Executable:          fallingblocks
-Main-is:             main.hs
+Executable fallingblocks
+  Main-is:        main.hs
+  other-modules:  Board, BoardTest, GameController, Game, GameState, GameTest, GraphicsInfo, 
+                  Helpers, Shape, ShapeTest, SplashController
+  hs-source-dirs: src
+  Build-Depends:  base, SDL, haskell98, containers, SDL-ttf, SDL-mixer >= 0.5.5
diff --git a/greenblock.bmp b/greenblock.bmp
deleted file mode 100644
Binary files a/greenblock.bmp and /dev/null differ
diff --git a/greyblock.bmp b/greyblock.bmp
deleted file mode 100644
Binary files a/greyblock.bmp and /dev/null differ
diff --git a/main.hs b/main.hs
deleted file mode 100644
--- a/main.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-import Paths_fallingblocks
-import Graphics.UI.SDL as SDL
-import Graphics.UI.SDL.TTF as TTF
-
-import Graphics.UI.SDL.Mixer as Mix
-
-import Game
-import Shape
-import Helpers
-import Board 
-
-import GameController
-import SplashController
-
-import GameState
-
-import Random (randomRIO)
-import Data.Maybe (isNothing)
-
-import GraphicsInfo
-
-main = do
-  SDL.init [InitEverything]
-  setVideoMode 400 400 32 []
-  TTF.init
-
-  setCaption "Falling Blocks!" "Falling Blocks!" 
-
-  mworked <- openAudio 44100 AudioS16Sys 2 4096
-  music <- loadMUS =<< getDataFileName "music.mp3"
-  
-  playMusic music (-1)
-
-  gi <- makeGraphics
-
-  enableKeyRepeat 500 30
-
-  c <- getRandomType
-  n <- getRandomType
-  gameLoop (GameState gi (newGame c n) 0 True music handleSplashEvents renderSplashScreen True)
-
-
-gameLoop :: GameState -> IO ()
-gameLoop gsfirst = do
-  gs <- addPiece gsfirst
-
-  --getEvents - would like to get all events from pollEvent
-  events <- getEvents pollEvent []
-
-  --handle input
-  let gs' = handleEvents events gs
-
-  --delay - probably want something a bit more
-  --        complex here to handle refresh rate
-  delay 10
-
-  doRender gs'
-
-  if (keepGoing gs')
-    then gameLoop $ tickAndMoveIfNeeded gs'
-    else cleanUp gs'
-
-cleanUp :: GameState -> IO ()
-cleanUp gs = do
-  cleanupGraphics $ grInfo gs
-  freeMusic $ mus gs
-  closeAudio
-  TTF.quit
-  SDL.quit
-
-
-
-getRandomType :: IO ShapeType 
-getRandomType = do
-  randomRIO (0,6) >>= \i ->
-      return (toEnum i::ShapeType)
-
-addPiece :: GameState -> IO GameState
-addPiece gsfirst =
-  if isNothing . nextBlock $ game gsfirst
-   then randomRIO (0,6) >>= \i -> 
-       return $ gsfirst {game = addBlock (game gsfirst) (toEnum i::ShapeType)}
-   else return gsfirst
-
-tickAndMoveIfNeeded :: GameState -> GameState
-tickAndMoveIfNeeded gs = if ticks gs > t && (stillRunning $ game gs) && (not $ paused gs)
-                         then gs { game = move (game gs) MoveDown,
-                                   ticks = 0 }
-                         else gs { ticks = (ticks gs) + 1 }
-    where t = 40 - floor (modifier)
-          modifier = 2.3 * (fromIntegral level) :: Float
-          level = curLevel $ game gs
-
-
--- collects a list of all outstanding events from SDL
-getEvents :: IO Event -> [Event] -> IO [Event]
-getEvents pEvent es = do
-  e <- pEvent
-  let hasEvent = e /= NoEvent
-  if hasEvent
-   then getEvents pEvent (e:es)
-   else return (reverse es)
-
-
diff --git a/music.mp3 b/music.mp3
deleted file mode 100644
Binary files a/music.mp3 and /dev/null differ
diff --git a/orangeblock.bmp b/orangeblock.bmp
deleted file mode 100644
Binary files a/orangeblock.bmp and /dev/null differ
diff --git a/purpleblock.bmp b/purpleblock.bmp
deleted file mode 100644
Binary files a/purpleblock.bmp and /dev/null differ
diff --git a/redblock.bmp b/redblock.bmp
deleted file mode 100644
Binary files a/redblock.bmp and /dev/null differ
diff --git a/src/Board.hs b/src/Board.hs
new file mode 100644
--- /dev/null
+++ b/src/Board.hs
@@ -0,0 +1,89 @@
+module Board where
+{- Really only want to export
+
+Board, newBoard, copyBlockToBoard, removeCompleteRows, isMoveValid
+-}
+
+import Helpers
+import qualified Data.Map as M
+import Data.Maybe (fromJust, isJust, isNothing)
+import Shape
+
+-- A board has a map of Position to Color
+data Board = Bd { m :: M.Map Position Color, ncol:: Int, nrow:: Int}
+           deriving (Show, Eq)
+
+
+newBoard :: Int -> Int -> Board
+newBoard x y = Bd M.empty x y
+
+copyBlockToBoard :: Block -> Board -> Board
+copyBlockToBoard block
+    = copySquares (blockPositions block) (typeColor (blockType block))
+
+--See about changing this to a foldl
+copySquares :: [Position] -> Color -> Board -> Board
+copySquares [] _ b = b
+copySquares (p:ps) c b = copySquares ps c (insert p c b)
+
+insert :: Position -> Color -> Board -> Board
+insert p c (Bd m x y) = Bd (M.insert p c m) x y
+
+--Returns board and number of lines cleared
+removeCompleteRows :: Board -> (Board, Int)
+removeCompleteRows board = foldl removeFullRow (board, 0) [0 .. (nrow board)]
+
+removeFullRow :: (Board, Int) -> Int -> (Board, Int)
+removeFullRow (b, ls) row = if rowIsFull b row
+                            then removeFullRow (moveEverythingDown, ls + 1) row
+                            else (b, ls)
+    where moveEverythingDown = foldl (moveColumnDown row) b [0 .. (ncol b)]
+          
+moveColumnDown :: Int -> Board -> Int -> Board
+moveColumnDown row board col 
+    | row <= (nrow board) = moveColumnDown (row + 1) (moveSquare col board row) col
+    | otherwise = board
+
+moveSquare :: Int -> Board -> Int -> Board
+moveSquare x b y = mdelete (x, y + 1) newboard
+    where abvSquare = doLookup (x, y + 1) b :: Maybe Color
+          newboard  = if isNothing abvSquare
+                      then mdelete (x, y) b
+                      else insert (x, y) (fromJust abvSquare) b
+          
+
+mdelete :: Position -> Board -> Board
+mdelete p (Bd m x y) = Bd (M.delete p m) x y
+
+rowIsFull :: Board -> Int -> Bool
+rowIsFull b row = and (map test [0 .. (ncol b)])
+    where test col = isJust $ doLookup (col, row) b
+
+isMoveValid :: Block -> Board -> Bool
+isMoveValid block board = and (map test blks)
+    where blks = blockPositions block
+          test pos@(x, y) = x >= 0 && x <= (ncol board) && isFree pos
+          isFree pos = Nothing == doLookup pos board
+          
+checkBelow :: Block -> Board -> Bool
+checkBelow block board = or (map (stopBelow board) (blockPositions block))
+
+stopBelow :: Board -> Position -> Bool
+stopBelow b (x, y) = y == 0 || Nothing /= doLookup (x, y - 1) b
+
+doLookup :: Position -> Board -> Maybe Color
+doLookup p@(x,y) (Bd b nc nr) = if x<0 || y <0 || x>nc
+                               then error ("Tried to look up " ++ show x ++ "," ++ show y)
+                               else M.lookup p b
+
+--test :: M.Map (Int, Int) Color
+--test = M.insert (0,0) Blue $ M.insert (1,0) Blue $ M.empty
+
+typeColor :: ShapeType -> Color
+typeColor O = Red
+typeColor I = Blue
+typeColor S = Yellow
+typeColor Z = Green
+typeColor L = Purple
+typeColor J = Cyan
+typeColor T = Orange
diff --git a/src/BoardTest.hs b/src/BoardTest.hs
new file mode 100644
--- /dev/null
+++ b/src/BoardTest.hs
@@ -0,0 +1,40 @@
+import Board
+import Helpers
+import Shape
+
+import Test.HUnit
+import Data.Maybe (isNothing, isJust)
+
+main :: IO Counts
+main = runTestTT $ TestList [first, second, third, forth, fifth]
+
+board1 :: Board
+board1 = foldl (\b p -> insert p Red b) (newBoard 2 2) [(0,0), (1,0), (2,0), (1,1)]
+
+first :: Test
+first = TestCase $ assertBool "should remove" ((isNothing $ doLookup (0,0) b')
+                                               && (isJust $ doLookup (1,0) b'))
+    where b' = removeCompleteRows board1
+
+second :: Test
+second = TestCase $ assertBool "row is full" (rowIsFull board1 0)
+
+third :: Test
+third = TestCase $ assertBool "should move" (isNothing $ doLookup (1, 1) b')
+    where b = insert (1,1) Red (newBoard 2 2)
+          b' = moveSquare 1 b 1
+
+forth :: Test
+forth = TestCase $ assertBool "should move" (isJust $ doLookup (1, 0) b')
+    where b = insert (1,1) Red (newBoard 2 2)
+          b' = moveSquare 1 b 0
+          
+board2 :: Board
+board2 = foldl (\b p -> insert p Red b) (newBoard 2 2) 
+         [(0,0), (1,0), (2,0), (0,1), (1,1), (2,1), (2,2)]
+
+fifth :: Test
+fifth = TestCase $ assertEqual "should be same" exp b
+    where b = removeCompleteRows board2
+          exp = insert (2,0) Red (newBoard 2 2)
+
diff --git a/src/Game.hs b/src/Game.hs
new file mode 100644
--- /dev/null
+++ b/src/Game.hs
@@ -0,0 +1,102 @@
+module Game where
+{-- put this back in
+(Game,
+             newGame,
+             Color(..),
+             addBlock,
+             move,
+             colorAt,
+             nrows, ncols,
+             activeBlock) where
+--}
+import Shape
+import Board
+import Helpers
+
+import Monad (mplus)
+import Data.Maybe (fromJust, isJust, isNothing)
+
+-- Score/Num lines/Level/isRunning
+type GameInfo = (Int, Int, Int, Bool)
+
+-- board, current piece, next piece, game info
+data Game = Gm { board::Board,
+                 activeBlock::(Maybe Block),
+                 nextBlock::(Maybe Block),
+                 gameInfo::GameInfo }
+
+
+score (Gm _ _ _ (s, _, _, _)) = s
+numLines (Gm _ _ _ (_, l, _, _)) = l
+curLevel (Gm _ _ _ (_, _, lv, _)) = lv
+stillRunning (Gm _ _  _ (_, _, _, r)) = r
+
+newGame :: ShapeType -> ShapeType -> Game
+newGame ct nt = Gm (newBoard ncols nrows) c n (0,0, 0, True)
+    where c = Just $ makeBlock ct initPos
+          n = Just $ makeBlock nt initPos
+
+addBlock :: Game -> ShapeType -> Game
+addBlock (Gm b cur next (s, n, lv, _)) t = Gm b blockToUse newNext (s, n, lv, keepGoing)
+    where newBlock = makeBlock t initPos
+          keepGoing = isMoveValid newBlock b
+          (blockToUse, newNext) | keepGoing = (cur, Just newBlock)
+                                | otherwise = (cur, Just newBlock)
+
+move :: Game -> Move -> Game
+move g@(Gm b Nothing _ _) move = g
+move g@(Gm b _ Nothing _) move = g
+move g@(Gm board (Just block) (Just nextBlock) (s, n, lv, r)) move 
+     | not $ stillRunning g = g
+     | otherwise = Gm board' newblock newNext ((computeScore lv s ls), n + ls, level, r)
+     where potentialBlock = moveBlock block move
+           isValid = isMoveValid potentialBlock board
+           isFinalMove = (move == MoveDown) && checkBelow block board
+           (newblock, newNext) | isFinalMove = (Just nextBlock, Nothing)
+                               | not isValid = (Just block, Just nextBlock)
+                               | otherwise = (Just potentialBlock, Just nextBlock)
+           (board', ls)   | isFinalMove = 
+                              removeCompleteRows $ copyBlockToBoard block board
+                          | otherwise = (board, 0)
+           level | isFinalMove = (n + ls) `div` 10
+                 | otherwise = lv
+
+
+computeScore :: Int -> Int -> Int -> Int
+computeScore level oldScore numLines = oldScore + extra
+    where extra | numLines == 1 = 40 * (level + 1)
+                | numLines == 2 = 100 * (level + 1)
+                | numLines == 3 = 300 * (level + 1)
+                | numLines == 4 = 1200 * (level + 1)
+                | otherwise = 0 
+
+
+colorAt :: Game -> Position -> Maybe Color
+colorAt (Gm board block _ _) p = boardC `mplus` (block >>= blockC)
+    where 
+      boardC :: Maybe Color
+      boardC = doLookup p board
+      blockC :: Block -> Maybe Color
+      blockC c | elem p (blockPositions c) = Just . typeColor $ blockType c
+               | otherwise = Nothing
+
+instance Show Game where
+    show g = unlines $ reverse[ makeRow g y| y <- [0 .. nrows]]
+
+makeRow :: Game -> Int -> String
+makeRow g y = [showCol (colorAt g (x,y)) | x <- [0..ncols]]
+
+showCol :: Maybe Color -> Char
+showCol Nothing = '.'
+showCol (Just c) = head $ show c
+
+initPos :: Position
+initPos = (6, 20)
+
+nrows :: Int
+nrows = 20
+
+ncols :: Int
+ncols = 10
+
+
diff --git a/src/GameController.hs b/src/GameController.hs
new file mode 100644
--- /dev/null
+++ b/src/GameController.hs
@@ -0,0 +1,110 @@
+module GameController where
+
+import Graphics.UI.SDL as SDL
+import Graphics.UI.SDL.TTF as TTF
+
+import Board
+import Game
+import Shape
+import Helpers
+import GameState
+import GraphicsInfo
+
+-- Takes a list of events and a game state and returns a modified gamestate
+handleGameEvents :: [Event] -> GameState -> GameState
+handleGameEvents [] gs = gs
+handleGameEvents ((KeyUp (Keysym SDLK_q _ _)):es) gs = gs { keepGoing = False}
+handleGameEvents (e:es) gs = handleGameEvents es (gs' themove)
+    where gs' Nothing = gs
+          gs' (Just m) = gs { game = move (game gs) m }
+          themove = 
+              case e of 
+                (KeyDown (Keysym SDLK_LEFT _ _))  -> Just MoveLeft
+                (KeyDown (Keysym SDLK_RIGHT _ _)) -> Just MoveRight
+                (KeyDown (Keysym SDLK_UP _ _)) -> Just Rotate
+                (KeyDown (Keysym SDLK_DOWN _ _)) -> Just MoveDown
+                otherwise  -> Nothing
+         
+
+-- Renders the current game state
+renderGameState:: GameState -> IO ()
+renderGameState gs = do
+  let gri = grInfo gs
+      g = game gs
+      s = screen gri
+      fnt = font gri
+
+  -- Clear the screen
+  worked <- fillRect s
+            Nothing
+            (Pixel 0)
+
+  title <- renderTextSolid (titlefont gri) "FALLING BLOCKS!" (Color 255 0 0)
+  blitSurface title Nothing s (Just (Rect 10 10 200 0))
+  
+--  scoreMessage <- renderTextSolid fnt ("Score:" ++ (show (score g))) (Color 255 0 0)
+--  blitSurface scoreMessage Nothing s (Just (Rect 220 45 200 0))
+
+  screenText "Score" fnt s 220 45
+  screenText (show $ score g) fnt s 220 70
+
+  screenText "Lines" fnt s 220 100
+  screenText (show $ numLines g) fnt s 220 125
+
+  screenText "Level" fnt s 220 155
+  screenText (show $ curLevel g) fnt s 220 190
+  
+  screenText "Next" fnt s 220 220
+  
+  sequence_ [drawBlock x (nrows - y) 20 60 (colorAt g (x, y)) gri s
+             | x <- [0..ncols], y <- [0..nrows]]
+
+  drawBlockRect (bkgdblock gri) s
+
+  drawNextBlock (nextBlock g) g gri
+
+  if not . stillRunning $ game gs
+   then do 
+     gameOver <- renderTextSolid (titlefont gri) "Game Over!" (Color 255 0 0)
+     blitSurface gameOver Nothing s (Just (Rect 50 200 200 0))
+   else return False
+
+  SDL.flip s
+
+screenText :: String -> Font -> Surface -> Int -> Int -> IO Bool
+screenText msg fnt s x y = do  
+  screenMessage <- renderTextSolid fnt msg (Color 255 0 0)
+  blitSurface screenMessage Nothing s (Just (Rect x y 200 0))
+
+
+drawNextBlock :: (Maybe Block) -> Game -> GraphicsInfo -> IO ()
+drawNextBlock Nothing _ _ = return ()
+drawNextBlock (Just b) g gri = sequence_ [drawBlock (-1 * x)
+ y 250 260 
+                                        (Just . typeColor $ blockType b) gri s 
+                                            | (x, y) <- blockPos b]
+    where s = screen gri
+
+
+--Change to take in coordinates
+drawBlockRect :: Surface -> Surface -> IO ()
+drawBlockRect block screen = do
+  sequence_ [db2 x y block screen | x <- [0, ncols + 2],  y <- [0..nrows + 2]]
+  sequence_ [db2 x y block screen | x <- [0 .. ncols + 2], y<- [0, nrows + 2]]
+ 
+db2 :: Int -> Int -> Surface -> Surface -> IO Bool
+db2 x y block screen
+    = blitSurface block
+      Nothing 
+      screen
+      (Just (Rect ((x * 15) + 5) ((y * 15) + 45) 15 15))
+  
+
+drawBlock :: Int -> Int -> Int -> Int -> Maybe Helpers.Color -> GraphicsInfo -> Surface -> IO Bool
+drawBlock _ _ _ _ Nothing _ _ = return False
+drawBlock x y xoff yoff (Just c) gri screen
+    = blitSurface
+      (getBlockSurface gri c)
+      Nothing 
+      screen
+      (Just (Rect ((x * 15)+ xoff) ((y * 15) + yoff) 15 15))
diff --git a/src/GameState.hs b/src/GameState.hs
new file mode 100644
--- /dev/null
+++ b/src/GameState.hs
@@ -0,0 +1,23 @@
+module GameState where
+
+import Game
+import GraphicsInfo
+import Graphics.UI.SDL as SDL
+import Graphics.UI.SDL.Mixer as Mix
+
+data GameState = GameState { 
+      grInfo :: GraphicsInfo,
+      game   :: Game,
+      ticks   :: Int,
+      keepGoing :: Bool,
+      mus :: Music,
+      curController :: ([Event] -> GameState -> GameState),
+      curRenderer :: (GameState -> IO ()),
+      paused :: Bool
+    }
+
+doRender :: GameState -> IO ()
+doRender gs = (curRenderer gs) gs
+
+handleEvents :: [Event] -> GameState -> GameState
+handleEvents es gs = (curController gs) es gs
diff --git a/src/GameTest.hs b/src/GameTest.hs
new file mode 100644
--- /dev/null
+++ b/src/GameTest.hs
@@ -0,0 +1,21 @@
+import Game
+import Shape
+import Helpers
+
+import Test.HUnit
+
+main :: IO Counts
+main = runTestTT $ TestList testCases
+
+assertList :: [([Position], Game)]
+assertList = [([(5,20), (6,20), (7,20), (6,19)], (addBlock newGame T)),
+              ([(5,19), (6,19), (7,19), (6,18)], move (addBlock newGame T) MoveDown)]
+
+testCases :: [Test]
+testCases = map t assertList
+    where t (poslist, game) = 
+              TestCase $ assertBool (show poslist) (hasColorsHere poslist game)      
+
+hasColorsHere :: [Position] -> Game -> Bool
+hasColorsHere ps g = and (map test ps)
+    where test p = Nothing /= colorAt g p
diff --git a/src/GraphicsInfo.hs b/src/GraphicsInfo.hs
new file mode 100644
--- /dev/null
+++ b/src/GraphicsInfo.hs
@@ -0,0 +1,83 @@
+module GraphicsInfo where
+
+import Graphics.UI.SDL as SDL
+import Graphics.UI.SDL.TTF as TTF
+
+import Helpers
+import Paths_fallingblocks
+
+makeGraphics :: IO GraphicsInfo
+makeGraphics = do
+  redblock <- loadBMP' "data/redblock.bmp"
+  blueblock <- loadBMP' "data/blueblock.bmp"
+  yellowblock <- loadBMP' "data/yellowblock.bmp"
+  greenblock <- loadBMP' "data/greenblock.bmp"
+  purpleblock <- loadBMP' "data/purpleblock.bmp"
+  cyanblock <- loadBMP' "data/cyanblock.bmp"
+  orangeblock <- loadBMP' "data/orangeblock.bmp"
+
+  greyblock <- loadBMP' "data/greyblock.bmp"
+  font <- openFont' "data/Joystix.ttf" 16
+  titlefont <- openFont' "data/Joystix.ttf" 20
+  screen <- getVideoSurface
+
+  return $ GraphicsInfo screen 
+             (BS redblock 
+                 blueblock
+                 yellowblock
+                 greenblock
+                 purpleblock
+                 cyanblock
+                 orangeblock
+             ) 
+             greyblock font titlefont
+      where
+        loadBMP' f = loadBMP =<< getDataFileName f
+        openFont' f n = do
+                 file <- getDataFileName f
+                 openFont file n
+
+cleanupGraphics :: GraphicsInfo -> IO ()
+cleanupGraphics gi = do
+  freeSurface $ screen gi
+  let bs = blocks gi
+           
+  freeSurface $ redBlock bs
+  freeSurface $ blueBlock bs
+  freeSurface $ yellowBlock bs
+  freeSurface $ greenBlock bs
+  freeSurface $ purpleBlock bs
+  freeSurface $ cyanBlock bs
+  freeSurface $ orangeBlock bs
+
+  closeFont $ font gi
+  closeFont $ titlefont gi
+
+data BlockSurfaces = BS {
+      redBlock :: Surface,
+      blueBlock :: Surface,
+      yellowBlock :: Surface,
+      greenBlock :: Surface,
+      purpleBlock :: Surface,
+      cyanBlock :: Surface,
+      orangeBlock :: Surface
+    }
+
+
+data GraphicsInfo = GraphicsInfo {
+      screen :: Surface,
+      blocks  :: BlockSurfaces,
+      bkgdblock :: Surface,
+      font   :: Font,
+      titlefont :: Font
+    }
+
+getBlockSurface :: GraphicsInfo -> Helpers.Color -> Surface
+getBlockSurface gi c = g $ blocks gi
+    where g | c == Red = redBlock
+            | c == Blue = blueBlock
+            | c == Yellow = yellowBlock
+            | c == Green = greenBlock
+            | c == Purple = purpleBlock
+            | c == Cyan = cyanBlock
+            | c == Orange = orangeBlock
diff --git a/src/Helpers.hs b/src/Helpers.hs
new file mode 100644
--- /dev/null
+++ b/src/Helpers.hs
@@ -0,0 +1,14 @@
+module Helpers where
+
+-- | The ways a piece can move
+data Move = MoveLeft | MoveRight | MoveDown | Rotate
+            deriving (Eq, Show)
+
+
+-- | Position: (col, row)
+type Position = (Int, Int)
+
+data Color = Red | Blue | Yellow | Green | Purple | Cyan | Orange
+           deriving (Eq)
+instance Show Color where
+    show _ = "X"
diff --git a/src/Shape.hs b/src/Shape.hs
new file mode 100644
--- /dev/null
+++ b/src/Shape.hs
@@ -0,0 +1,69 @@
+module Shape (ShapeType(..), 
+              Block,
+              makeBlock,
+              moveBlock,
+              blockType,
+              blockPositions,
+              blockPos) where
+
+import Helpers
+
+-- | The various shape types
+data ShapeType = O | I | S | Z | L | J | T
+                 deriving (Eq, Show, Enum)
+
+type ShapeConfig = [Position]
+
+rotations :: ShapeType -> [ShapeConfig]
+rotations O = [[(-1, -1), (0, -1), (-1, 0), (0,0)]]
+rotations I = [[(-2, 0), (-1, 0), (0,0), (1,0)],
+               [(0, -2), (0, -1), (0,0), (0, 1)]]
+rotations S = [[(-1, -1), (0,-1), (0,0), (1,0)],
+               [(1, -1), (1, 0), (0,0), (0,1)]]
+rotations Z = [[(-1, 0), (0,0), (0,-1), (1, -1)],
+               [(0, -1), (0,0), (1, 0), (1,1)]]
+rotations L = [[(-1, -1), (-1, 0), (0,0), (1,0)],
+               [(0,-1), (1, -1), (0,0), (0, 1)],
+               [(-1, 0), (0,0), (1,0), (1,1)],
+               [(0,-1), (0,0), (0,1), (-1,1)]]
+rotations J = [[(-1,0), (0,0), (1,0), (1,-1)],
+               [(0,-1), (0,0), (0,1), (1,1)],
+               [(-1,0), (-1,1), (0,0), (1,0)],
+               [(-1,-1), (0,-1), (0,0), (0,1)]]
+rotations T = [[(-1,0), (0,0), (0,-1), (1,0)],
+               [(0,-1), (0,0), (0,1), (1,0)],
+               [(-1,0), (0,0), (1,0), (0,1)],
+               [(-1,0), (0,0), (0,-1), (0,1)]]
+
+-- | A falling block.  Knows its current shape, 
+--   its current position, and the list of future shapes (rotations)
+data Block = Blk ShapeType Position [ShapeConfig]
+
+instance Show Block where
+    show (Blk t p (c:cs)) = (show t) ++ " " ++ (show p) ++ " " ++ (show c)
+
+-- | Given a ShapeType and an initial position, create a new block
+makeBlock :: ShapeType -> Position -> Block
+makeBlock t p = Blk t p rots
+    where rots = cycle $ rotations t
+
+-- | Move a block
+moveBlock :: Block -> Move -> Block
+moveBlock (Blk t p (c:cs)) Rotate = Blk t p cs
+moveBlock (Blk t p cs) m = Blk t p' cs
+    where p' | m == MoveLeft = addPos p (-1, 0)
+             | m == MoveRight = addPos p (1, 0)
+             | m == MoveDown = addPos p (0, -1)
+
+addPos :: Position -> Position -> Position
+addPos (x, y) (x', y') = (x + x', y + y')
+
+blockType :: Block -> ShapeType
+blockType (Blk s _ _) = s
+
+-- | Given a block, get the positions it occupies
+blockPositions :: Block -> [Position]
+blockPositions (Blk _ p (c:cs)) = map (addPos p) c
+
+blockPos :: Block -> [Position]
+blockPos (Blk _ _ (c:cs)) = c
diff --git a/src/ShapeTest.hs b/src/ShapeTest.hs
new file mode 100644
--- /dev/null
+++ b/src/ShapeTest.hs
@@ -0,0 +1,32 @@
+import Shape
+import Helpers
+
+import Test.HUnit
+import List (sort)
+import Monad (unless)
+
+main :: IO Counts
+main = runTestTT $ TestList testCases 
+
+movecases = [((makeBlock T initPos), [(20,20), (19, 20), (21, 20), (20, 19)])]
+
+testCases :: [Test]
+testCases = map t movecases
+    where t (block, ps) = 
+              TestCase (assertRightPos ("expected " ++ show ps ++ " got " ++ show block) ps block)
+
+initPos = (20, 20)
+-- Helper functions
+doMoves :: ShapeType -> [Move] -> Block
+doMoves t moves = doMHelper (makeBlock t initPos) moves
+    where doMHelper block [] = block
+          doMHelper block (p:ps) = doMHelper (moveBlock block p) ps
+
+assertRightPos :: String -> [Position] -> Block -> Assertion
+assertRightPos msg exp b = assertSamePos msg exp (blockPositions b)
+
+assertSamePos :: String -> [Position] -> [Position] -> Assertion
+assertSamePos msg exp act = unless (samePos exp act) (assertFailure msg)
+ 
+samePos :: [Position] -> [Position] -> Bool
+samePos exp act = (sort exp) == (sort act)
diff --git a/src/SplashController.hs b/src/SplashController.hs
new file mode 100644
--- /dev/null
+++ b/src/SplashController.hs
@@ -0,0 +1,27 @@
+module SplashController where
+
+import Graphics.UI.SDL as SDL
+import Graphics.UI.SDL.TTF as TTF
+import GameState
+import GraphicsInfo
+import GameController
+
+handleSplashEvents :: [Event] -> GameState -> GameState
+handleSplashEvents ((KeyUp _):_) gs = gs { curController = handleGameEvents, 
+                                           curRenderer = renderGameState,
+                                           paused = False}
+handleSplashEvents _ gs = gs
+
+
+renderSplashScreen :: GameState -> IO ()
+renderSplashScreen gs = do
+  let gri = grInfo gs
+      s = screen gri
+  title <- renderTextSolid (titlefont gri) "FALLING BLOCKS!" (Color 255 0 0)
+  blitSurface title Nothing s (Just (Rect 10 100 200 0))
+
+  subtext <- renderTextSolid (font gri) "press any key" (Color 255 0 0)
+  blitSurface subtext Nothing s (Just (Rect 60 150 200 0))
+
+  SDL.flip s
+  return ()
diff --git a/src/main.hs b/src/main.hs
new file mode 100644
--- /dev/null
+++ b/src/main.hs
@@ -0,0 +1,103 @@
+import Graphics.UI.SDL as SDL
+import Graphics.UI.SDL.TTF as TTF
+
+import Graphics.UI.SDL.Mixer as Mix
+
+import Game
+import Shape
+import Helpers
+import Board 
+
+import GameController
+import SplashController
+
+import GameState
+
+import Random (randomRIO)
+import Data.Maybe (isNothing)
+
+import GraphicsInfo
+import Paths_fallingblocks
+
+main = do
+  SDL.init [InitEverything]
+  setVideoMode 400 400 32 []
+  TTF.init
+
+  setCaption "Falling Blocks!" "Falling Blocks!" 
+
+  mworked <- openAudio 44100 AudioS16Sys 2 4096
+  music <- loadMUS =<< getDataFileName "data/music.mp3"
+  playMusic music (-1)
+
+  gi <- makeGraphics
+
+  enableKeyRepeat 500 30
+
+  c <- getRandomType
+  n <- getRandomType
+  gameLoop (GameState gi (newGame c n) 0 True music handleSplashEvents renderSplashScreen True)
+
+
+gameLoop :: GameState -> IO ()
+gameLoop gsfirst = do
+  gs <- addPiece gsfirst
+
+  --getEvents - would like to get all events from pollEvent
+  events <- getEvents pollEvent []
+
+  --handle input
+  let gs' = handleEvents events gs
+
+  --delay - probably want something a bit more
+  --        complex here to handle refresh rate
+  delay 10
+
+  doRender gs'
+
+  if (keepGoing gs')
+    then gameLoop $ tickAndMoveIfNeeded gs'
+    else cleanUp gs'
+
+cleanUp :: GameState -> IO ()
+cleanUp gs = do
+  cleanupGraphics $ grInfo gs
+  freeMusic $ mus gs
+  closeAudio
+  TTF.quit
+  SDL.quit
+
+
+
+getRandomType :: IO ShapeType 
+getRandomType = do
+  randomRIO (0,6) >>= \i ->
+      return (toEnum i::ShapeType)
+
+addPiece :: GameState -> IO GameState
+addPiece gsfirst =
+  if isNothing . nextBlock $ game gsfirst
+   then randomRIO (0,6) >>= \i -> 
+       return $ gsfirst {game = addBlock (game gsfirst) (toEnum i::ShapeType)}
+   else return gsfirst
+
+tickAndMoveIfNeeded :: GameState -> GameState
+tickAndMoveIfNeeded gs = if ticks gs > t && (stillRunning $ game gs) && (not $ paused gs)
+                         then gs { game = move (game gs) MoveDown,
+                                   ticks = 0 }
+                         else gs { ticks = (ticks gs) + 1 }
+    where t = 40 - floor (modifier)
+          modifier = 2.3 * (fromIntegral level) :: Float
+          level = curLevel $ game gs
+
+
+-- collects a list of all outstanding events from SDL
+getEvents :: IO Event -> [Event] -> IO [Event]
+getEvents pEvent es = do
+  e <- pEvent
+  let hasEvent = e /= NoEvent
+  if hasEvent
+   then getEvents pEvent (e:es)
+   else return (reverse es)
+
+
diff --git a/yellowblock.bmp b/yellowblock.bmp
deleted file mode 100644
Binary files a/yellowblock.bmp and /dev/null differ