Browse files

Adds a lot of templates.

  • Loading branch information...
1 parent d5fc1b2 commit 0cb22b5a4685b35a29658bf549762614271d5c2a @clanehin committed May 12, 2012
View
1 Roguestar/Lib/BeginGame.hs
@@ -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
+
View
3 Roguestar/Lib/Creature.hs
@@ -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.
View
12 Roguestar/Lib/DB.hs
@@ -37,8 +37,8 @@ module Roguestar.Lib.DB
whereIs,
getContents,
move,
- dbSetStartingSpecies,
- dbGetStartingSpecies,
+ setStartingSpecies,
+ getStartingSpecies,
ro, atomic,
logDB,
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.
View
0 Roguestar/Lib/Data/PlayerState.hs
No changes.
View
42 Roguestar/Lib/Roguestar.hs
@@ -1,16 +1,52 @@
module Roguestar.Lib.Roguestar
(Game,
- newEmptyGame)
+ newGame,
+ getPlayerState,
+ Roguestar.Lib.Roguestar.getStartingSpecies)
where
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
+
View
6 Roguestar/Lib/Species.hs
@@ -1,7 +1,6 @@
module Roguestar.Lib.Species
- (player_species_names,
- SpeciesData(..),
+ (SpeciesData(..),
speciesInfo)
where
@@ -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] }
View
18 Roguestar/Lib/SpeciesData.hs
@@ -1,7 +1,6 @@
module Roguestar.Lib.SpeciesData
(Species(..),
- all_species,
- player_species)
+ all_species)
where
data Species =
@@ -23,18 +22,3 @@ data Species =
all_species :: [Species]
all_species = [minBound..maxBound]
-player_species :: [Species]
-player_species = [
- Anachronid,
- Androsynth,
- Ascendant,
- Caduceator,
- Encephalon,
- Goliath,
- Hellion,
- Kraken,
- Myrmidon,
- Perennial,
- Recreant,
- Reptilian]
-
View
59 Roguestar/Server/Main.hs
@@ -1,23 +1,70 @@
-{-# 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>"
+ where
+ 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
View
4 roguestar.cabal
@@ -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,
+ data-lens-template,
containers >=0.3.0.0,
base >=4
ghc-prof-options: -prof -auto-all
View
5 snaplets/heist/templates/404.tpl
@@ -0,0 +1,5 @@
+<apply template="/hidden/context">
+<h1>404 Not Found</h1>
+
+<p>You has a sad roguestar :(</p>
+</apply>
View
28 snaplets/heist/templates/contribute.tpl
@@ -0,0 +1,28 @@
+<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>
+
+<apply template="/hidden/ui/faqbox">
+ <bind tag="question">HTML/CSS/Javascript Talent</bind>
+ <bind tag="answer"><apply template="/hidden/contribute/webtalent"/></bind>
+</apply>
+
+<apply template="/hiddenui/faqbox">
+ <bind tag="question">Haskell Programmers</bind>
+ <bind tag="answer"><apply template="/hidden/contribute/haskell"/></bind>
+</apply>
+
+<apply template="/hidden/ui/faqbox">
+ <bind tag="question">Other</bind>
+ <bind tag="answer"><apply template="/hidden/contribute/other"/></bind>
+</apply>
+
+</apply>
+</apply>
+
View
17 snaplets/heist/templates/help.tpl
@@ -0,0 +1,17 @@
+<apply template="/hidden/context">
+<h1>Help!</h1>
+
+<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>
+</apply>
+
+<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>
+ </apply>
+</apply>
+</apply>
View
21 snaplets/heist/templates/hidden/context.tpl
@@ -0,0 +1,21 @@
+<!DOCTYPE html>
+
+<html>
+ <head>
+ <title>Roguestar</title>
+ <link rel="stylesheet" type="text/css" href="/static/roguestar.css"/>
+ </head>
+ <body>
+ <div class="menu">
+ <a class="menuitem" id="menu-home" href="/">Home</a> |
+ <a class="menuitem" id="menu-blog" href="http://blog.downstairspeople.org/">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>
+ <div class="main">
+ <content/>
+ </div>
+ </body>
+</html>
+
View
11 snaplets/heist/templates/hidden/contribute/artwork.tpl
@@ -0,0 +1,11 @@
+<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>
+
+<ul>
+<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>
+</ul>
+
+<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>
View
1 snaplets/heist/templates/hidden/contribute/haskell.tpl
@@ -0,0 +1 @@
+<p>Everything is on <apply template="/hidden/links/github"/>. Show me something awesome and I'll honor your pull request.</p>
View
5 snaplets/heist/templates/hidden/contribute/other.tpl
@@ -0,0 +1,5 @@
+<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>
View
3 snaplets/heist/templates/hidden/contribute/webtalent.tpl
@@ -0,0 +1,3 @@
+<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>
View
9 snaplets/heist/templates/hidden/help/keys.tpl
@@ -0,0 +1,9 @@
+<p>At this time there is only one keyboard mapping for roguestar, a deficiency that needs to be improved.</p>
+
+<table class="keymap">
+ <tr>
+ <th>Key Stroke</th><th>Action</th>
+ </tr><tr>
+ <td>h</td><td>Up</td>
+ </tr>
+</table>
View
3 snaplets/heist/templates/hidden/help/wth.tpl
@@ -0,0 +1,3 @@
+<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>
View
1 snaplets/heist/templates/hidden/links/contact-me.tpl
@@ -0,0 +1 @@
+(Email me: <a href="mailto:lane@downstairspeople.org">lane@downstairspeople.org</a>)
View
1 snaplets/heist/templates/hidden/links/github.tpl
@@ -0,0 +1 @@
+<a href="https://github.com/clanehin/roguestar">github</a>
View
3 snaplets/heist/templates/hidden/ui/faq.tpl
@@ -0,0 +1,3 @@
+<div class="faq">
+<content/>
+</div>
View
4 snaplets/heist/templates/hidden/ui/faqbox.tpl
@@ -0,0 +1,4 @@
+<div class="faqbox">
+<h3 class="question"><question/></h3>
+<div class="answer"><answer/></div>
+</div>
View
5 snaplets/heist/templates/index.tpl
@@ -0,0 +1,5 @@
+<apply template="/hidden/context">
+<h1>Roguestar</h1>
+
+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>.
+</apply>
View
81 static/roguestar.css
@@ -0,0 +1,81 @@
+
+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;
+}
+
+div.menu {
+ 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;
+}

0 comments on commit 0cb22b5

Please sign in to comment.