compiles now, printing group adjacency working
This commit is contained in:
parent
22bf2d1f48
commit
162a9e9c3d
18
Groups.hs
18
Groups.hs
@ -46,6 +46,10 @@ adjGroups x g = filter (\y -> any (\z -> z `elem` adjFrens) y) (otherGroups x g)
|
|||||||
where
|
where
|
||||||
adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x g)
|
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
|
-- Return the groups with C removed from its current group
|
||||||
removeFromGroup :: MainCharacter -> Groups -> Groups
|
removeFromGroup :: MainCharacter -> Groups -> Groups
|
||||||
removeFromGroup c g = ( [c] : (groupMinusChar c) : (otherGroups c g) )
|
removeFromGroup c g = ( [c] : (groupMinusChar c) : (otherGroups c g) )
|
||||||
@ -70,17 +74,3 @@ downChar c d
|
|||||||
-- Return the Downed minus the chosen character
|
-- Return the Downed minus the chosen character
|
||||||
readyChar :: MainCharacter -> Downed -> Downed
|
readyChar :: MainCharacter -> Downed -> Downed
|
||||||
readyChar c d = filter (/= c) d
|
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)
|
|
||||||
--}
|
|
||||||
|
14
Print.hs
14
Print.hs
@ -9,15 +9,15 @@ printState :: BoardState -> IO ()
|
|||||||
printState bs = do
|
printState bs = do
|
||||||
putStrLn "== BOARD STATE =="
|
putStrLn "== BOARD STATE =="
|
||||||
putStrLn " - Groups -"
|
putStrLn " - Groups -"
|
||||||
mapM_ putStrLn $ let zipGroup = zip ['A' ... ] groups in map
|
mapM_ putStrLn $ let zipGroups = zip ['A', 'B'.. ] groups in
|
||||||
(\(id, x) -> id ++ " ~ [ " ++ concatGroup x ++ " ] <-> "
|
map
|
||||||
concatGroup x $ map snd $ filter
|
(\(id, x) -> [id] ++ " ~ [ " ++ concatGroup x ++ " ] <-> "
|
||||||
(\(id,y) -> foldr (||) False (map (\z -> (any x) (getAdj z groups)) y) groups)
|
++
|
||||||
zipGroup
|
(map fst $ filter (\(id,y) -> y `elem` (neighborGroups x groups)) zipGroups)
|
||||||
(\(id, x) -> foldr (||) False (map (== x `elem` $ zipGroup
|
) zipGroups
|
||||||
putStrLn " - Downed -"
|
putStrLn " - Downed -"
|
||||||
mapM_ putStrLn $ map
|
mapM_ putStrLn $ map
|
||||||
(\x -> "~ " ++ show x) $ groups
|
(\x -> "~ " ++ show x) $ (ntDowned . bsNeoTokyo) bs
|
||||||
putStrLn " - GameLog -"
|
putStrLn " - GameLog -"
|
||||||
mapM_ putStrLn $ map
|
mapM_ putStrLn $ map
|
||||||
(\x ->
|
(\x ->
|
||||||
|
Loading…
Reference in New Issue
Block a user