Browse Source

[WIP] points + centering

adaptedStrategy0
Slash 9 years ago
parent
commit
a3e1ff8c7a
3 changed files with 37 additions and 3 deletions
  1. +3
    -1
      vm/Datatypes.hs
  2. +14
    -0
      vm/Tests.hs
  3. +20
    -2
      vm/VM.hs

+ 3
- 1
vm/Datatypes.hs View File

@ -31,7 +31,9 @@ data Command = MoveW
data Game = Game {
gameBoard :: Board,
gameUnits :: [Unit],
oldPositions :: Set Int
oldPositions :: Set Int,
oldLines :: Int,
points :: Int
}
deriving Show


+ 14
- 0
vm/Tests.hs View File

@ -19,6 +19,7 @@ testTutto = do
deepCheck (\pivot cell -> cell == counterRotateCell pivot (rotateCell pivot cell))
deepCheck (\pivot cell -> cell == counterRotateCell2 pivot (rotateCell pivot cell))
checkForNothing::[Maybe(Cell, Fallimento)] -> Maybe(Cell, Fallimento)
checkForNothing (Nothing:xs) = checkForNothing xs
checkForNothing ((Just v):xs) = Just v
@ -30,6 +31,19 @@ testTutteRotazioni = checkForNothing [
testDoppieRotazioni (1,5) [(1,3), (3,4), (3,6), (1,7), (0,6), (0,4), (1,3)]
]
testCentering = deepCheck (\up um um1 -> let b = Board 5 10 (Set.fromList [])
u = Unit (Set.fromList (um1:um)) up
c = centerUnit u b
bw = 5
xCoords = Set.map (\(x, y) -> x) (unitMembers c)
yCoords = Set.map (\(x, y) -> y) (unitMembers c)
unitLeft = Set.findMin xCoords
unitRight = Set.findMax xCoords
unitTop = Set.findMin yCoords
deltaLeft = unitLeft
deltaRight = bw - unitRight - 1
in (deltaLeft == deltaRight || (deltaRight - deltaLeft) == 1) && unitTop == 0)
testGame = let board = Board 5 10 (Set.fromList [])
unit = Unit (Set.fromList [(2, 8)]) (2, 8)
game = Game board [unit] (Set.fromList [hash unit])


+ 20
- 2
vm/VM.hs View File

@ -7,6 +7,19 @@ import qualified Data.Set as Set
import Datatypes
unitMap :: (Cell -> Cell) -> Unit -> Unit
unitMap f (Unit members pivot) = Unit (Set.map f members) (f pivot)
centerUnit :: Unit -> Board -> Unit
centerUnit u b = unitMap (\(x, y) -> (x + deltaX, y - unitTop)) u where
members = unitMembers u
yCoords = Set.map (\(x, y) -> y) members
xCoords = Set.map (\(x, y) -> x) members
unitTop = Set.findMin yCoords
unitLeft = Set.findMin xCoords
unitRight = Set.findMax xCoords
deltaX = (unitLeft + (boardWidth b - unitRight - 1)) `div` 2 - unitLeft
collides :: Unit -> Board -> Bool
collides u b = not . Set.null $ Set.intersection (unitMembers u) (boardFilled b)
@ -15,8 +28,13 @@ 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) _) = Game newBoard us (Set.fromList []) where
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
@ -31,7 +49,7 @@ isCompleted _ = False
step :: Game -> Command -> (Game, Notes)
step game@(Game _ [] _) command = (game, ErrorZero)
step game@(Game board (unit:us) oldPositions) command =
if unit `collides` board || newUnit `isInvalidFor` board
if newUnit `collides` board || newUnit `isInvalidFor` board
then let final = checkSpawn (lockUnit game) in
(if isCompleted final then (final, Ended) else (final, OK))
else


Loading…
Cancel
Save