diff --git a/src/SinglePasses.hs b/src/SinglePasses.hs new file mode 100644 index 0000000..ee2bec5 --- /dev/null +++ b/src/SinglePasses.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module SinglePasses where + +import Data.Set(Set(..),difference,union,toList,empty) +import Data.Maybe +import Data.Typeable +import qualified Datatypes as DT +import qualified VM + +data Cell = Cell { x :: Int, y :: Int} + deriving (Show, Typeable) + +data Output = Output { width :: Int, + height :: Int, + filled :: [Cell], + touched :: [Cell], + unit :: [Cell], + score :: Int + } + deriving (Show, Typeable) + +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 = touchedcells touched, + unit = unitcells game, + score = DT.points game + } + filledcells gm = extractcell $ DT.filled $ DT.board gm + unitcells gm = if null $ DT.units gm + then [] + else extractunit $ head $ DT.units gm + touchedcells tc = extractcell tc + +gameswithtouched :: [(DT.Game,VM.Notes)] -> [((DT.Game,VM.Notes),Set DT.Cell)] +gameswithtouched [] = [] +gameswithtouched (x:[]) = [(x,empty)] +gameswithtouched (x:xs) = (x,touched):lastels + where + touched1 = snd $ head lastels + touched2 = if null $ DT.units $ fst $ fst $ head lastels + then empty + else DT.members $ head $ DT.units $ fst $ fst $ head lastels + touched = difference (difference (union touched1 touched2) cells) units + cells = DT.filled $ DT.board $ fst x + units = if null $ DT.units $ fst x + then empty + else DT.members $ head $ DT.units $ fst x + touchedcells tc = extractcell touched + lastels = gameswithtouched xs + +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)