Renders a map on the server.

parent 0cb22b5a
{-# LANGUAGE OverloadedStrings #-}
module Roguestar.Lib.BeginGame
(dbBeginGame)
(beginGame)
where
import Roguestar.Lib.Plane
......@@ -13,6 +13,7 @@ import Roguestar.Lib.Facing
import Roguestar.Lib.TerrainData
import Roguestar.Lib.ToolData
import Control.Monad
import Control.Monad.Error
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.Substances as Substances
import Roguestar.Lib.PlayerState
......@@ -36,20 +37,6 @@ homeBiome Recreant = TundraBiome
homeBiome Reptilian = ForestBiome
homeBiome DustVortex = DesertBiome
startingEquipmentByClass :: CharacterClass -> [Tool]
startingEquipmentByClass Barbarian = [kinetic_fleuret]
startingEquipmentByClass Consular = [sphere Silver]
startingEquipmentByClass Engineer = [sphere Crudnium,sphere Molybdenum,sphere Uranium]
startingEquipmentByClass ForceAdept = [kinetic_sabre]
startingEquipmentByClass Marine = [phase_pistol,phase_rifle]
startingEquipmentByClass Ninja = []
startingEquipmentByClass Pirate = [phaser]
startingEquipmentByClass Scout = [phase_pistol]
startingEquipmentByClass Shepherd = [sphere Wood]
startingEquipmentByClass Thief = [sphere Platinum]
startingEquipmentByClass Warrior = [phaser,kinetic_fleuret]
startingEquipmentByClass StarChild = [sphere Diamond]
startingEquipmentBySpecies :: Species -> [Tool]
startingEquipmentBySpecies Anachronid = [sphere Radon]
startingEquipmentBySpecies Ascendant = [sphere Neon]
......@@ -69,21 +56,24 @@ dbCreateStartingPlane :: Creature -> DB PlaneRef
dbCreateStartingPlane creature =
do dbNewPlane "belhaven" (TerrainGenerationData {
tg_smootheness = 3,
tg_biome = homeBiome $ creature_species creature,
tg_placements = [] }) TheUniverse
tg_biome = homeBiome $ creature_species creature,
tg_placements = [] }) TheUniverse
-- |
-- Begins the game with the specified starting player creature and the specified starting character class.
-- The character class should not be pre-applied to the creature.
-- Begins the game with the specified starting player creature.
--
dbBeginGame :: Creature -> CharacterClass -> DB ()
dbBeginGame creature character_class =
do let first_level_creature = applyCharacterClass character_class creature
beginGame :: DB ()
beginGame =
do player_state <- playerState
creature <- case player_state of
SpeciesSelectionState (Just c) -> return c
_ -> throwError $ DBError "Tried to begin a game, but no species/creature has been selected."
plane_ref <- dbCreateStartingPlane creature
landing_site <- pickRandomClearSite 200 30 2 (Position (0,0)) (not . (`elem` difficult_terrains)) plane_ref
creature_ref <- dbAddCreature first_level_creature (Standing plane_ref landing_site Here)
creature_ref <- dbAddCreature creature (Standing plane_ref landing_site Here)
setPlayerCreature creature_ref
_ <- createTown plane_ref [basic_stargate,monolith]
let starting_equip = startingEquipmentBySpecies (creature_species creature) ++ startingEquipmentByClass character_class
let starting_equip = startingEquipmentBySpecies (creature_species creature)
forM_ starting_equip $ \tool -> dbAddTool tool (Inventory creature_ref)
forM_ [0..10] $ \_ -> do tool_position <- pickRandomClearSite 200 1 2 landing_site (not . (`elem` difficult_terrains)) plane_ref
tool_type <- weightedPickM [(8,phase_pistol),(5,phaser),(3,phase_rifle),(8,kinetic_fleuret),(3,kinetic_sabre),
......@@ -92,5 +82,5 @@ dbBeginGame creature character_class =
(_,end_of_nonaligned_first_series) <- makePlanets (Subsequent plane_ref NonAlignedRegion) =<< generatePlanetInfo nonaligned_first_series_planets
_ <- makePlanets (Subsequent end_of_nonaligned_first_series NonAlignedRegion) =<< generatePlanetInfo nonaligned_second_series_planets
_ <- makePlanets (Subsequent end_of_nonaligned_first_series CyborgRegion) =<< generatePlanetInfo cyborg_planets
setPlayerState $ PlayerCreatureTurn creature_ref NormalMode
setPlayerState $ PlayerCreatureTurn creature_ref
......@@ -42,13 +42,12 @@ generateCreature :: Faction -> Species -> DB Creature
generateCreature faction species = generateAttributes faction species $ mconcat $ species_starting_attributes $ speciesInfo species
-- |
-- During DBRaceSelectionState, generates a new Creature for the player character and sets it into the
-- database's DBClassSelectionState.
-- During DBRaceSelectionState, generates a new Creature for the player character.
--
generateInitialPlayerCreature :: Species -> DB ()
generateInitialPlayerCreature species =
do newc <- generateCreature Player species
setStartingSpecies species
setPlayerState $ SpeciesSelectionState $ Just newc
-- |
-- Generates a new Creature from the specified Species and adds it to the database.
......@@ -95,7 +94,7 @@ getTerrainAffinity creature_ref =
-- | Get the current creature, if it belongs to the specified faction, based on the current playerState.
getCurrentCreature :: (DBReadable db) => Faction -> db (Maybe CreatureRef)
getCurrentCreature faction =
do m_who <- liftM creatureOf $ playerState
do m_who <- liftM subjectOf $ playerState
is_one_of_us <- maybe (return False) (liftM (== faction) . getCreatureFaction) m_who
return $ if is_one_of_us then m_who else Nothing
......
......@@ -13,8 +13,9 @@ module Roguestar.Lib.DB
DBReadable(..),
playerState,
setPlayerState,
getPlayerCreature,
setPlayerCreature,
SnapshotEvent(..),
DBError(..),
initial_db,
DB_BaseType(db_error_flag),
dbActionCount,
......@@ -37,8 +38,6 @@ module Roguestar.Lib.DB
whereIs,
getContents,
move,
setStartingSpecies,
getStartingSpecies,
ro, atomic,
logDB,
mapRO, filterRO, sortByRO,
......@@ -89,8 +88,8 @@ data DB_History = DB_History {
data DB_BaseType = DB_BaseType { db_player_state :: PlayerState,
db_next_object_ref :: Integer,
db_starting_species :: Maybe Species,
db_creatures :: Map CreatureRef Creature,
db_player_creature :: Maybe CreatureRef,
db_planes :: Map PlaneRef Plane,
db_tools :: Map ToolRef Tool,
db_buildings :: Map BuildingRef Building,
......@@ -101,14 +100,6 @@ data DB_BaseType = DB_BaseType { db_player_state :: PlayerState,
db_action_count :: Integer }
deriving (Read,Show)
data DBError =
DBError String
| DBErrorFlag ErrorFlag
deriving (Read,Show)
instance Error DBError where
strMsg = DBError
type DBResult r = Either DBError (r,DB_History)
data DB a = DB { cycleDB :: forall r. DB_History -> (a -> DB_History -> DBResult r) -> DBResult r }
......@@ -120,7 +111,7 @@ runDB dbAction database =
instance Monad DB where
return a = DB $ \h f -> f a h
k >>= m = DB $ \h f -> cycleDB k h $ \a h' -> cycleDB (m a) h' f
fail = error
fail = throwError . DBError
instance Functor DB where
fmap = liftM
......@@ -212,10 +203,10 @@ atomic action ro_action =
--
initial_db :: DB_BaseType
initial_db = DB_BaseType {
db_player_state = SpeciesSelectionState,
db_player_state = SpeciesSelectionState Nothing,
db_next_object_ref = 0,
db_starting_species = Nothing,
db_creatures = Map.fromList [],
db_player_creature = Nothing,
db_planes = Map.fromList [],
db_tools = Map.fromList [],
db_buildings = Map.fromList [],
......@@ -232,18 +223,18 @@ setupDBHistory db =
db_here = db,
db_random = rng }
-- |
-- Returns the DBState of the database.
--
playerState :: (DBReadable m) => m PlayerState
playerState = asks db_player_state
-- |
-- Sets the DBState of the database.
--
setPlayerState :: PlayerState -> DB ()
setPlayerState state = modify (\db -> db { db_player_state = state })
getPlayerCreature :: (DBReadable m) => m (Maybe CreatureRef)
getPlayerCreature = asks db_player_creature
setPlayerCreature :: CreatureRef -> DB ()
setPlayerCreature creature_ref = modify (\db -> db { db_player_creature = Just creature_ref })
dbActionCount :: (DBReadable db) => db Integer
dbActionCount = asks db_action_count
......@@ -517,18 +508,6 @@ dbNextTurn refs =
List.map (\r -> (r,fromMaybe (error "dbNextTurn: missing time coordinate") $
Map.lookup (genericReference r) (db_time_coordinates db))) refs)
-- |
-- Answers the starting species.
--
getStartingSpecies :: DB (Maybe Species)
getStartingSpecies = do gets db_starting_species
-- |
-- Sets the starting species.
--
setStartingSpecies :: Species -> DB ()
setStartingSpecies the_species = modify (\db -> db { db_starting_species = Just the_species })
-- |
-- Takes a snapshot of a SnapshotEvent in progress.
--
......
module Roguestar.Lib.DBErrorFlag
(ErrorFlag(..))
(DBError(..),
ErrorFlag(..))
where
import Control.Monad.Error
data DBError =
DBError String
| DBErrorFlag ErrorFlag
deriving (Read,Show)
instance Error DBError where
strMsg = DBError
data ErrorFlag =
BuildingApproachWrongAngle -- some buildings (like stargates) are sensitive to the angle of approach
| NothingAtFeet -- tried to pick something up, but there is nothing at your feet
......
{-# LANGUAGE ExistentialQuantification, Rank2Types, FlexibleContexts, ScopedTypeVariables #-}
-- |
-- Perception is essentially a catalogue of information that can be
-- observed from a creatures-eye-view, i.e. information that
-- is legal for a human agent or ai agent to have while choosing
-- it's next move.
--
-- | The Perception monad is a wrapper for roguestar's core
-- monad that reveals only as much information as a character
-- legitimately has. Thus, it is suitable for writing AI
-- routines as well as an API for the player's client.
module Roguestar.Lib.Perception
(DBPerception,
whoAmI,
runPerception,
visibleObjects,
visibleTerrain,
myFaction,
Roguestar.Lib.Perception.getCreatureFaction,
whereAmI,
......@@ -68,12 +67,16 @@ whoAmI = DBPerception $ ask
-- |
-- Run a DBPerception from the point-of-view of the given creature.
-- Note that if you pass any 'Reference' or 'Location' into the perception monad,
-- it will be able to cheat. Therefore, don't.
--
runPerception :: (DBReadable db) => CreatureRef -> (forall m. DBReadable m => DBPerception m a) -> db a
runPerception creature_ref perception = dbSimulate $ runReaderT (fromPerception perception) creature_ref
visibleTerrain :: (DBReadable db) => DBPerception db [(TerrainPatch,Position)]
visibleTerrain =
do plane_ref <- whatPlaneAmIOn
faction <- myFaction
liftDB $ dbGetVisibleTerrainForFaction faction plane_ref
visibleObjects :: (DBReadable db) => (forall m. DBReadable m => Reference () -> DBPerception m Bool) -> DBPerception db [Location]
visibleObjects filterF =
do me <- whoAmI
......@@ -108,7 +111,6 @@ localBiome =
do plane_ref <- whatPlaneAmIOn
liftDB $ liftM plane_biome $ dbGetPlane plane_ref
-- Let's look into re-writing this with A*:
-- http://hackage.haskell.org/packages/archive/astar/0.2.1/doc/html/Data-Graph-AStar.html
compass :: (DBReadable db) => DBPerception db Facing
......
......@@ -4,7 +4,7 @@ module Roguestar.Lib.Plane
planetName,
randomPlanetName,
planeDepth,
dbGetCurrentPlane,
getCurrentPlane,
Roguestar.Lib.Plane.distanceBetweenSquared,
pickRandomClearSite_withTimeout,
pickRandomClearSite,
......@@ -120,9 +120,9 @@ distanceBetweenSquared a_ref b_ref =
-- |
-- Gets the current plane of interest based on whose turn it is.
--
dbGetCurrentPlane :: (DBReadable db) => db (Maybe PlaneRef)
dbGetCurrentPlane = runMaybeT $
do creature_with_current_turn <- MaybeT $ liftM creatureOf playerState
getCurrentPlane :: (DBReadable db) => db (Maybe PlaneRef)
getCurrentPlane = runMaybeT $
do creature_with_current_turn <- MaybeT $ liftM subjectOf playerState
(Parent plane_ref) <- liftM detail $ lift $ getPlanarLocation creature_with_current_turn
return plane_ref
......
module Roguestar.Lib.PlayerState
(PlayerState(..),
CreatureTurnMode(..),
SnapshotEvent(..),
creatureOf,
subjectOf,
menuIndex,
modifyMenuIndex)
HasSubject(..))
where
import Roguestar.Lib.DBData
......@@ -15,27 +11,12 @@ import Roguestar.Lib.MakeData
import Roguestar.Lib.TravelData
data PlayerState =
SpeciesSelectionState
| ClassSelectionState Creature
| PlayerCreatureTurn CreatureRef CreatureTurnMode
SpeciesSelectionState (Maybe Creature)
| PlayerCreatureTurn CreatureRef
| SnapshotEvent SnapshotEvent
| GameOver
deriving (Read,Show)
data CreatureTurnMode =
NormalMode
| MoveMode
| PickupMode Integer
| DropMode Integer
| WieldMode Integer
| MakeMode Integer PrepareMake
| AttackMode
| FireMode
| JumpMode
| TurnMode
| ClearTerrainMode
deriving (Read,Show)
data SnapshotEvent =
AttackEvent {
attack_event_source_creature :: CreatureRef,
......@@ -76,44 +57,27 @@ data SnapshotEvent =
bump_event_new_class :: Maybe CharacterClass }
deriving (Read,Show)
-- | Get the 'Creature' acting in the given 'PlayerState'.
creatureOf :: PlayerState -> Maybe CreatureRef
creatureOf state = case state of
PlayerCreatureTurn creature_ref _ -> Just creature_ref
SnapshotEvent event -> subjectOf event
GameOver -> Nothing
ClassSelectionState {} -> Nothing
SpeciesSelectionState {} -> Nothing
-- | Get the subject creature of a 'SnapshotEvent', that is, the creature taking action.
subjectOf :: SnapshotEvent -> Maybe CreatureRef
subjectOf event = case event of
AttackEvent { attack_event_source_creature = attacker_ref } -> Just attacker_ref
MissEvent { miss_event_creature = attacker_ref } -> Just attacker_ref
WeaponOverheatsEvent { weapon_overheats_event_creature = attacker_ref } -> Just attacker_ref
WeaponExplodesEvent { weapon_explodes_event_creature = attacker_ref } -> Just attacker_ref
KilledEvent killed_ref -> Just killed_ref
DisarmEvent { disarm_event_source_creature = attacker_ref } -> Just attacker_ref
SunderEvent { sunder_event_source_creature = attacker_ref } -> Just attacker_ref
TeleportEvent { teleport_event_creature = creature_ref } -> Just creature_ref
HealEvent { heal_event_creature = creature_ref } -> Just creature_ref
ClimbEvent { climb_event_creature = creature_ref } -> Just creature_ref
BumpEvent { bump_event_creature = creature_ref } -> Just creature_ref
ExpendToolEvent {} -> Nothing
-- | Current index into the menu, if there is one.
menuIndex :: PlayerState -> Maybe Integer
menuIndex state = fst $ modifyMenuIndex_ id state
class HasSubject a where
subjectOf :: a -> Maybe CreatureRef
-- | Modify the current index into the menu, if there is one (otherwise has no effect).
modifyMenuIndex :: (Integer -> Integer) -> PlayerState -> PlayerState
modifyMenuIndex f state = snd $ modifyMenuIndex_ f state
instance HasSubject PlayerState where
subjectOf (SpeciesSelectionState {}) = Nothing
subjectOf (PlayerCreatureTurn x) = Just x
subjectOf (SnapshotEvent x) = subjectOf x
subjectOf GameOver = Nothing
modifyMenuIndex_ :: (Integer -> Integer) -> PlayerState -> (Maybe Integer,PlayerState)
modifyMenuIndex_ f state = case state of
PlayerCreatureTurn c (PickupMode n) -> (Just n,PlayerCreatureTurn c $ PickupMode $ f n)
PlayerCreatureTurn c (DropMode n) -> (Just n,PlayerCreatureTurn c $ DropMode $ f n)
PlayerCreatureTurn c (WieldMode n) -> (Just n,PlayerCreatureTurn c $ WieldMode $ f n)
PlayerCreatureTurn c (MakeMode n make_prep) -> (Just n,PlayerCreatureTurn c $ MakeMode (f n) make_prep)
x -> (Nothing,x)
instance HasSubject SnapshotEvent where
subjectOf event = case event of
AttackEvent { attack_event_source_creature = attacker_ref } -> Just attacker_ref
MissEvent { miss_event_creature = attacker_ref } -> Just attacker_ref
WeaponOverheatsEvent { weapon_overheats_event_creature = attacker_ref } -> Just attacker_ref
WeaponExplodesEvent { weapon_explodes_event_creature = attacker_ref } -> Just attacker_ref
KilledEvent killed_ref -> Just killed_ref
DisarmEvent { disarm_event_source_creature = attacker_ref } -> Just attacker_ref
SunderEvent { sunder_event_source_creature = attacker_ref } -> Just attacker_ref
TeleportEvent { teleport_event_creature = creature_ref } -> Just creature_ref
HealEvent { heal_event_creature = creature_ref } -> Just creature_ref
ClimbEvent { climb_event_creature = creature_ref } -> Just creature_ref
BumpEvent { bump_event_creature = creature_ref } -> Just creature_ref
ExpendToolEvent {} -> Nothing
{-# LANGUAGE Rank2Types #-}
module Roguestar.Lib.Roguestar
(Game,
newGame,
getPlayerState,
Roguestar.Lib.Roguestar.getStartingSpecies)
rerollStartingSpecies,
Creature(..),
TerrainPatch(..),
Position(..),
Facing(..),
Roguestar.Lib.Roguestar.beginGame,
perceive)
where
import Roguestar.Lib.DB as DB
import Control.Concurrent.STM
import Control.Monad
import Roguestar.Lib.PlayerState
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.Random
import Roguestar.Lib.Creature
import Roguestar.Lib.CreatureData
import Roguestar.Lib.BeginGame as BeginGame
import Roguestar.Lib.Perception
import Roguestar.Lib.TerrainData
import Roguestar.Lib.Facing
data Game = Game {
game_db :: TVar DB_BaseType }
......@@ -41,12 +55,17 @@ poke g f =
getPlayerState :: Game -> IO (Either DBError PlayerState)
getPlayerState g = peek g playerState
getStartingSpecies :: Game -> IO (Either DBError (Maybe Species))
getStartingSpecies g = peek g DB.getStartingSpecies
rerollStartingSpecies :: Game -> Species -> IO (Either DBError Species)
rerollStartingSpecies g species = poke g $
rerollStartingSpecies :: Game -> IO (Either DBError Species)
rerollStartingSpecies g = poke g $
do species <- pickM all_species
generateInitialPlayerCreature species
return species
beginGame :: Game -> IO (Either DBError ())
beginGame g = poke g $ BeginGame.beginGame
perceive :: Game -> (forall m. DBReadable m => DBPerception m a) -> IO (Either DBError a)
perceive g f = peek g $
do player_creature <- maybe (fail "No player creature selected yet.") return =<< getPlayerCreature
runPerception player_creature f
......@@ -37,7 +37,7 @@ dbPerformPlayerTurn beh creature_ref =
dbFinishPendingAITurns :: DB ()
dbFinishPendingAITurns =
do m_current_plane <- dbGetCurrentPlane
do m_current_plane <- getCurrentPlane
case m_current_plane of
Just p -> dbFinishPlanarAITurns p
Nothing -> return ()
......@@ -62,7 +62,7 @@ dbFinishPlanarAITurns plane_ref =
if (faction /= Player)
then do dbPerform1CreatureAITurn creature_ref
dbFinishPlanarAITurns plane_ref
else setPlayerState (PlayerCreatureTurn creature_ref NormalMode)
else setPlayerState (PlayerCreatureTurn creature_ref)
return ()
_ -> error "dbFinishPlanarAITurns: impossible case"
......
{-# LANGUAGE TemplateHaskell, OverloadedStrings, ScopedTypeVariables #-}
import Prelude
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Text.XHtmlCombinators.Escape as XH
import qualified Text.XmlHtml as X
import Control.Exception (SomeException)
import qualified Control.Monad.CatchIO as CatchIO
import Control.Monad.Trans
import Control.Monad.State
import Control.Applicative
import Control.Monad.ST
import Data.STRef
import Data.Array.ST
import Data.Array.IArray
import Data.Array.Unboxed
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
......@@ -16,7 +23,11 @@ import Snap.Http.Server.Config
import Data.Lens.Template
import Data.Maybe
import Data.Ord
import qualified Data.List as List
import Roguestar.Lib.Roguestar
import Roguestar.Lib.PlayerState
import Roguestar.Lib.DBErrorFlag
import Roguestar.Lib.Perception
data App = App {
_heist :: Snaplet (Heist App),
......@@ -62,8 +73,115 @@ static :: Handler App App ()
static = serveDirectory "./static/"
play :: Handler App App ()
play = ifTop $
do writeBS "hello, world!"
play =
do g <- getGame
player_state <- liftIO $ getPlayerState g
case player_state of
Right something ->
routeRoguestar something
[("",method GET . displayCurrentState),
("maptext",method GET . const (createMap >>= writeText)),
("reroll",method POST . reroll),
("accept",method POST . accept)]
routeRoguestar :: PlayerState -> [(BS.ByteString,PlayerState -> Handler App App ())] -> Handler App App ()
routeRoguestar ps xs = route $ map (\(bs,f) -> (bs,f ps)) xs
displayCurrentState :: PlayerState -> Handler App App ()
displayCurrentState (SpeciesSelectionState Nothing) =
render "/hidden/play/empty-game"
displayCurrentState (SpeciesSelectionState (Just creature)) =
renderWithSplices "/hidden/play/character-creation"
[("content",return $ [X.TextNode $ T.pack $ "You are a " ++ show (creature_species creature) ++ "."])]
displayCurrentState (PlayerCreatureTurn creature_ref) =
do map_text <- createMap
renderWithSplices "/hidden/play/normal-play"
[("map",return $ [X.Element "pre" [] [X.TextNode map_text]])]
displayCurrentState _ = pass
reroll :: PlayerState -> Handler App App ()
reroll (SpeciesSelectionState _) =
do g <- getGame
liftIO $ rerollStartingSpecies g
replay
reroll _ = pass
accept :: PlayerState -> Handler App App ()
accept (SpeciesSelectionState (Just _)) =
do g <- getGame
liftIO $ beginGame g
replay
accept _ = pass
replay :: Handler App App ()
replay = redirect "/play"
oops :: DBError -> Handler App App ()
oops db_error = writeBS $ "FIXME: this error message is useless."
getGame :: Handler App App Game
getGame = gets _app_game
data MapData = MapData {
md_visible_terrain :: [(TerrainPatch,Position)],
md_position_info :: (Facing,Position) }
createMap :: Handler App App T.Text
createMap =
do let (x,y) = (21,21) --we'll probably want to let the player customize this later
g <- getGame
map_data <- liftIO $ perceive g $
do visible_terrain <- visibleTerrain
visible_objects <- visibleObjects
my_position <- whereAmI
return $ MapData visible_terrain my_position
case map_data of
Right map_data_ -> return $ constructMapText (x,y) map_data_
constructMapText :: (Integer,Integer) -> MapData -> T.Text
constructMapText (width,height) _ | width `mod` 2 == 0 || height `mod` 2 == 0 = error "Map widths and heights must be odd numbers"
constructMapText (width,height) (MapData visible_terrain (_,Position (center_x,center_y))) = T.unfoldr f (False,0)
where f :: (Bool,Int) -> Maybe (Char, (Bool,Int))
f (False,i) = if i > snd (bounds char_array)
then Nothing
else Just (char_array ! i,(succ i `mod` fromInteger width == 0,succ i))
f (True,i) = Just ('\n',(False,i))
x_adjust = center_x - (width-1) `div` 2
y_adjust = center_y - (height-1) `div` 2
array_length = fromInteger $ width*height
char_array :: UArray Int Char
char_array = runSTUArray $
do ax <- newArray (0,array_length-1) ' '
forM_ visible_terrain $ \(tp,Position (x,y)) ->
do let i = fromInteger $ (x-x_adjust) + (y-y_adjust)*width
when (i >= 0 && i < array_length-1) $
writeArray ax (fromInteger $ (x - x_adjust)+(y - y_adjust)*width) $ charcodeOf tp
return ax
class Charcoded a where
charcodeOf :: a -> Char
instance Charcoded TerrainPatch where
-- eventually I'd want this to look like:
-- charcodeOf Grass = ('.', Green, "grass")
charcodeOf RockFace = '#'
charcodeOf Rubble = '~'
charcodeOf Ore = '~'
charcodeOf RockyGround = '.'
charcodeOf Dirt = '.'
charcodeOf Grass = '.'
charcodeOf Sand = '~'
charcodeOf Desert = '~'
charcodeOf Forest = 'f'
charcodeOf DeepForest = 'f'
charcodeOf Water = '~'
charcodeOf DeepWater = '~'
charcodeOf Ice = '.'
charcodeOf Lava = '~'
charcodeOf Glass = '.'
charcodeOf RecreantFactory = '_'
charcodeOf Upstairs = '>'
charcodeOf Downstairs = '<'
main :: IO ()
main = serveSnaplet defaultConfig appInit
......
......@@ -19,6 +19,7 @@ executable roguestar-server
snap-core >=0.8,
snap-server >= 0.8,
text >=0.11,
xmlhtml,
xhtml-combinators == 0.2.2,
MonadCatchIO-transformers >= 0.2 && < 0.3,
data-lens-template,
......@@ -46,7 +47,9 @@ library
array >=0.3.0.0,
containers >=0.3.0.0,
base >=4
exposed-modules:Roguestar.Lib.Roguestar
exposed-modules:Roguestar.Lib.Roguestar,
Roguestar.Lib.PlayerState,
Roguestar.Lib.DBErrorFlag
other-modules: Roguestar.Lib.TravelData,
Roguestar.Lib.VisibilityData,
Roguestar.Lib.FactionData,
......@@ -87,9 +90,7 @@ library
Roguestar.Lib.BuildingData,
Roguestar.Lib.Town,
Roguestar.Lib.Random,
Roguestar.Lib.PlayerState,
Roguestar.Lib.MakeData,
Roguestar.Lib.DBErrorFlag,
Roguestar.Lib.Behavior.Construction,
Roguestar.Lib.Behavior.Make,
Roguestar.Lib.Activate,
......
<apply template="/hidden/play/context">
<content/>
<form action="/play/reroll" method="post">
<input type="submit" name="Regenerate"/>
</form>
<form action="/play/accept" method="post">
<input type="submit" name="Accept"/>
</form>
</apply>
<apply template="/hidden/context">
<content/>
</apply>
<apply template="/hidden/play/context">
You may randomly re-generate you character as many times as you wish:
<form action="/play/reroll" method="post">
<input type="submit" name="Generate"/>
</form>
</apply>
<apply template="/hidden/play/context">
<map/>
</apply>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment