You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
70 lines
2.7 KiB
70 lines
2.7 KiB
{-# LANGUAGE DeriveGeneric #-}
|
|
module SinglePasses(Output(..), Cell(..), passes) where
|
|
|
|
import Data.Set(Set(..),difference,union,toList,empty)
|
|
import Data.Maybe
|
|
import Data.Typeable
|
|
import GHC.Generics
|
|
import Data.Aeson
|
|
import Data.Aeson.Types
|
|
|
|
import qualified Datatypes as DT
|
|
import qualified VM
|
|
|
|
|
|
data Cell = Cell { x :: Int, y :: Int}
|
|
deriving (Show, Generic)
|
|
|
|
data Output = Output { width :: Int,
|
|
height :: Int,
|
|
filled :: [Cell],
|
|
touched :: [Cell],
|
|
unit :: [Cell],
|
|
score :: Int
|
|
}
|
|
deriving (Show, Generic)
|
|
|
|
instance FromJSON Cell
|
|
instance ToJSON Cell
|
|
|
|
instance FromJSON Output
|
|
instance ToJSON Output
|
|
|
|
|
|
passes :: [(DT.Game, VM.Notes)] -> [Output]
|
|
passes gamesnotes = map generateoutput (gameswithtouched gamesnotes)
|
|
where
|
|
generateoutput ((game,note),touched) = Output { width = DT.width $ DT.board game,
|
|
height = DT.height $ DT.board game,
|
|
filled = filledcells game,
|
|
touched = extractcell touched,
|
|
unit = unitcells game,
|
|
score = DT.score game
|
|
}
|
|
filledcells gm = extractcell $ DT.filled $ DT.board gm
|
|
unitcells gm = if null $ DT.units gm
|
|
then []
|
|
else extractunit $ head $ DT.units gm
|
|
|
|
|
|
gameswithtouched :: [(DT.Game,VM.Notes)] -> [((DT.Game,VM.Notes),Set DT.Cell)]
|
|
gameswithtouched els = gameswithtouched0 els Data.Set.empty
|
|
|
|
gameswithtouched0 :: [(DT.Game,VM.Notes)] -> Set DT.Cell -> [((DT.Game,VM.Notes),Set DT.Cell)]
|
|
gameswithtouched0 [] acc = []
|
|
gameswithtouched0 (x:[]) acc = [(x,acc)]
|
|
gameswithtouched0 (x:xs) acc = (x,touched):lastels
|
|
where
|
|
touched = (difference (difference acc cells) units)
|
|
cells = DT.filled $ DT.board $ fst x
|
|
units = if null $ DT.units $ fst x
|
|
then Data.Set.empty
|
|
else DT.members $ head $ DT.units $ fst x
|
|
touchedcells tc = extractcell touched
|
|
lastels = gameswithtouched0 xs (union touched units)
|
|
|
|
extractunit :: DT.Unit -> [Cell]
|
|
extractunit unit = extractcell $ DT.members unit
|
|
|
|
extractcell :: Set DT.Cell -> [Cell]
|
|
extractcell cell = map (\(x,y) -> Cell x y) (toList cell)
|