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.
82 lines
2.7 KiB
82 lines
2.7 KiB
module VM where
|
|
|
|
import Data.Set (Set)
|
|
import qualified Data.Set as Set
|
|
import Test.QuickCheck
|
|
|
|
type Cell = (Int, Int)
|
|
|
|
data Board = Board {
|
|
boardWidth :: Int,
|
|
boardHeight :: Int,
|
|
filled :: Set Cell
|
|
}
|
|
|
|
data Unit = Unit {
|
|
unitMembers :: Set Cell,
|
|
unitPivot :: Cell
|
|
}
|
|
deriving Show
|
|
|
|
data Command = MoveW
|
|
| MoveE
|
|
| MoveSW
|
|
| MoveSE
|
|
| RotateClockwise
|
|
| RotateCounterclockwise
|
|
|
|
|
|
data Game = Game Board Unit
|
|
-- data Game = Game { board :: Board, unit :: Unit }
|
|
|
|
-- isValidPosition :: Unit -> Board
|
|
|
|
data Notes = OK
|
|
| Collision
|
|
| CollisionWithRowElision
|
|
|
|
-- step :: Game -> Command -> (Game, Notes)
|
|
-- step game inst
|
|
|
|
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 + px `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
|
|
|
|
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
|
|
|
|
test :: (Cell -> Cell) -> [Bool]
|
|
test f = [f (0,3) == (2,5), f (1,3) == (3, 6), f (2,3) == (3,7), f (3, 3) == (4,8), f (2, 4) == (2,7)]
|
|
|
|
test2 :: (Cell -> Cell) -> [Bool]
|
|
test2 f = [f (2,5) == (3,6), f (3,6) == (2, 7), f (2,7) == (1,7), f (1, 7) == (1,6), f (1, 6) == (1,5), f (1, 5) == (2, 5)]
|
|
|
|
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))
|