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

  1. module VM where
  2. import Data.Set (Set)
  3. import qualified Data.Set as Set
  4. import Test.QuickCheck
  5. type Cell = (Int, Int)
  6. data Board = Board {
  7. boardWidth :: Int,
  8. boardHeight :: Int,
  9. filled :: Set Cell
  10. }
  11. data Unit = Unit {
  12. unitMembers :: Set Cell,
  13. unitPivot :: Cell
  14. }
  15. deriving Show
  16. data Command = MoveW
  17. | MoveE
  18. | MoveSW
  19. | MoveSE
  20. | RotateClockwise
  21. | RotateCounterclockwise
  22. data Game = Game Board Unit
  23. -- data Game = Game { board :: Board, unit :: Unit }
  24. -- isValidPosition :: Unit -> Board
  25. data Notes = OK
  26. | Collision
  27. | CollisionWithRowElision
  28. -- step :: Game -> Command -> (Game, Notes)
  29. -- step game inst
  30. applyWholeUnit :: Unit -> (Cell -> Cell) -> Unit
  31. applyWholeUnit (Unit members pivot) f = Unit (Set.map f members) (f pivot)
  32. applyCommand :: Unit -> Command -> Unit
  33. applyCommand unit MoveW = applyWholeUnit unit move where
  34. move (x, y) = (x - 1, y)
  35. applyCommand unit MoveE = applyWholeUnit unit move where
  36. move (x, y) = (x + 1, y)
  37. applyCommand unit MoveSW = applyWholeUnit unit move where
  38. move (x, y) = (x - ((y + 1) `mod` 2), y + 1)
  39. applyCommand unit MoveSE = applyWholeUnit unit move where
  40. move (x, y) = (x + (y `mod` 2), y + 1)
  41. applyCommand (Unit members pivot) RotateClockwise = Unit (Set.map transform members) pivot where
  42. transform cell = rotateCell pivot cell
  43. applyCommand (Unit members pivot) RotateCounterclockwise = Unit (Set.map transform members) pivot where
  44. transform cell = counterRotateCell pivot cell
  45. rotateCell :: Cell -> Cell -> Cell
  46. rotateCell (px, py) (x, y) = (px - ddiag + (doriz + px `mod` 2) `div` 2, py + doriz) where
  47. (ddiag, doriz) = relativePosition (px, py) (x, y)
  48. counterRotateCell :: Cell -> Cell -> Cell
  49. counterRotateCell pivot = rp . rp . rp . rp . rp where
  50. rp = rotateCell pivot
  51. relativePosition :: Cell -> Cell -> (Int, Int)
  52. relativePosition (px, py) (x, y) = (diagDir, horizDir) where
  53. diagDir = y - py
  54. horizDir = x - px + (if py `mod` 2 == 0 then diagDir + diagDir `mod` 2 else diagDir - diagDir `mod` 2) `div` 2
  55. test :: (Cell -> Cell) -> [Bool]
  56. 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)]
  57. test2 :: (Cell -> Cell) -> [Bool]
  58. 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)]
  59. deepCheck p = quickCheckWith (stdArgs { maxSuccess = 10000 }) p
  60. testTutto = do
  61. deepCheck (\pivot cell -> let r2 = rotateCell pivot in (r2 . r2 . r2 . r2 . r2 . r2) cell == cell)
  62. deepCheck (\pivot cell -> cell == counterRotateCell pivot (rotateCell pivot cell))