Permalink
Browse files

New Hierarchical location system and read-only database actions.

darcs-hash:20071221061522-2da90-331abfb750e6a7e5a317f72352ef0ee4dd13a7ee.gz
  • Loading branch information...
1 parent 56752ae commit 04e38eff74cd67a594fb919ff13cef37e8ec4522 @clanehin committed Dec 21, 2007
Showing with 1,006 additions and 697 deletions.
  1. +5 −10 Makefile
  2. +30 −27 src/Attribute.hs
  3. +8 −6 src/AttributeData.hs
  4. +4 −5 src/BeginGame.hs
  5. +22 −33 src/Creature.hs
  6. +144 −101 src/DB.hs
  7. +263 −76 src/DBData.hs
  8. +161 −0 src/DBPrivate.hs
  9. +21 −55 src/Dice.hs
  10. +11 −23 src/GridRayCaster.hs
  11. +180 −0 src/HierarchicalDatabase.hs
  12. +0 −188 src/InsidenessMap.hs
  13. +4 −5 src/Main.hs
  14. +38 −55 src/Plane.hs
  15. +3 −11 src/PlaneData.hs
  16. +41 −33 src/PlaneVisibility.hs
  17. +41 −33 src/Protocol.hs
  18. +6 −11 src/RNG.hs
  19. +11 −11 src/Races.hs
  20. +2 −2 src/RandomUtils.hs
  21. +7 −7 src/SpeciesData.hs
  22. +1 −2 src/Stats.hs
  23. +3 −3 src/ToolData.hs
