Skip to content
Browse files

Default movement type and compass.

  • Loading branch information...
1 parent e0a63d5 commit 57bc4461753707560b0d69498d5e58886a0cfcc0 @clanehin committed Jun 21, 2012
View
8 Roguestar/Lib/Roguestar.hs
@@ -12,6 +12,7 @@ module Roguestar.Lib.Roguestar
Roguestar.Lib.Roguestar.beginGame,
perceive,
behave,
+ Roguestar.Lib.Roguestar.facingBehavior,
Behavior(..))
where
@@ -27,7 +28,7 @@ import Roguestar.Lib.BeginGame as BeginGame
import Roguestar.Lib.Perception
import Roguestar.Lib.TerrainData
import Roguestar.Lib.Facing
-import Roguestar.Lib.Behavior
+import Roguestar.Lib.Behavior as Behavior
data Game = Game {
game_db :: TVar DB_BaseType }
@@ -72,6 +73,11 @@ perceive g f = peek g $
do player_creature <- maybe (fail "No player creature selected yet.") return =<< getPlayerCreature
runPerception player_creature f
+facingBehavior :: Game -> Facing -> IO (Either DBError Behavior)
+facingBehavior g facing = peek g $
+ do player_creature <- maybe (fail "No player creature selected yet.") return =<< getPlayerCreature
+ Behavior.facingBehavior player_creature facing
+
behave :: Game -> Behavior -> IO (Either DBError ())
behave g b = poke g $
do player_creature <- maybe (fail "No player creature selected yet.") return =<< getPlayerCreature
View
2 Roguestar/Lib/Substances.hs
@@ -205,7 +205,7 @@ substanceValue a = case toSubstance a of
ChromaliteSubstance x -> 1000 + 2 * chromalitePotency x ^ 2
instance SubstanceType Gas where
- toSubstance x = GasSubstance x
+ toSubstance = GasSubstance
fromSubstance (GasSubstance x) = Just x
fromSubstance _ = Nothing
View
43 Roguestar/Server/Main.hs
@@ -134,16 +134,21 @@ move (PlayerCreatureTurn {}) =
moveBehavior :: Handler App App Behavior
moveBehavior =
- do direction <- liftM (fromMaybe $ error "No direction identifier.") $ getPostParam "direction"
+ do g <- getGame
+ direction <- liftM (fromMaybe $ error "No direction identifier.") $ getPostParam "direction"
mode <- liftM (fromMaybe $ error "No mode identifier.") $ getPostParam "mode"
let facing = fromMaybe (error "Not a valid direction identifier.") $ stringToFacing direction
- let action = case mode of
- _ | direction == "wait" -> const Wait
- "step" -> Step
- "attack" -> Attack
- "fire" -> Fire
- "jump" -> Jump
- "turn" -> TurnInPlace
+ action <- case mode of
+ _ | direction == "wait" -> return $ const Wait
+ "normal" ->
+ do result <- liftIO $ facingBehavior g facing
+ case result of
+ Right x -> return $ const x
+ "step" -> return Step
+ "attack" -> return Attack
+ "fire" -> return Fire
+ "jump" -> return Jump
+ "turn" -> return TurnInPlace
return $ action facing
replay :: Handler App App ()
@@ -196,17 +201,29 @@ constructMapText (width,height) (MapData visible_terrain visible_objects (_,Posi
writeArray ax i $ charcodeOf vobs
return ax
+data StatsData = StatsData {
+ stats_health :: CreatureHealth,
+ stats_compass :: Facing }
+
createStatsBlock :: Handler App App T.Text
createStatsBlock =
do g <- getGame
- health <- liftIO $ perceive g myHealth
- case health of
- Right health_ ->
+ stats <- liftIO $ perceive g $
+ do health <- myHealth
+ facing <- compass
+ return $ StatsData {
+ stats_health = health,
+ stats_compass = facing }
+ case stats of
+ Right stats_ ->
return $ T.concat [
"Health: ",
- T.pack $ show $ creature_absolute_health health_,
+ T.pack $ show $ creature_absolute_health $ stats_health stats_,
"/",
- T.pack $ show $ creature_max_health health_]
+ T.pack $ show $ creature_max_health $ stats_health stats_,
+ "\n",
+ "Compass: ",
+ T.pack $ show $ stats_compass stats_]
class Charcoded a where
charcodeOf :: a -> Char
View
3 snaplets/heist/templates/hidden/play/normal-play.tpl
@@ -5,7 +5,8 @@
</div>
<form action="/play/move" method="post">
<div>
-<input type="radio" name="mode" value="step" checked="checked"/> Walk |
+<input type="radio" name="mode" value="normal" checked="checked"/> Normal |
+<input type="radio" name="mode" value="step"/> Walk |
<input type="radio" name="mode" value="attack"/> Attack |
<input type="radio" name="mode" value="fire"/> Fire |
<input type="radio" name="mode" value="jump"/> Jump |

0 comments on commit 57bc446

Please sign in to comment.
Something went wrong with that request. Please try again.