rotate is now working properly

vm/VM.hs

@@ -0,0 +1,82 @@
+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))

vm/vm.hs

@@ -1,80 +0,0 @@
-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
-
-applyCommand :: Unit -> Command -> Unit
-
-applyCommand (Unit members pivot) MoveW = Unit (Set.map move members) (move pivot) where
-    move (y, x) = (y - 1, x)
-
-applyCommand (Unit members pivot) MoveE = Unit (Set.map move members) (move pivot) where
-    move (y, x) = (y + 1, x)
-
-applyCommand (Unit members pivot) MoveSW = Unit (Set.map move members) (move pivot) where
-    move (y, x) = (y - ((x + 1) `mod` 2), x + 1)
-
-applyCommand (Unit members pivot) MoveSE = Unit (Set.map move members) (move pivot) where
-    move (y, x) = (y + (x `mod` 2), x + 1)
-
-applyCommand (Unit members pivot) RotateClockwise = Unit (Set.map move members) (move pivot) where
-    move (y, x) = (y + (x `mod` 2), x + 1)
-
-applyCommand (Unit members pivot) RotateCounterclockwise = Unit (Set.map move members) (move pivot) where
-    move (y, x) = (y + (x `mod` 2), x + 1)
-
-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)]
-
-testx :: (Int -> Int) -> [Bool]
-testx f = [f 0 == 2, f 1 == 3, f 2 == 3, f 3 == 4, f 2 == 2]
-
-info :: Cell -> Cell -> (Int, Int)
-info (py, px) (y, x) = (ddiag, doriz) where
-    ddiag = x - px
-    doriz = y - py + (if px `mod` 2 == 0 then ddiag + ddiag `mod` 2 else ddiag - ddiag `mod` 2) `div` 2
-
-rotate :: Cell -> Cell -> Cell
-rotate (py, px) (y, x) = (py - ddiag + doriz `div` 2, px + doriz) where
-    (ddiag, doriz) = info (py, px) (y, x)
-
-deepCheck p = quickCheckWith (stdArgs { maxSuccess = 10000 }) p
-
-testTutto = do
-        deepCheck (\pivot cell -> let r2 = rotate pivot in (r2 . r2 . r2 . r2 . r2 . r2) cell == cell)