even moar refactoring

src/Datatypes/Game.hs

@@ -1,9 +1,12 @@
 module Datatypes.Game (Game(..), completed) where
 
+import Data.Hashable (hash)
 import Data.Set (Set)
+import qualified Data.Set as Set
 
 import Datatypes.Board (Board)
 import Datatypes.Unit (Unit)
+import qualified Datatypes.Unit as Unit
 
 type UnitHash = Int
 
@@ -18,3 +21,12 @@ data Game = Game {
 
 completed :: Game -> Bool
 completed game = null $ units game
+
+new :: Board -> [Unit] -> Game
+new b us = Game {
+                board = b,
+                units = (c:cs),
+                visitedUnits = Set.singleton (hash c),
+                oldLines = 0,
+                score = 0
+                } where (c:cs) = map (flip Unit.centeredIn b) us

src/Datatypes/Unit.hs

@@ -1,4 +1,4 @@
-module Datatypes.Unit (Unit(..), map, collidesWith, isOutsideOf, mergeWith) where
+module Datatypes.Unit (Unit(..), map, centeredIn, collidesWith, isOutsideOf, mergeWith) where
 
 import Prelude hiding (map)
 

src/Strategy0.hs

@@ -1,6 +1,7 @@
 module Strategy0 where
 
 import Datatypes
+import qualified Datatypes.Game as Game
 import VM
 
 seswlist = cycle [MoveSE, MoveSW]
@@ -16,7 +17,7 @@ stepr game = if notes == GameOver
              else (1 + (fst new_step), snd new_step) 
   where
     (new_game,notes) = step game MoveSE  
-    score = points new_game
+    score = Game.score new_game
     new_step = (stepl new_game)
 
 stepl :: Game -> (Int,Int)
@@ -25,6 +26,6 @@ stepl game = if notes == GameOver
              else (1 + (fst new_step), snd new_step) 
   where
     (new_game,notes) = step game MoveSW  
-    score = points new_game
+    score = Game.score new_game
     new_step = (stepr new_game)
 

src/VM.hs

@@ -12,6 +12,14 @@ import qualified Datatypes.Game as Game
 import Datatypes.Unit (Unit(..))
 import qualified Datatypes.Unit as Unit
 
+data Command = MoveW
+             | MoveE
+             | MoveSW
+             | MoveSE
+             | RotateClockwise
+             | RotateCounterclockwise
+             deriving (Show,Eq)
+
 data Notes = OK
            | GameOver
            | Lock { rowsCleaned :: Int }
@@ -28,14 +36,6 @@ cmdToString (RotateClockwise:cs) = 'd' : cmdToString cs
 cmdToString (RotateCounterclockwise:cs) = 'k' : cmdToString cs
 cmdToString [] = []
 
-data Command = MoveW
-             | MoveE
-             | MoveSW
-             | MoveSE
-             | RotateClockwise
-             | RotateCounterclockwise
-             deriving (Show,Eq)
-
 moveScore :: Int -> Int -> Int -> Int
 moveScore size lines linesOld = points + lineBonus where
     points = size + 100 * ((1 + lines) * lines) `div` 2
@@ -44,28 +44,29 @@ moveScore size lines linesOld = points + lineBonus where
                     else 0
 
 checkSpawn :: Game -> Game
-checkSpawn game@(Game _ [] _ _ _) = game
-checkSpawn game@(Game board (u:us) oldPos _ _) = if u `Unit.collidesWith` board
-                                                 then game { Game.units = [] }
-                                                 else game
+checkSpawn game@(Game { units = [] }) = game
+checkSpawn game@(Game { units = (u:us), board = b }) =
+        if u `Unit.collidesWith` b
+            then game { Game.units = [] }
+            else game
 
 lockUnit :: Game -> Game
 lockUnit game = game {
                      board = newBoard,
-                     units = us,
+                     units = otherUnits,
                      visitedUnits = Set.empty,
                      oldLines = clearedLines,
                      score = Game.score game + newScore
                      } where
-                         (u:us) = Game.units game
-                         mergedBoard = u `Unit.mergeWith` (Game.board game)
+                         (currentUnit:otherUnits) = Game.units game
+                         mergedBoard = currentUnit `Unit.mergeWith` (Game.board game)
                          (newBoard, clearedLines) = Board.clearLines mergedBoard
-                         size = Set.size $ Unit.members u
+                         size = Set.size $ Unit.members currentUnit
                          newScore = moveScore size clearedLines (Game.oldLines game)
 
 testStep = let unit = Unit (0, 0) (Set.fromList [(2,9)])
                board = Board 5 10 (Set.fromList [(0,8),(1,8),(0,9),(1,9),(4,8),(3,9),(4,9)])
-               in  step (Game board [unit] (Set.fromList []) 0 0) MoveSW 
+               in  step (Game board [unit] (Set.fromList []) 0 0) MoveSW
 
 testStep2 = let unit = Unit (2, 4) (Set.fromList [(0,3),(1,3),(2,3),(3,3),(1,4),(2,4),(3,4), (1,5),(2,5),(2,6)])
                 board = Board 6 10 (Set.fromList [(0,8),(0,9),(4,6),(3,7),(4,7),(3,8),(4,8),(2,9),(3,9),(4,9),(5,8),(5,9)])
@@ -77,21 +78,27 @@ testStep2 = let unit = Unit (2, 4) (Set.fromList [(0,3),(1,3),(2,3),(3,3),(1,4),
 
 testStep3 = let unit = Unit (0, 0) (Set.fromList [(2,9)])
                 board = Board 5 10 (Set.fromList [(0,8),(1,8),(0,9),(1,9),(4,8),(3,9),(4,9)])
-                in  step (Game board [unit] (Set.fromList []) 0 0) MoveSW 
+                in  step (Game board [unit] (Set.fromList []) 0 0) MoveSW
 
 step :: Game -> Command -> (Game, Notes)
-step game@(Game _ [] _ _ _) command = (game, ErrorGameEnded)
-step game@(Game board (unit:us) oldPositions o l) command =
-        if newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board
-            then let final = checkSpawn (lockUnit game) in
-                (if Game.completed final then (final, GameOver) else (final, Lock 0))
-            else
-                if Set.member (hash newUnit) oldPositions
-                   then (Game board (newUnit:us) oldPositions o l, ErrorSamePosition)
-                   else (Game board (newUnit:us) newOldPositions o l, OK)
-                   where
-                       newUnit = applyCommand unit command
-                       newOldPositions = Set.insert (hash newUnit) oldPositions
+step game@(Game { units = [] }) command = (game, ErrorGameEnded)
+step game command =
+        if shouldLock
+        then
+            if Game.completed updatedGame
+                then (updatedGame, GameOver)
+                else (updatedGame, Lock (Game.oldLines updatedGame))
+        else
+            if Set.member (hash newUnit) (Game.visitedUnits game)
+                then (game { units = newUnit:otherUnits }, ErrorSamePosition)
+                else (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits }, OK)
+        where
+            (unit:otherUnits) = Game.units game
+            newUnit = applyCommand unit command
+            board = Game.board game
+            shouldLock = newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board
+            newVisitedUnits = Set.insert (hash newUnit) (Game.visitedUnits game)
+            updatedGame = checkSpawn $ lockUnit game
 
 applyCommand :: Unit -> Command -> Unit
 applyCommand unit MoveW = Unit.map move unit where