diff --git a/src/Datatypes/Game.hs b/src/Datatypes/Game.hs index 44e225b..69bfaef 100644 --- a/src/Datatypes/Game.hs +++ b/src/Datatypes/Game.hs @@ -1,9 +1,12 @@ module Datatypes.Game (Game(..), completed) where +import Data.Hashable (hash) import Data.Set (Set) +import qualified Data.Set as Set import Datatypes.Board (Board) import Datatypes.Unit (Unit) +import qualified Datatypes.Unit as Unit type UnitHash = Int @@ -18,3 +21,12 @@ data Game = Game { completed :: Game -> Bool completed game = null $ units game + +new :: Board -> [Unit] -> Game +new b us = Game { + board = b, + units = (c:cs), + visitedUnits = Set.singleton (hash c), + oldLines = 0, + score = 0 + } where (c:cs) = map (flip Unit.centeredIn b) us diff --git a/src/Datatypes/Unit.hs b/src/Datatypes/Unit.hs index 2e34190..3870a1f 100644 --- a/src/Datatypes/Unit.hs +++ b/src/Datatypes/Unit.hs @@ -1,4 +1,4 @@ -module Datatypes.Unit (Unit(..), map, collidesWith, isOutsideOf, mergeWith) where +module Datatypes.Unit (Unit(..), map, centeredIn, collidesWith, isOutsideOf, mergeWith) where import Prelude hiding (map) diff --git a/src/Strategy0.hs b/src/Strategy0.hs index 158d4d5..838da43 100644 --- a/src/Strategy0.hs +++ b/src/Strategy0.hs @@ -1,6 +1,7 @@ module Strategy0 where import Datatypes +import qualified Datatypes.Game as Game import VM seswlist = cycle [MoveSE, MoveSW] @@ -16,7 +17,7 @@ stepr game = if notes == GameOver else (1 + (fst new_step), snd new_step) where (new_game,notes) = step game MoveSE - score = points new_game + score = Game.score new_game new_step = (stepl new_game) stepl :: Game -> (Int,Int) @@ -25,6 +26,6 @@ stepl game = if notes == GameOver else (1 + (fst new_step), snd new_step) where (new_game,notes) = step game MoveSW - score = points new_game + score = Game.score new_game new_step = (stepr new_game) diff --git a/src/VM.hs b/src/VM.hs index 1f9e82b..8099ee7 100644 --- a/src/VM.hs +++ b/src/VM.hs @@ -12,6 +12,14 @@ import qualified Datatypes.Game as Game import Datatypes.Unit (Unit(..)) import qualified Datatypes.Unit as Unit +data Command = MoveW + | MoveE + | MoveSW + | MoveSE + | RotateClockwise + | RotateCounterclockwise + deriving (Show,Eq) + data Notes = OK | GameOver | Lock { rowsCleaned :: Int } @@ -28,14 +36,6 @@ cmdToString (RotateClockwise:cs) = 'd' : cmdToString cs cmdToString (RotateCounterclockwise:cs) = 'k' : cmdToString cs cmdToString [] = [] -data Command = MoveW - | MoveE - | MoveSW - | MoveSE - | RotateClockwise - | RotateCounterclockwise - deriving (Show,Eq) - moveScore :: Int -> Int -> Int -> Int moveScore size lines linesOld = points + lineBonus where points = size + 100 * ((1 + lines) * lines) `div` 2 @@ -44,28 +44,29 @@ moveScore size lines linesOld = points + lineBonus where else 0 checkSpawn :: Game -> Game -checkSpawn game@(Game _ [] _ _ _) = game -checkSpawn game@(Game board (u:us) oldPos _ _) = if u `Unit.collidesWith` board - then game { Game.units = [] } - else 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 = us, + units = otherUnits, visitedUnits = Set.empty, oldLines = clearedLines, score = Game.score game + newScore } where - (u:us) = Game.units game - mergedBoard = u `Unit.mergeWith` (Game.board game) + (currentUnit:otherUnits) = Game.units game + mergedBoard = currentUnit `Unit.mergeWith` (Game.board game) (newBoard, clearedLines) = Board.clearLines mergedBoard - size = Set.size $ Unit.members u + 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 + 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)]) @@ -77,21 +78,27 @@ testStep2 = let unit = Unit (2, 4) (Set.fromList [(0,3),(1,3),(2,3),(3,3),(1,4), 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 + in step (Game board [unit] (Set.fromList []) 0 0) MoveSW step :: Game -> Command -> (Game, Notes) -step game@(Game _ [] _ _ _) command = (game, ErrorGameEnded) -step game@(Game board (unit:us) oldPositions o l) command = - if newUnit `Unit.collidesWith` board || newUnit `Unit.isOutsideOf` board - then let final = checkSpawn (lockUnit game) in - (if Game.completed final then (final, GameOver) else (final, Lock 0)) - else - if Set.member (hash newUnit) oldPositions - then (Game board (newUnit:us) oldPositions o l, ErrorSamePosition) - else (Game board (newUnit:us) newOldPositions o l, OK) - where - newUnit = applyCommand unit command - newOldPositions = Set.insert (hash newUnit) oldPositions +step game@(Game { units = [] }) command = (game, ErrorGameEnded) +step game command = + 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 }, OK) + where + (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 applyCommand :: Unit -> Command -> Unit applyCommand unit MoveW = Unit.map move unit where