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 qualified Datatypes.Cell as Cell import Datatypes.Game (Game(..), Command(..)) import qualified Datatypes.Game as Game import Datatypes.Unit (Unit(..)) import qualified Datatypes.Unit as Unit data Notes = OK | GameOver | Lock { rowsCleaned :: Int } | ErrorSamePosition | ErrorGameEnded deriving (Show,Eq) cmdToString :: [Command] -> String cmdToString [] = "" cmdToString cmds@(s:ss) = case smartConvert cmds of Just word -> word ++ cmdToString (drop (length word) cmds) Nothing -> dumbConvert s : cmdToString ss dumbConvert MoveW = 'p' dumbConvert MoveE = 'b' dumbConvert MoveSW = 'a' dumbConvert MoveSE = 'l' dumbConvert RotateClockwise = 'd' dumbConvert RotateCounterclockwise = 'k' smartConvert cmds = innerSmartConvert cmds Game.powerPhrases where innerSmartConvert _ [] = Nothing innerSmartConvert cmds (p:ps) = if p `List.isPrefixOf` cmds then Just $ Game.phraseConverter p else innerSmartConvert cmds ps 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 = initialVisitedUnits otherUnits, 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) initialVisitedUnits [] = Set.empty initialVisitedUnits (u:us) = Set.singleton (hash u) step :: Game -> Command -> (Game, Notes) step game@(Game { units = [] }) command = (game, ErrorGameEnded) step game command = let (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) { history = command:(Game.history game), phrasesCache = Game.updateCache (Game.phrasesCache game) (command:(Game.history game)) } in 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, history = command:(Game.history game), phrasesCache = Game.updateCache (Game.phrasesCache game) (command:(Game.history game))}, OK) 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 = Cell.rotateClockwise pivot cell applyCommand (Unit pivot members) RotateCounterclockwise = Unit pivot (Set.map transform members) where transform cell = Cell.rotateCounterclockwise pivot cell