You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
81 lines
3.7 KiB
81 lines
3.7 KiB
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)
|
|
|
|
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
|
|
|
|
lockUnit :: Game -> Game
|
|
lockUnit game = game {
|
|
board = newBoard,
|
|
units = newUnits otherUnits,
|
|
visitedUnits = initialVisitedUnits otherUnits,
|
|
oldLines = clearedLines,
|
|
score = Game.score game + newScore
|
|
} where
|
|
(currentUnit:otherUnits) = Game.units game
|
|
newUnits [] = []
|
|
newUnits (u:us) | u `Unit.collidesWith` newBoard = []
|
|
newUnits us = us
|
|
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 = Game.notifyCommand (lockUnit game) command
|
|
in
|
|
if shouldLock
|
|
then
|
|
if Game.isCompleted 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.notifyCommand (game { units = newUnit:otherUnits, visitedUnits = newVisitedUnits }) command, 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
|