From a3e1ff8c7a4c6dc9365896a679a4a89f5af59ef6 Mon Sep 17 00:00:00 2001
From: Slash <daniele.baracchi@gmail.com>
Date: Sat, 8 Aug 2015 12:54:07 +0200
Subject: [PATCH] [WIP] points + centering

---
 vm/Datatypes.hs |  4 +++-
 vm/Tests.hs     | 14 ++++++++++++++
 vm/VM.hs        | 22 ++++++++++++++++++++--
 3 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/vm/Datatypes.hs b/vm/Datatypes.hs
index bca081e..24ecce8 100644
--- a/vm/Datatypes.hs
+++ b/vm/Datatypes.hs
@@ -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
 
diff --git a/vm/Tests.hs b/vm/Tests.hs
index cdc80c0..075955e 100644
--- a/vm/Tests.hs
+++ b/vm/Tests.hs
@@ -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])
diff --git a/vm/VM.hs b/vm/VM.hs
index 2cbaff7..bc18443 100644
--- a/vm/VM.hs
+++ b/vm/VM.hs
@@ -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