From d3c4ada96b8917d0edd86d0f5260bb2c1f791a1b Mon Sep 17 00:00:00 2001
From: Slash <daniele.baracchi@gmail.com>
Date: Sat, 8 Aug 2015 13:50:18 +0200
Subject: [PATCH] moar vm goodness

---
 vm/Datatypes.hs |  9 +++++++++
 vm/VM.hs        | 51 ++++++++++++++++++++++++++++++++-----------------
 2 files changed, 43 insertions(+), 17 deletions(-)

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