compiles now, printing group adjacency working

This commit is contained in:
Shaun Kerr 2019-05-20 10:39:43 +12:00
parent 22bf2d1f48
commit 162a9e9c3d
2 changed files with 11 additions and 21 deletions

View File

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

View File

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