|
@ -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) |