View
@@ -6,9 +6,7 @@ HS_FLAGS = -hidir products/ \
--make src/Main.hs \
-o products/roguestar-engine
-default : ghc
-
-release : ghc-release
+default : roguestar-engine
update :
darcs pull --all
@@ -25,16 +23,13 @@ clean :
doc :
${MAKE} -C haddock
-ghc :
+roguestar-engine :
@echo "warning: you're building with development flags on (-Werror, no optimization)"
@echo " did you want to 'make release' ?"
- ghc -Werror ${HS_FLAGS}
-
-ghc-prof :
- ghc ${HS_FLAGS} -prof -auto-all
+ ghc-6.8.2 -Werror ${HS_FLAGS} -prof -auto-all
-ghc-release :
- ghc -O2 -fvia-c ${HS_FLAGS}
+release :
+ ghc -O2 ${HS_FLAGS}
check:
${MAKE} clean
View
@@ -1,21 +1,21 @@
--------------------------------------------------------------------------
--- roguestar-engine: the space-adventure roleplaying game backend.
--- Copyright (C) 2006 Christopher Lane Hinson <lane@downstairspeople.org>
---
--- This program is free software; you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation; either version 2 of the License, or
--- (at your option) any later version.
---
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--- GNU General Public License for more details.
---
--- You should have received a copy of the GNU General Public License along
--- with this program; if not, write to the Free Software Foundation, Inc.,
--- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
---
+-- roguestar-engine: the space-adventure roleplaying game backend.
+-- Copyright (C) 2007,2006 Christopher Lane Hinson <lane@downstairspeople.org>
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License along
+-- with this program; if not, write to the Free Software Foundation, Inc.,
+-- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+--
--------------------------------------------------------------------------
module Attribute
@@ -26,22 +26,25 @@ import AttributeData
import DB
import Dice
import Data.Maybe
+import Data.Ratio
---
+-- |
-- Randomly generate 1 attribute from an attribute generator.
--
generate1Attribute :: AttributeGenerator a -> DB (Maybe a)
generate1Attribute (AttributeAlways someAttrib) = do return (Just someAttrib)
-generate1Attribute (AttributeSometimes someAttrib percentage_chance maybeNextGen) = do percentage_roll <- (1 `d` 100)
- if (percentage_roll <= percentage_chance)
- then return (Just someAttrib)
- else case maybeNextGen of
- Just nextGen -> generate1Attribute nextGen
- Nothing -> return Nothing
+generate1Attribute (AttributeSometimes someAttrib chance maybeNextGen) =
+ do good <- roll $ map (<= numerator chance) [1..denominator chance]
+ if good
+ then return (Just someAttrib)
+ else case maybeNextGen of
+ Just nextGen -> generate1Attribute nextGen
+ Nothing -> return Nothing
---
+-- |
-- Randomly generate attributes from a list of AttributeGenerators.
--
generateAttributes :: [AttributeGenerator a] -> DB [a]
-generateAttributes attribGens = do maybeAttribs <- mapM generate1Attribute attribGens
- return $ map fromJust $ filter isJust maybeAttribs
+generateAttributes attribGens =
+ do maybeAttribs <- mapM generate1Attribute attribGens
+ return $ map fromJust $ filter isJust maybeAttribs
View
@@ -24,29 +24,31 @@ module AttributeData
multipleAttribute)
where
+import Data.List
+
-- |
-- Used to randomly generate attributes for an entity.
-- AttributeAlways is a generator that always creates the specified attribute.
-- (AttributeSometimes attrib x $ otherwise) is a generator that generates
--- the the attribute "attrib" x-percent of the time, and invokes the attribute
+-- the the attribute "attrib" x-fraction of the time, and invokes the attribute
-- generator "otherwise" otherwise.
--
data AttributeGenerator a = AttributeAlways a
- | AttributeSometimes a Integer (Maybe (AttributeGenerator a))
+ | AttributeSometimes a Rational (Maybe (AttributeGenerator a))
deriving (Show, Read)
-- |
-- Grants the entity the specified attribute x percent of the time, otherwise nothing
--
-percentAttribute :: a -> Integer -> AttributeGenerator a
+percentAttribute :: a -> Rational -> AttributeGenerator a
percentAttribute attr x = AttributeSometimes attr x $ Nothing
-- |
-- Grants the entity the specified attribute between minimum and maximum instances of the
-- attribute, on average the average of the two (as a binomial distribution).
--
-multipleAttribute :: a -> (Int,Int) -> [AttributeGenerator a]
+multipleAttribute :: a -> (Integer,Integer) -> [AttributeGenerator a]
multipleAttribute attr (mini,maxi) | mini >= 0 && maxi >= mini =
- (replicate mini $ AttributeAlways attr) ++ (replicate (maxi-mini) $ percentAttribute attr 50)
-multipleAttribute _ _ = error "maximum < minimum badness"
+ (genericReplicate mini $ AttributeAlways attr) ++ (genericReplicate (maxi-mini) $ percentAttribute attr 50)
+multipleAttribute _ _ = error "multipleAttribute: maximum < minimum badness"
View
@@ -28,6 +28,7 @@ import Character
import CharacterData
import DB
import DBData
+import Facing
import TerrainData
import Data.Maybe
import ToolData
@@ -59,11 +60,9 @@ dbCreateStartingPlane creature =
dbBeginGame :: Creature -> CharacterClass -> DB ()
dbBeginGame creature character_class =
do let first_level_creature = applyCharacterClass character_class creature
- creature_ref <- dbAddCreature first_level_creature
plane_ref <- dbCreateStartingPlane creature
landing_site <- pickRandomClearSite 200 30 2 plane_ref
- dbMoveInto plane_ref creature_ref (DBCoordinateLocation landing_site)
- a_phase_pistol <- dbAddTool phase_pistol
- phaser_spot <- pickRandomClearSite 200 30 2 plane_ref
- dbMoveInto plane_ref a_phase_pistol (DBCoordinateLocation phaser_spot)
+ creature_ref <- dbAddCreature first_level_creature (Standing plane_ref landing_site Here)
+ phaser_position <- pickRandomClearSite 200 30 2 plane_ref
+ dbAddTool phase_pistol (Dropped plane_ref phaser_position)
dbSetState $ DBPlayerCreatureTurn creature_ref
View
@@ -24,18 +24,17 @@ module Creature
creatureTests,
dbNewCreature,
dbTurnCreature,
- dbWalkCreature)
+ dbStepCreature)
where
-import Data.Maybe
import Control.Monad.State
+import Data.Maybe
import CreatureData
import DB
import SpeciesData
import Species
import Tests
import DBData
-import Dice
import FactionData
import Facing
@@ -49,7 +48,7 @@ runCreatureGenerationTest = do db0 <- initialDB
dbGenerateCreature :: Faction -> Species -> DB Creature
dbGenerateCreature faction species =
do (stats,attribs,name) <- generateCreatureData species
- random_id <- 1 `d` 2000
+ random_id <- dbNextRandomInteger
return (Creature { creature_stats=stats,
creature_attribs=attribs,
creature_species_name=name,
@@ -70,40 +69,30 @@ dbGenerateInitialPlayerCreature species =
-- |
-- Generates a new Creature from the specified Species and adds it to the database.
--
-dbNewCreature :: Faction -> Species -> DB CreatureRef
-dbNewCreature faction species =
- do dbAddCreature =<< dbGenerateCreature faction species
+dbNewCreature :: (CreatureLocation l) => Faction -> Species -> l -> DB CreatureRef
+dbNewCreature faction species loc =
+ do creature <- dbGenerateCreature faction species
+ dbAddCreature creature loc
-- |
-- Causes the creature to walk in the specified facing direction.
-dbWalkCreature :: Facing -> CreatureRef -> DB ()
-dbWalkCreature facing creature_ref =
- do dbTurnCreature facing creature_ref
- loc <- liftM (snd . fromJust) $ dbWhere creature_ref
- let loc' = case loc of
- DBCoordinateLocation (x,y) ->
- DBCoordinateLocation ((x+delta_x,y+delta_y))
- DBCoordinateFacingLocation ((x,y),old_facing) ->
- DBCoordinateFacingLocation ((x+delta_x,y+delta_y),old_facing)
- (delta_x,delta_y) = facingToRelative facing
--- movement_cost = case (abs delta_x,abs delta_y) of
--- (0,0) -> 0%1
--- (1,0) -> x%1
--- (0,1) -> y%1
--- (1,1) -> 7%5
--- _ -> error "dbWalkCreature: facingToRelative should only answer in the range -1..1
- dbMoveTo creature_ref loc'
+--
+dbWalkCreature :: Facing -> (Integer,Integer) -> CreatureRef -> DB ()
+dbWalkCreature face (x',y') creature_ref =
+ do dbMove creature_ref $ \l -> return $ fromMaybe l $
+ do p <- liftM location $ toPlanarLocation l
+ Position (x,y) <- liftM location $ toPositionLocation l
+ return $ genericLocationP $
+ standCreature l (Standing { standing_plane = p,
+ standing_position = Position (x+x',y+y'),
+ standing_facing = face })
+ return ()
+
+dbStepCreature :: Facing -> CreatureRef -> DB ()
+dbStepCreature face = dbWalkCreature face (facingToRelative face)
dbTurnCreature :: Facing -> CreatureRef -> DB ()
-dbTurnCreature facing creature_ref =
- do loc <- liftM (snd . fromJust) $ dbWhere creature_ref
- let loc' = case loc of
- DBCoordinateLocation xy ->
- DBCoordinateFacingLocation (xy,facing)
- DBCoordinateFacingLocation (xy,_) ->
- DBCoordinateFacingLocation (xy,facing)
--- movement_cost = facingDistance old_facing facing % 4
- dbMoveTo creature_ref loc'
+dbTurnCreature face = dbWalkCreature face (0,0)
creatureTests :: [TestCase]
creatureTests = [testHitPointCalculation,testAlive,testDead,
Oops, something went wrong. Retry.

0 comments on commit 04e38ef

Please sign in to comment.