icfp2015/src/VM.hs

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