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 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 (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 =
        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) }
            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) }, 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 = 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