vm is now (hopefully) complete

vm/VM.hs

@@ -1,5 +1,7 @@
 module VM where
 
+import Data.Hashable (hash, Hashable(..))
+import qualified Data.List as List
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Test.QuickCheck
@@ -11,6 +13,7 @@ data Board = Board {
            boardHeight :: Int,
            filled :: Set Cell
            }
+           deriving Show
 
 data Unit = Unit {
           unitMembers :: Set Cell,
@@ -24,25 +27,66 @@ data Command = MoveW
              | MoveSE
              | RotateClockwise
              | RotateCounterclockwise
+             deriving Show
 
 
-data Game = Game Board Unit
--- data Game = Game { board :: Board, unit :: Unit }
+data Game = Game {
+          gameBoard :: Board,
+          gameUnits :: [Unit],
+          oldPositions :: Set Int
+          }
+          deriving Show
 
--- isValidPosition :: Unit -> Board
+instance Hashable Unit where
+        hashWithSalt salt (Unit members pivot) =
+            hashWithSalt salt (List.sort (Set.toList members), pivot)
 
 data Notes = OK
+           | Ended
            | Collision
            | CollisionWithRowElision
-
--- step :: Game -> Command -> (Game, Notes)
--- step game inst
+           | ErrorZero
+           deriving Show
+
+collides :: Unit -> Board -> Bool
+collides u b = not . Set.null $ Set.intersection (unitMembers u) (filled b)
+
+isInvalidFor :: Unit -> Board -> Bool
+isInvalidFor u b = any isOutside (Set.toList $ unitMembers u) where
+    isOutside (x, y) = x < 0 || x >= boardWidth b || y < 0 || y >= boardHeight b
+
+lockUnit :: Game -> Game
+lockUnit (Game board (u:us) _) = Game newBoard us (Set.fromList []) where
+    newBoard = board { filled = Set.union (unitMembers u) (filled board) }
+
+checkSpawn :: Game -> Game
+checkSpawn game@(Game _ [] _) = game
+checkSpawn game@(Game board (u:us) oldPos) = if u `collides` board
+                                                 then Game board [] oldPos
+                                                 else game
+
+isCompleted :: Game -> Bool
+isCompleted game@(Game _ [] _) = True
+isCompleted _ = False
+
+step :: Game -> Command -> (Game, Notes)
+step game@(Game _ [] _) command = (game, ErrorZero)
+step game@(Game board (unit:us) oldPositions) command =
+        if unit `collides` board || newUnit `isInvalidFor` board
+            then let final = checkSpawn (lockUnit game) in
+                (if isCompleted final then (final, Ended) else (final, OK))
+            else
+                if Set.member (hash newUnit) oldPositions
+                   then (Game board (newUnit:us) oldPositions, ErrorZero)
+                   else (Game board (newUnit:us) newOldPositions, OK)
+                   where
+                       newUnit = applyCommand unit command
+                       newOldPositions = Set.insert (hash newUnit) oldPositions
 
 applyWholeUnit :: Unit -> (Cell -> Cell) -> Unit
 applyWholeUnit (Unit members pivot) f = Unit (Set.map f members) (f pivot)
 
 applyCommand :: Unit -> Command -> Unit
-
 applyCommand unit MoveW = applyWholeUnit unit move where
     move (x, y) = (x - 1, y)
 applyCommand unit MoveE = applyWholeUnit unit move where
@@ -57,7 +101,7 @@ applyCommand (Unit members pivot) RotateCounterclockwise = Unit (Set.map transfo
     transform cell = counterRotateCell pivot cell
 
 rotateCell :: Cell -> Cell -> Cell
-rotateCell (px, py) (x, y) = (px - ddiag + (doriz + px `mod` 2) `div` 2, py + doriz) where
+rotateCell (px, py) (x, y) = (px - ddiag + (doriz + py `mod` 2) `div` 2, py + doriz) where
     (ddiag, doriz) = relativePosition (px, py) (x, y)
 
 counterRotateCell :: Cell -> Cell -> Cell
@@ -80,3 +124,13 @@ deepCheck p = quickCheckWith (stdArgs { maxSuccess = 10000 }) p
 testTutto = do
         deepCheck (\pivot cell -> let r2 = rotateCell pivot in (r2 . r2 . r2 . r2 . r2 . r2) cell == cell)
         deepCheck (\pivot cell -> cell == counterRotateCell pivot (rotateCell pivot cell))
+        deepCheck (\pivot cell -> cell == counterRotateCell2 pivot (rotateCell pivot cell))
+
+testGame = let board = Board 5 10 (Set.fromList [])
+               unit = Unit (Set.fromList [(2, 8)]) (2, 8)
+               game = Game board [unit] (Set.fromList [hash unit])
+               in game
+
+counterRotateCell2 :: Cell -> Cell -> Cell
+counterRotateCell2 (px, py) (x, y) = (px + doriz - (ddiag + px `mod` 2) `div` 2, py + ddiag - doriz) where
+    (ddiag, doriz) = relativePosition (px, py) (x, y)