You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
116 lines
4.1 KiB
116 lines
4.1 KiB
module VM where
|
|
|
|
import Data.Hashable (hash, 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,
|
|
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
|
|
|
|
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
|
|
move (x, y) = (x + 1, y)
|
|
applyCommand unit MoveSW = applyWholeUnit unit move where
|
|
move (x, y) = (x - ((y + 1) `mod` 2), y + 1)
|
|
applyCommand unit MoveSE = applyWholeUnit unit move where
|
|
move (x, y) = (x + (y `mod` 2), y + 1)
|
|
applyCommand (Unit members pivot) RotateClockwise = Unit (Set.map transform members) pivot where
|
|
transform cell = rotateCell pivot cell
|
|
applyCommand (Unit members pivot) RotateCounterclockwise = Unit (Set.map transform members) pivot where
|
|
transform cell = counterRotateCell pivot cell
|
|
|
|
rotateCell :: Cell -> Cell -> Cell
|
|
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
|
|
counterRotateCell pivot = rp . rp . rp . rp . rp where
|
|
rp = rotateCell pivot
|
|
counterRotateCell2 :: Cell -> Cell -> Cell
|
|
counterRotateCell2 (px, py) (x, y) = (px + (ddiag + doriz + py `mod` 2) `div` 2, py + ddiag - doriz) where
|
|
(ddiag, doriz) = relativePosition (px, py) (x, y)
|
|
|
|
relativePosition :: Cell -> Cell -> (Int, Int)
|
|
relativePosition (px, py) (x, y) = (diagDir, horizDir) where
|
|
diagDir = y - py
|
|
horizDir = x - px + (if py `mod` 2 == 0 then diagDir + diagDir `mod` 2 else diagDir - diagDir `mod` 2) `div` 2
|