loop :: MapGenM m
     => NameGenerator --              Name generator.
     -> Int --                        Total number of settlements to generate.
     -> Map Settlement HexCoord --    Map of already-generated settlements.
     -> Map Terrain (Set HexCoord) -- Terrain locations.
     -> Int --                        Number of generated settlements.
     -> [SettlementType] --           List of settlement types to generate.
     -> m [(Settlement, HexCoord)]
loop ng total = core
 where
   core done tm numGen []       = mgProgress 1 >> (return $ Map.toList done)
   core done tm numGen (st:sts) = do
     mgProgress $ fromIntegral numGen % fromIntegral total
     -- Look for candidate locations
     ts <- mgRequiredTerrain st
     let hs = concatMap (Set.toList . maybe Set.empty id . flip Map.lookup tm) ts
         lengthHs = length hs
     -- Select a candidate location.
     ri <- mgRandom
     let i = abs ri `mod` lengthHs
         h = hs !! i
     -- Pick a name.
     let pickloop = do
         name <- pickName ng
         let settlement = Settlement name
         if Map.member settlement done
          then pickloop
          else return settlement
     s <- pickloop
     -- Place the item.
     mgAddSettlement s st h
     let done' = Map.insert s h done
     -- Create a road if needed.
     when (not $ Map.null done) $ do
       -- Select a random, already-done settlement.
       let sizeDone = Map.size done
       ri <- mgRandom
       let i = abs ri `mod` sizeDone
           (s2, h2) = Map.toList done !! i
       -- Get the path to its location.
       let neighborM h = do
             let ns = neighbors h
             ns' <- filterM (\n -> do t <- mgGetTerrain n
                                      return $ not $ any (==t) [Sea,Freshwater])
                            ns
             return $ Set.fromList ns'
           movecost :: Terrain -> Rational
           movecost Sea        = 100000
           movecost Freshwater = 100000
           movecost Coast      = 10
           movecost Plains     = 1.7
           movecost Forest     = 5
           movecost Hill       = 5.5
           movecost Mountain   = 7
           movecostM h1 h2 = do
             -- For road to road, only 1
             r1 <- mgGetRoad h1
             r2 <- mgGetRoad h2
             if r1 && r2
              then return 1
              else do
                -- Use the larger movement cost.
                t1 <- mgGetTerrain h1
                t2 <- mgGetTerrain h2
                -- Adjust movement costs if going
                -- to a tile that is different y-coord
                -- in offset coordinates
                let (_, y1) = toOffset h1
                    (_, y2) = toOffset h2
                    (c1, c2) = (movecost t1, movecost t2)
                    (c1', c2')
                      | y1 == y2  = (c1, c2)
                      | otherwise = (c1 * 1.05, c2 * 1.05)
                return $ max c1' c2'
       Just roads <- aStarM
                       neighborM
                       movecostM
                       (return . fromIntegral . distance h)
                       (return . (==h))
                       (return h2)
       -- Fill in roads
       mapM_ (flip mgPutRoad True) roads
       mgPutRoad h True
       mgPutRoad h2 True

     -- Disallow tiles within 5 tiles of the selected tile.
     let disalloweds = Set.fromList $ nearby 5 h
         tm' = Map.map (Set.\\ disalloweds) tm

     core done' tm' (numGen+1) sts
loop :: MapGenM m
     => NameGenerator --              Name generator.
     -> Int --                        Total number of settlements to generate.
     -> Map Settlement HexCoord --    Map of already-generated settlements.
     -> Map Terrain (Set HexCoord) -- Terrain locations.
     -> Int --                        Number of generated settlements.
     -> [SettlementType] --           List of settlement types to generate.
     -> m [(Settlement, HexCoord)]
