Skip to content
This repository
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 88 lines (80 sloc) 3.315 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
{-# LANGUAGE TypeFamilies #-}

module Roguestar.Lib.Planet
    (makePlanets,
     generatePlanetInfo)
    where

import Roguestar.Lib.PlanetData
import Roguestar.Lib.PlaneData
import Roguestar.Lib.DB
import Roguestar.Lib.Plane
import Roguestar.Lib.TerrainData
import Control.Monad
import Control.Monad.Random
import Data.Maybe
import Data.Ord
import Roguestar.Lib.Town
import Data.List
import Data.ByteString.Char8 as B
import Roguestar.Lib.FactionData
import Roguestar.Lib.BuildingData

makePlanet :: (LocationConstructor l, ReferenceTypeOf l ~ Plane) => l -> PlanetInfo -> DB PlaneRef
makePlanet plane_location planet_info =
    do seed <- getRandom
       seed_down <- getRandom
       planet_name <- liftM (`fromMaybe` planet_info_name planet_info) $
                          randomPlanetName Nonaligned
       plane_ref <- dbNewPlane
          planet_name
          (TerrainGenerationData {
               tg_smootheness = 3,
               tg_biome = planet_info_biome planet_info,
               tg_placements = [recreantFactories seed,
                                stairsDown seed_down 0] })
          plane_location
       town <- liftM catMaybes $ forM (planet_info_town planet_info) $ \(r,b) ->
           do p <- rationalRoll r
              return $ if p then Just b else Nothing
       _ <- createTown plane_ref town
       _ <- makeDungeons planet_name (Beneath plane_ref) 1 planet_info
       return plane_ref

makePlanets :: Subsequent -> [PlanetInfo] -> DB (PlaneRef,PlaneRef)
makePlanets _ [] = return $ error "makePlanets: empty list"
makePlanets l (planet_info:[]) =
    do plane_ref <- makePlanet l planet_info
       return (plane_ref,plane_ref)
makePlanets l (planet_info:rest) =
    do first_plane_ref <- makePlanet l planet_info
       (_,last_plane_ref) <- makePlanets (Subsequent first_plane_ref $ subsequent_via l) rest
       return (first_plane_ref,last_plane_ref)

makeDungeons :: (LocationConstructor l, ReferenceTypeOf l ~ Plane) =>
                B.ByteString ->
                l ->
                Integer ->
                PlanetInfo ->
                DB PlaneRef
makeDungeons planet_name plane_location i planet_info =
    do let n = planet_info_depth planet_info
       seed_up <- getRandom
       seed_down <- getRandom
       plane_ref <- dbNewPlane
           planet_name
           (TerrainGenerationData {
               tg_smootheness = 2,
               tg_biome = planet_info_dungeon planet_info,
               tg_placements =
                   [stairsUp seed_up i] ++
                   if i < n then [stairsDown seed_down i] else [] })
           plane_location
       when (i == n) $
           do _ <- createTown plane_ref $ Data.List.replicate (fromInteger n) powerup
              return ()
       when (i < n) $
           do _ <- makeDungeons planet_name (Beneath plane_ref) (succ i) planet_info
              return ()
       return plane_ref

generatePlanetInfo :: (DBReadable db) => [PlanetInfo] -> db [PlanetInfo]
generatePlanetInfo planet_infos = liftM (sortBy (comparing planet_info_priority)) $ forM planet_infos $ \planet_info ->
    do -- see documentation for 'PlanetData.PlanetInfo'
       prio_bonus <- getRandomR (0.0,1.0)
       return $ planet_info { planet_info_priority =
           planet_info_priority planet_info + prio_bonus }

Something went wrong with that request. Please try again.