diff --git a/Groups.hs b/Groups.hs index e487c69..d820bb0 100644 --- a/Groups.hs +++ b/Groups.hs @@ -46,6 +46,10 @@ adjGroups x g = filter (\y -> any (\z -> z `elem` adjFrens) y) (otherGroups x g) where adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x g) +-- The groups a group is adjacent to +neighborGroups :: Group -> Groups -> Groups +neighborGroups g gs = uniq . concat $ map (\x -> adjGroups x gs) g + -- Return the groups with C removed from its current group removeFromGroup :: MainCharacter -> Groups -> Groups removeFromGroup c g = ( [c] : (groupMinusChar c) : (otherGroups c g) ) @@ -70,17 +74,3 @@ downChar c d -- Return the Downed minus the chosen character readyChar :: MainCharacter -> Downed -> Downed readyChar c d = filter (/= c) d - -{-- --- Attract X and Y (only if adjacent) -attract :: MainCharacter -> MainCharacter -> BoardState -> BoardState -attract x y (nt,d) - | not $ y `elem` (getAdj x nt) = (nt,d) - | otherwise = attract' x y (nt,d) - --- Attract X and Y (no restrictions) -attract' :: MainCharacter -> MainCharacter -> BoardState -> BoardState -attract' x y (nt,d) - | x `elem` d = (nt, (filter (/= x) d)) - | otherwise = ((uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt)), d) ---} diff --git a/Print.hs b/Print.hs index 5be125c..7d177d4 100644 --- a/Print.hs +++ b/Print.hs @@ -9,15 +9,15 @@ printState :: BoardState -> IO () printState bs = do putStrLn "== BOARD STATE ==" putStrLn " - Groups -" - mapM_ putStrLn $ let zipGroup = zip ['A' ... ] groups in map - (\(id, x) -> id ++ " ~ [ " ++ concatGroup x ++ " ] <-> " - concatGroup x $ map snd $ filter - (\(id,y) -> foldr (||) False (map (\z -> (any x) (getAdj z groups)) y) groups) - zipGroup -(\(id, x) -> foldr (||) False (map (== x `elem` $ zipGroup + mapM_ putStrLn $ let zipGroups = zip ['A', 'B'.. ] groups in + map + (\(id, x) -> [id] ++ " ~ [ " ++ concatGroup x ++ " ] <-> " + ++ + (map fst $ filter (\(id,y) -> y `elem` (neighborGroups x groups)) zipGroups) + ) zipGroups putStrLn " - Downed -" mapM_ putStrLn $ map - (\x -> "~ " ++ show x) $ groups + (\x -> "~ " ++ show x) $ (ntDowned . bsNeoTokyo) bs putStrLn " - GameLog -" mapM_ putStrLn $ map (\x ->