diff --git a/vm/Datatypes.hs b/vm/Datatypes.hs index 24ecce8..e0cd14d 100644 --- a/vm/Datatypes.hs +++ b/vm/Datatypes.hs @@ -28,6 +28,15 @@ data Command = MoveW | RotateCounterclockwise 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 [] = [] + data Game = Game { gameBoard :: Board, gameUnits :: [Unit], diff --git a/vm/VM.hs b/vm/VM.hs index bc18443..f0e54bd 100644 --- a/vm/VM.hs +++ b/vm/VM.hs @@ -27,35 +27,52 @@ isInvalidFor :: Unit -> Board -> Bool isInvalidFor u b = any isOutside (Set.toList $ unitMembers u) where isOutside (x, y) = x < 0 || x >= boardWidth b || y < 0 || y >= boardHeight b -lockUnit :: Game -> Game -lockUnit (Game board (u:us) _ oldLines points) = Game newBoard us (Set.fromList []) newLines (newPoints + oldPoints) where - newBoard = board { boardFilled = Set.union (unitMembers u) (boardFilled board) } - newPoints = (Set.length (unitMembers u)) + (100 * (1 + newLines) * newLines `div` 2) + lineBonus - lineBonus = if oldLines > 1 - then floor ((oldLines - 1) * newPoints / 10) - else 0 - newLines = 0 - checkSpawn :: Game -> Game -checkSpawn game@(Game _ [] _) = game -checkSpawn game@(Game board (u:us) oldPos) = if u `collides` board - then Game board [] oldPos +checkSpawn game@(Game _ [] _ _ _) = game +checkSpawn game@(Game board (u:us) oldPos _ _) = if u `collides` board + then game { gameUnits = [] } else game isCompleted :: Game -> Bool -isCompleted game@(Game _ [] _) = True +isCompleted game@(Game _ [] _ _ _) = True isCompleted _ = False +clearLines :: Board -> (Board, Int) +clearLines (Board width height filled) = let (newFilled, linesDeleted) = tryToDelete yCoords 0 filled + in (Board width height newFilled, linesDeleted) + where + yCoords = Set.toList $ Set.map (\(x, y) -> y) filled + countInLine l items = Set.size $ Set.filter (\(x, y) -> y == l) items + tryToDelete (l:ls) count items = if countInLine l items == width + then tryToDelete ls (count + 1) (deleteLine l items) + else tryToDelete ls count items + tryToDelete [] count items = (items, count) + deleteLine l items = let deleted = Set.filter (\(x, y) -> y /= l) items + in Set.map (\(x, y) -> if y < l then (x, y + 1) else (x, y)) deleted + +lockUnit :: Game -> Game +lockUnit (Game board (u:us) _ oldLines oldPoints) = Game newBoard us (Set.fromList []) newLines (newPoints + oldPoints) where + tempBoard = board { boardFilled = Set.union (unitMembers u) (boardFilled board) } + (newBoard, newLines) = clearLines tempBoard + newPoints = (Set.size (unitMembers u)) + (100 * (1 + newLines) * newLines `div` 2) + lineBonus + lineBonus = if oldLines > 1 + then floor (fromIntegral ((oldLines - 1) * newPoints) / 10) + else 0 + +testStep = let unit = Unit (Set.fromList [(2,9)]) (0,0) + 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 _ [] _) command = (game, ErrorZero) -step game@(Game board (unit:us) oldPositions) command = +step game@(Game _ [] _ _ _) command = (game, ErrorZero) +step game@(Game board (unit:us) oldPositions o l) command = if newUnit `collides` board || newUnit `isInvalidFor` board then let final = checkSpawn (lockUnit game) in (if isCompleted final then (final, Ended) else (final, OK)) else if Set.member (hash newUnit) oldPositions - then (Game board (newUnit:us) oldPositions, ErrorZero) - else (Game board (newUnit:us) newOldPositions, OK) + then (Game board (newUnit:us) oldPositions o l, ErrorZero) + else (Game board (newUnit:us) newOldPositions o l, OK) where newUnit = applyCommand unit command newOldPositions = Set.insert (hash newUnit) oldPositions