module VM where import Data.Hashable (hash, Hashable(..)) import qualified Data.List as List import Data.Set (Set) import qualified Data.Set as Set import Datatypes.Board (Board(..)) import qualified Datatypes.Board as Board import Datatypes.Cell (Cell(..)) import Datatypes.Game (Game(..)) import qualified Datatypes.Game as Game import Datatypes.Unit (Unit(..)) import qualified Datatypes.Unit as Unit data Command = MoveW | MoveE | MoveSW | MoveSE | RotateClockwise | RotateCounterclockwise deriving (Show,Eq) data Notes = OK | GameOver | Lock { rowsCleaned :: Int } | ErrorSamePosition | ErrorGameEnded deriving (Show,Eq) cmdToString :: [Command] -> String cmdToString (MoveW:cs) = 'p' : cmdToString cs cmdToString (MoveE:cs) = 'b' : cmdToString cs cmdToString (MoveSW:cs) = 'a' : cmdToString cs cmdToString (MoveSE:cs) = 'l' : cmdToString cs cmdToString (RotateClockwise:cs) = 'd' : cmdToString cs cmdToString (RotateCounterclockwise:cs) = 'k' : cmdToString cs cmdToString [] = [] moveScore :: Int -> Int -> Int -> Int moveScore size lines linesOld = points + lineBonus where points = size + 100 * ((1 + lines) * lines) `div` 2 lineBonus = if linesOld > 1 then floor (fromIntegral ((linesOld - 1) * points) / 100) else 0 checkSpawn :: Game -> Game checkSpawn game@(Game { units = [] }) = game checkSpawn game@(Game { units = (u:us), board = b }) = if u `Unit.collidesWith` b then game { Game.units = [] } else game lockUnit :: Game -> Game lockUnit game = game { board = newBoard, units = otherUnits, visitedUnits = Set.empty, oldLines = clearedLines, score = Game.score game + newScore } where (currentUnit:otherUnits) = Game.units game mergedBoard = currentUnit `Unit.mergeWith` (Game.board game) (newBoard, clearedLines) = Board.clearLines mergedBoard size = Set.size $ Unit.members currentUnit newScore = moveScore size clearedLines (Game.oldLines game) testStep = let unit = Unit (0, 0) (Set.fromList [(2,9)]) board = Board 5 10 (Set.fromList [(0,8),(1,8),(0,9),(1,9),(4,8),(3,9),(4,9)]) in step (Game board [unit] (Set.fromList []) 0 0) MoveSW testStep2 = let unit = Unit (2, 4) (Set.fromList [(0,3),(1,3),(2,3),(3,3),(1,4),(2,4),(3,4), (1,5),(2,5),(2,6)]) board = Board 6 10 (Set.fromList [(0,8),(0,9),(4,6),(3,7),(4,7),(3,8),(4,8),(2,9),(3,9),(4,9),(5,8),(5,9)]) (g1, n1) = step (Game board [unit] (Set.fromList []) 2 0) MoveSW (g2, n2) = step g1 MoveSE (g3, n3) = step g2 MoveSW (g4, n4) = step g3 MoveSW in (g4, n4) testStep3 = let unit = Unit (0, 0) (Set.fromList [(2,9)]) board = Board 5 10 (Set.fromList [(0,8),(1,8),(0,9),(1,9),(4,8),(3,9),(4,9)]) in step (Game board [unit] (Set.fromList []) 0 0) MoveSW step :: Game -> Command -> (Game, Notes) step game@(Game { units = [] }) command = (game, ErrorGameEnded) step game command = if shouldLock then if Game.completed updatedGame then (updatedGame, GameOver) else (updatedGame, Lock (Game.oldLines updatedGame)) else if Set.member (hash newUnit) (Game.visitedUnits game) then (game { units = newUnit:otherUnits }, ErrorSamePosition) else (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits }, OK) where (unit:otherUnits) = Game.units game newUnit = applyCommand unit command board = Game.board game shouldLock = newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board newVisitedUnits = Set.insert (hash newUnit) (Game.visitedUnits game) updatedGame = checkSpawn $ lockUnit game applyCommand :: Unit -> Command -> Unit applyCommand unit MoveW = Unit.map move unit where move (x, y) = (x - 1, y) applyCommand unit MoveE = Unit.map move unit where move (x, y) = (x + 1, y) applyCommand unit MoveSW = Unit.map move unit where move (x, y) = (x - ((y + 1) `mod` 2), y + 1) applyCommand unit MoveSE = Unit.map move unit where move (x, y) = (x + (y `mod` 2), y + 1) applyCommand (Unit pivot members) RotateClockwise = Unit pivot (Set.map transform members) where transform cell = rotateCell pivot cell applyCommand (Unit pivot members) RotateCounterclockwise = Unit pivot (Set.map transform members) 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