From d9ff1942757c8a4c4cf9d5e458e96d8532294e44 Mon Sep 17 00:00:00 2001 From: Slash Date: Sat, 8 Aug 2015 00:25:54 +0200 Subject: [PATCH] rotate is now working properly --- vm/VM.hs | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ vm/vm.hs | 80 ------------------------------------------------------ 2 files changed, 82 insertions(+), 80 deletions(-) create mode 100644 vm/VM.hs delete mode 100644 vm/vm.hs diff --git a/vm/VM.hs b/vm/VM.hs new file mode 100644 index 0000000..1f81074 --- /dev/null +++ b/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)) diff --git a/vm/vm.hs b/vm/vm.hs deleted file mode 100644 index 634adf4..0000000 --- a/vm/vm.hs +++ /dev/null @@ -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)