diff --git a/vm/Datatypes.hs b/vm/Datatypes.hs new file mode 100644 index 0000000..da4d1cc --- /dev/null +++ b/vm/Datatypes.hs @@ -0,0 +1,47 @@ +module Datatypes where + +import Data.Hashable (Hashable(..)) +import qualified Data.List as List +import Data.Set (Set) +import qualified Data.Set as Set + +type Cell = (Int, Int) + +data Board = Board { + boardWidth :: Int, + boardHeight :: Int, + boardFilled :: Set Cell + } + deriving Show + +data Unit = Unit { + unitMembers :: Set Cell, + unitPivot :: Cell + } + deriving Show + +data Command = MoveW + | MoveE + | MoveSW + | MoveSE + | RotateClockwise + | RotateCounterclockwise + deriving Show + +data Game = Game { + gameBoard :: Board, + gameUnits :: [Unit], + oldPositions :: Set Int + } + deriving Show + +data Notes = OK + | Ended + | Collision + | CollisionWithRowElision + | ErrorZero + deriving Show + +instance Hashable Unit where + hashWithSalt salt (Unit members pivot) = + hashWithSalt salt (List.sort (Set.toList members), pivot) diff --git a/vm/Tests.hs b/vm/Tests.hs index 77bb38e..84c1d8d 100644 --- a/vm/Tests.hs +++ b/vm/Tests.hs @@ -1,3 +1,4 @@ +import Datatypes import VM import Data.Hashable (hash, Hashable(..)) @@ -46,5 +47,5 @@ testControRotazioni :: Cell -> [Cell] -> Maybe Cell testControRotazioni _ [] = Nothing testControRotazioni _ [x] = Nothing testControRotazioni pivot (x:y:xs) = if counterRotateCell pivot x == y - then testRotazioni pivot (y:xs) + then testControRotazioni pivot (y:xs) else Just x diff --git a/vm/VM.hs b/vm/VM.hs index 5e7c070..2cbaff7 100644 --- a/vm/VM.hs +++ b/vm/VM.hs @@ -5,50 +5,10 @@ import qualified Data.List as List import Data.Set (Set) import qualified Data.Set as Set -type Cell = (Int, Int) - -data Board = Board { - boardWidth :: Int, - boardHeight :: Int, - filled :: Set Cell - } - deriving Show - -data Unit = Unit { - unitMembers :: Set Cell, - unitPivot :: Cell - } - deriving Show - -data Command = MoveW - | MoveE - | MoveSW - | MoveSE - | RotateClockwise - | RotateCounterclockwise - deriving Show - - -data Game = Game { - gameBoard :: Board, - gameUnits :: [Unit], - oldPositions :: Set Int - } - deriving Show - -instance Hashable Unit where - hashWithSalt salt (Unit members pivot) = - hashWithSalt salt (List.sort (Set.toList members), pivot) - -data Notes = OK - | Ended - | Collision - | CollisionWithRowElision - | ErrorZero - deriving Show +import Datatypes collides :: Unit -> Board -> Bool -collides u b = not . Set.null $ Set.intersection (unitMembers u) (filled b) +collides u b = not . Set.null $ Set.intersection (unitMembers u) (boardFilled b) isInvalidFor :: Unit -> Board -> Bool isInvalidFor u b = any isOutside (Set.toList $ unitMembers u) where @@ -56,7 +16,7 @@ isInvalidFor u b = any isOutside (Set.toList $ unitMembers u) where lockUnit :: Game -> Game lockUnit (Game board (u:us) _) = Game newBoard us (Set.fromList []) where - newBoard = board { filled = Set.union (unitMembers u) (filled board) } + newBoard = board { boardFilled = Set.union (unitMembers u) (boardFilled board) } checkSpawn :: Game -> Game checkSpawn game@(Game _ [] _) = game