|
@ -1,14 +1,19 @@ |
|
|
{-# LANGUAGE DeriveDataTypeable #-} |
|
|
|
|
|
module SinglePasses where |
|
|
|
|
|
|
|
|
{-# LANGUAGE DeriveGeneric #-} |
|
|
|
|
|
module SinglePasses(Output(..), Cell(..), passes) where |
|
|
|
|
|
|
|
|
import Data.Set(Set(..),difference,union,toList,empty) |
|
|
import Data.Set(Set(..),difference,union,toList,empty) |
|
|
import Data.Maybe |
|
|
import Data.Maybe |
|
|
import Data.Typeable |
|
|
import Data.Typeable |
|
|
|
|
|
import GHC.Generics |
|
|
|
|
|
import Data.Aeson |
|
|
|
|
|
import Data.Aeson.Types |
|
|
|
|
|
|
|
|
import qualified Datatypes as DT |
|
|
import qualified Datatypes as DT |
|
|
import qualified VM |
|
|
import qualified VM |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
data Cell = Cell { x :: Int, y :: Int} |
|
|
data Cell = Cell { x :: Int, y :: Int} |
|
|
deriving (Show, Typeable) |
|
|
|
|
|
|
|
|
deriving (Show, Generic) |
|
|
|
|
|
|
|
|
data Output = Output { width :: Int, |
|
|
data Output = Output { width :: Int, |
|
|
height :: Int, |
|
|
height :: Int, |
|
@ -17,7 +22,14 @@ data Output = Output { width :: Int, |
|
|
unit :: [Cell], |
|
|
unit :: [Cell], |
|
|
score :: Int |
|
|
score :: Int |
|
|
} |
|
|
} |
|
|
deriving (Show, Typeable) |
|
|
|
|
|
|
|
|
deriving (Show, Generic) |
|
|
|
|
|
|
|
|
|
|
|
instance FromJSON Cell |
|
|
|
|
|
instance ToJSON Cell |
|
|
|
|
|
|
|
|
|
|
|
instance FromJSON Output |
|
|
|
|
|
instance ToJSON Output |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
passes :: [(DT.Game, VM.Notes)] -> [Output] |
|
|
passes :: [(DT.Game, VM.Notes)] -> [Output] |
|
|
passes gamesnotes = map generateoutput (gameswithtouched gamesnotes) |
|
|
passes gamesnotes = map generateoutput (gameswithtouched gamesnotes) |
|
@ -27,7 +39,7 @@ passes gamesnotes = map generateoutput (gameswithtouched gamesnotes) |
|
|
filled = filledcells game, |
|
|
filled = filledcells game, |
|
|
touched = touchedcells touched, |
|
|
touched = touchedcells touched, |
|
|
unit = unitcells game, |
|
|
unit = unitcells game, |
|
|
score = DT.points game |
|
|
|
|
|
|
|
|
score = DT.score game |
|
|
} |
|
|
} |
|
|
filledcells gm = extractcell $ DT.filled $ DT.board gm |
|
|
filledcells gm = extractcell $ DT.filled $ DT.board gm |
|
|
unitcells gm = if null $ DT.units gm |
|
|
unitcells gm = if null $ DT.units gm |
|
@ -37,17 +49,17 @@ passes gamesnotes = map generateoutput (gameswithtouched gamesnotes) |
|
|
|
|
|
|
|
|
gameswithtouched :: [(DT.Game,VM.Notes)] -> [((DT.Game,VM.Notes),Set DT.Cell)] |
|
|
gameswithtouched :: [(DT.Game,VM.Notes)] -> [((DT.Game,VM.Notes),Set DT.Cell)] |
|
|
gameswithtouched [] = [] |
|
|
gameswithtouched [] = [] |
|
|
gameswithtouched (x:[]) = [(x,empty)] |
|
|
|
|
|
|
|
|
gameswithtouched (x:[]) = [(x,Data.Set.empty)] |
|
|
gameswithtouched (x:xs) = (x,touched):lastels |
|
|
gameswithtouched (x:xs) = (x,touched):lastels |
|
|
where |
|
|
where |
|
|
touched1 = snd $ head lastels |
|
|
touched1 = snd $ head lastels |
|
|
touched2 = if null $ DT.units $ fst $ fst $ head lastels |
|
|
touched2 = if null $ DT.units $ fst $ fst $ head lastels |
|
|
then empty |
|
|
|
|
|
|
|
|
then Data.Set.empty |
|
|
else DT.members $ head $ DT.units $ fst $ fst $ head lastels |
|
|
else DT.members $ head $ DT.units $ fst $ fst $ head lastels |
|
|
touched = difference (difference (union touched1 touched2) cells) units |
|
|
touched = difference (difference (union touched1 touched2) cells) units |
|
|
cells = DT.filled $ DT.board $ fst x |
|
|
cells = DT.filled $ DT.board $ fst x |
|
|
units = if null $ DT.units $ fst x |
|
|
units = if null $ DT.units $ fst x |
|
|
then empty |
|
|
|
|
|
|
|
|
then Data.Set.empty |
|
|
else DT.members $ head $ DT.units $ fst x |
|
|
else DT.members $ head $ DT.units $ fst x |
|
|
touchedcells tc = extractcell touched |
|
|
touchedcells tc = extractcell touched |
|
|
lastels = gameswithtouched xs |
|
|
lastels = gameswithtouched xs |
|
|