loop ng total = core
 where
   core done tm numGen []       = mgProgress 1 >> (return $ Map.toList done)
   core done tm numGen (st:sts) = do
     mgProgress $ fromIntegral numGen % fromIntegral total
     -- Look for candidate locations
     ts <- mgRequiredTerrain st
     let hs = concatMap (Set.toList . maybe Set.empty id . flip Map.lookup tm) ts
         lengthHs = length hs
     -- Select a candidate location.
     ri <- mgRandom
     let i = abs ri `mod` lengthHs
         h = hs !! i
     -- Pick a name.
     let pickloop = do
         name <- pickName ng
         let settlement = Settlement name
         if Map.member settlement done
          then pickloop
          else return settlement
     s <- pickloop
     -- Place the item.
     mgAddSettlement s st h
     let done' = Map.insert s h done
     -- Create a road if needed.
     when (not $ Map.null done) $ do
       -- Select a random, already-done settlement.
       let sizeDone = Map.size done
       ri <- mgRandom
       let i = abs ri `mod` sizeDone
           (s2, h2) = Map.toList done !! i
       -- Get the path to its location.
       let neighborM h = do
             let ns = neighbors h
             ns' <- filterM (\n -> do t <- mgGetTerrain n
                                      return $ not $ any (==t) [Sea,Freshwater])
                            ns
             return $ Set.fromList ns'
           movecost :: Terrain -> Rational
           movecost Sea        = 100000
           movecost Freshwater = 100000
           movecost Coast      = 10
           movecost Plains     = 1.7
           movecost Forest     = 5
           movecost Hill       = 5.5
           movecost Mountain   = 7
           movecostM h1 h2 = do
             -- For road to road, only 1
             r1 <- mgGetRoad h1
             r2 <- mgGetRoad h2
             if r1 && r2
              then return 1
              else do
                -- Use the larger movement cost.
                t1 <- mgGetTerrain h1
                t2 <- mgGetTerrain h2
                -- Adjust movement costs if going
                -- to a tile that is different y-coord
                -- in offset coordinates
                let (_, y1) = toOffset h1
                    (_, y2) = toOffset h2
                    (c1, c2) = (movecost t1, movecost t2)
                    (c1', c2')
                      | y1 == y2  = (c1, c2)
                      | otherwise = (c1 * 1.05, c2 * 1.05)
                return $ max c1' c2'
       Just roads <- aStarM
                       neighborM
                       movecostM
                       (return . fromIntegral . distance h)
                       (return . (==h))
                       (return h2)
       -- Fill in roads
       mapM_ (flip mgPutRoad True) roads
       mgPutRoad h True
       mgPutRoad h2 True

     -- Disallow tiles within 5 tiles of the selected tile.
     let disalloweds = Set.fromList $ nearby 5 h
         tm' = Map.map (Set.\\ disalloweds) tm

     core done' tm' (numGen+1) sts
loop ng total = core
 where
   core done tm numGen []       = mgProgress 1 >> (return $ Map.toList done)
   core done tm numGen (st:sts) = do
     mgProgress $ fromIntegral numGen % fromIntegral total
     -- Look for candidate locations
     ts <- mgRequiredTerrain st
     let hs = concatMap (Set.toList . maybe Set.empty id . flip Map.lookup tm) ts
         lengthHs = length hs
     -- Select a candidate location.
     ri <- mgRandom
     let i = abs ri `mod` lengthHs
         h = hs !! i
     -- Pick a name.
     let pickloop = do
         name <- pickName ng
         let settlement = Settlement name
         if Map.member settlement done
          then pickloop
          else return settlement
     s <- pickloop
     -- Place the item.
     mgAddSettlement s st h
     let done' = Map.insert s h done
     -- Create a road if needed.
     when (not $ Map.null done) $ do
       -- Select a random, already-done settlement.
       let sizeDone = Map.size done
       ri <- mgRandom
       let i = abs ri `mod` sizeDone
           (s2, h2) = Map.toList done !! i
       -- Get the path to its location.
       let neighborM h = do
             let ns = neighbors h
             ns' <- filterM (\n -> do t <- mgGetTerrain n
                                      return $ not $ any (==t) [Sea,Freshwater])
                            ns
             return $ Set.fromList ns'
           movecost :: Terrain -> Rational
           movecost Sea        = 100000
           movecost Freshwater = 100000
           movecost Coast      = 10
           movecost Plains     = 1.7
           movecost Forest     = 5
           movecost Hill       = 5.5
           movecost Mountain   = 7
           movecostM h1 h2 = do
             -- For road to road, only 1
             r1 <- mgGetRoad h1
             r2 <- mgGetRoad h2
             if r1 && r2
              then return 1
              else do
                -- Use the larger movement cost.
                t1 <- mgGetTerrain h1
                t2 <- mgGetTerrain h2
                -- Adjust movement costs if going
                -- to a tile that is different y-coord
                -- in offset coordinates
                let (_, y1) = toOffset h1
                    (_, y2) = toOffset h2
                    (c1, c2) = (movecost t1, movecost t2)
                    (c1', c2')
                      | y1 == y2  = (c1, c2)
                      | otherwise = (c1 * 1.05, c2 * 1.05)
                return $ max c1' c2'
       Just roads <- aStarM
                       neighborM
                       movecostM
                       (return . fromIntegral . distance h)
                       (return . (==h))
                       (return h2)
       -- Fill in roads
       mapM_ (flip mgPutRoad True) roads
       mgPutRoad h True
       mgPutRoad h2 True

     -- Disallow tiles within 5 tiles of the selected tile.
     let disalloweds = Set.fromList $ nearby 5 h
         tm' = Map.map (Set.\\ disalloweds) tm

     core done' tm' (numGen+1) sts