|
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
|