Adds a lot of templates.

parent d5fc1b2f
......@@ -93,3 +93,4 @@ dbBeginGame creature character_class =
_ <- 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
......@@ -48,8 +48,7 @@ generateCreature faction species = generateAttributes faction species $ mconcat
generateInitialPlayerCreature :: Species -> DB ()
generateInitialPlayerCreature species =
do newc <- generateCreature Player species
dbSetStartingSpecies species
setPlayerState (ClassSelectionState newc)
setStartingSpecies species
-- |
-- Generates a new Creature from the specified Species and adds it to the database.
......@@ -37,8 +37,8 @@ module Roguestar.Lib.DB
ro, atomic,
mapRO, filterRO, sortByRO,
......@@ -520,14 +520,14 @@ dbNextTurn refs =
-- |
-- Answers the starting species.
dbGetStartingSpecies :: DB (Maybe Species)
dbGetStartingSpecies = do gets db_starting_species
getStartingSpecies :: DB (Maybe Species)
getStartingSpecies = do gets db_starting_species
-- |
-- Sets the starting species.
dbSetStartingSpecies :: Species -> DB ()
dbSetStartingSpecies the_species = modify (\db -> db { db_starting_species = Just the_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.Roguestar
import Roguestar.Lib.DB as DB
import Control.Concurrent.STM
import Roguestar.Lib.PlayerState
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.Random
import Roguestar.Lib.Creature
data Game = Game {
game_db :: TVar DB_BaseType }
newEmptyGame :: IO Game
newEmptyGame =
newGame :: IO Game
newGame =
do db <- newTVarIO initial_db
return $ Game db
peek :: Game -> DB a -> IO (Either DBError a)
peek g f =
do game <- atomically $ readTVar (game_db g)
result <- runDB f game
return $ case result of
Left err -> Left err
Right (a,_) -> Right a
poke :: Game -> DB a -> IO (Either DBError a)
poke g f =
do game <- atomically $ readTVar (game_db g)
result <- runDB f game
case result of
Left err -> return $ Left err
Right (a,next_db) ->
do atomically $ writeTVar (game_db g) next_db
return $ Right a
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 $
do species <- pickM all_species
generateInitialPlayerCreature species
return species
module Roguestar.Lib.Species
......@@ -13,9 +12,6 @@ import Roguestar.Lib.CreatureAttribute
import Data.Monoid
import Roguestar.Lib.TerrainData
player_species_names :: [String]
player_species_names = map (map toLower . show) player_species
data SpeciesData = SpeciesData {
species_recurring_attributes :: CreatureAttribute,
species_starting_attributes :: [CreatureAttributeGenerator] }
module Roguestar.Lib.SpeciesData
data Species =
......@@ -23,18 +22,3 @@ data Species =
all_species :: [Species]
all_species = [minBound..maxBound]
player_species :: [Species]
player_species = [
{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell, OverloadedStrings, ScopedTypeVariables #-}
import Prelude
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Snap
import qualified Text.XHtmlCombinators.Escape as XH
import Control.Exception (SomeException)
import qualified Control.Monad.CatchIO as CatchIO
import Control.Monad.Trans
import Control.Applicative
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Util.FileServe
import Snap.Http.Server.Config
import Data.Lens.Template
import Data.Maybe
import Data.Ord
import Roguestar.Lib.Roguestar
data App = App
data App = App {
_heist :: Snaplet (Heist App),
_app_game :: Game }
makeLenses [''App]
instance HasHeist App where heistLens = subSnaplet heist
appInit :: SnapletInit App App
appInit = makeSnaplet "taskflask" "Task Flask" Nothing $
do addRoutes [("/static", static)]
return App
do hs <- nestSnaplet "heist" heist $ heistInit "templates"
addRoutes [("/play", play),
("/static", static),
("/hidden", handle404),
("/fail", handle500 (do error "my brain exploded")),
("", heistServe)]
game <- liftIO newGame
wrapHandlers (<|> handle404)
wrapHandlers handle500
return $ App hs game
handle500 :: MonadSnap m => m a -> m ()
handle500 m = (m >> return ()) `CatchIO.catch` \(e::SomeException) -> do
let t = T.pack $ show e
putResponse r
writeBS "<html><head><title>Internal Server Error</title></head>"
writeBS "<body><h1>Internal Server Error</h1>"
writeBS "<p>A web handler threw an exception. Details:</p>"
writeBS "<pre>\n"
writeText $ XH.escape t
writeBS "\n</pre></body></html>"
r = setContentType "text/html" $
setResponseStatus 500 "Internal Server Error" emptyResponse
static :: Handler b v ()
handle404 :: Handler App App ()
handle404 =
do modifyResponse $ setResponseCode 404
render "404"
static :: Handler App App ()
static = serveDirectory "./static/"
play :: Handler App App ()
play = ifTop $
do writeBS "hello, world!"
main :: IO ()
main = serveSnaplet defaultConfig appInit
......@@ -17,7 +17,11 @@ executable roguestar-server
hs-source-dirs: .
build-depends: snap >=0.8,
snap-core >=0.8,
snap-server >= 0.8,
text >=0.11,
xhtml-combinators == 0.2.2,
MonadCatchIO-transformers >= 0.2 && < 0.3,
containers >=,
base >=4
ghc-prof-options: -prof -auto-all
<apply template="/hidden/context">
<h1>404 Not Found</h1>
<p>You has a sad roguestar :(</p>
<apply template="/hidden/context">
<h1>How to Contribute</h1>
<apply template="/hidden/ui/faq">
<apply template="/hidden/ui/faqbox">
<bind tag="question">Artwork</bind>
<bind tag="answer"><apply template="/hidden/contribute/artwork"/></bind>
<apply template="/hidden/ui/faqbox">
<bind tag="question">HTML/CSS/Javascript Talent</bind>
<bind tag="answer"><apply template="/hidden/contribute/webtalent"/></bind>
<apply template="/hiddenui/faqbox">
<bind tag="question">Haskell Programmers</bind>
<bind tag="answer"><apply template="/hidden/contribute/haskell"/></bind>
<apply template="/hidden/ui/faqbox">
<bind tag="question">Other</bind>
<bind tag="answer"><apply template="/hidden/contribute/other"/></bind>
<apply template="/hidden/context">
<apply template="/hidden/ui/faq">
<apply template="/hidden/ui/faqbox">
<bind tag="question">What the hell is this?</bind>
<bind tag="answer"><apply template="/hidden/help/wth"/></bind>
<apply template="/hidden/ui/faq">
<apply template="/hidden/ui/faqbox">
<bind tag="question">Keyboard Commands</bind>
<bind tag="answer"><apply template="/hidden/help/keys"/></bind>
<!DOCTYPE html>
<link rel="stylesheet" type="text/css" href="/static/roguestar.css"/>
<div class="menu">
<a class="menuitem" id="menu-home" href="/">Home</a> |
<a class="menuitem" id="menu-blog" href="">Blog</a> |
<a class="menuitem" id="menu-play" href="/play">Play</a> |
<a class="menuitem" id="menu-contribute" href="/contribute">Contribute</a> |
<a class="menuitem" id="menu-help" href="/help">Help</a>
<div class="main">
<p>Roguestar would look a LOT better with artwork. Any kind of hand-drawing, painting, digital or 3D artwork can be used, if it is stylistically sensible and you have the right to contribute it. In particular, I need:</p>
<li>Logos, headers, footers, any kind of sensible decoration for the web site.</li>
<li>Pictures of monsters, characters and equipment (not humans).</li>
<li>Pictures of landscapes and environments.</li>
<li>Pictures of creatures performing specific tasks, such as picking up and object or firing a weapon.</li>
<li>Pictures of anything else you encounter in the game that seems appropriate for illustration.</li>
<p>Any content must be available under copyright terms no more restrictive than the version of the GPL that roguestar is distrubted under. If you don't know what this means, just ask. <apply template="/hidden/links/contact-me"/></p>
<p>Everything is on <apply template="/hidden/links/github"/>. Show me something awesome and I'll honor your pull request.</p>
<p>Feel free to tell all of your friends/blog readers/pets/etc about roguestar!</p>
<p>Your honest opinion about what does and does not make roguestar fun for you is absolutely invaluable <apply template="/hidden/links/contact-me"/>.
<p>Check out roguestar on <apply template="/hidden/links/github"/> to learn more about how it works.</p>
<p>If you can improve the styling, layout, presentation, or general awesomeness of the website, please do so. You can get the source for roguestar, including all templates, css, javascript, etc, from <apply template="/hidden/links/github"/>.</p>
<p>Most of the content for this site is written using Heist templates, which will be easy to figure out for anyone who speaks HTML. Everything else is regular CSS+javascript. Although you need git to work on roguestar, you don't need a working Haskell build environment, just the server binary. Ask me and I'll build one for your environment. <apply template="/hidden/links/contact-me"/></p>
<p>At this time there is only one keyboard mapping for roguestar, a deficiency that needs to be improved.</p>
<table class="keymap">
<th>Key Stroke</th><th>Action</th>
<p>Roguestar is based on the roguelike tradition of computer games, in which maps, tools and enemies are represented by letters and symbols on a grid. It dates back to a time when computer graphics were not practical for gaming.</p>
<p>In the past, there was a fancy 3D interface to Roguestar, but I made a judgement call that this was not the best way to design the game.</p>
(Email me: <a href=""></a>)
<a href="">github</a>
<div class="faq">
<div class="faqbox">
<h3 class="question"><question/></h3>
<div class="answer"><answer/></div>
<apply template="/hidden/context">
Roguestar is a text-based tactical role-playing game set in a science-fiction universe. You can begin playing right now, in your web browser: <a href="/play">Play Now</a>.
body {
padding: 0px;
margin: 0px;
font-family: "Gill Sans", "Nimbus Sans L", "Century Gothic", sans-serif;
background: #FFF;
div.main {
margin: 0;
padding: 1in;
padding-top: 0;
} {
margin-top: 0.25in;
margin-bottom: 0.25in;
padding-left: 1in;
padding-right: 1in;
background-color: #DDD;
border-bottom: solid;
border-top: solid;
border-bottom-width: 1mm;
border-top-width: 1mm;
border-bottom-color: #005;
border-top-color: #005;
div.stale {
font-size: 60%;
font-color: #444;
code {
font-family: monospace;
font-weight: normal;
img {
border: 0;
img.screenshot {
border: solid;
border-width: 1px;
border-color: black;
float: right;
h1 {
color: #006;
h2 {
color: #006;
h3 {
color: #006;
h4 {
color: #006;
h5 {
color: #006;
a {
color: #005;
text-decoration: none;
a:visited {
color: #005;
a:hover {
text-decoration: underline;
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