diff options
| author | ChristopherLaneHinson <> | 2011-04-08 00:55:31 (GMT) |
|---|---|---|
| committer | Luite Stegeman <luite@luite.com> | 2011-04-08 00:55:31 (GMT) |
| commit | 1a6409823a4dfe256e1907e2b8439a8b544db9e5 (patch) | |
| tree | db2676c10d92d6eb0e2f0abf4cf400031155e5f7 | |
| parent | a75d811abbcd3a8482cee976bf79a2ff99102ea1 (diff) | |
| -rw-r--r-- | roguestar-engine.cabal | 39 | ||||
| -rw-r--r-- | src/DB.hs | 4 | ||||
| -rw-r--r-- | src/Protocol.hs | 4 |
3 files changed, 25 insertions, 22 deletions
diff --git a/roguestar-engine.cabal b/roguestar-engine.cabal index f33bef0..90f01bc 100644 --- a/roguestar-engine.cabal +++ b/roguestar-engine.cabal @@ -1,18 +1,10 @@ name: roguestar-engine -version: 0.6.0.0 -cabal-version: -any +version: 0.6.0.1 +cabal-version: >=1.2 build-type: Simple license: OtherLicense license-file: LICENSE maintainer: Christopher Lane Hinson <lane@downstairspeople.org> -build-depends: hslogger >=1.1.0 && <1.2, - priority-sync >=0.2.1.0 && <0.3, PSQueue >=1.1 && <1.2, - bytestring >=0.9.1.5 && <0.10, parallel >=2.2.0.1 && <2.3, - stm >=2.1.1.2 && <2.2, data-memocombinators >=0.4.0 && <0.5, - MonadRandom >=0.1.4 && <0.2, MaybeT >=0.1.2 && <0.2, - mtl >=1.1.0.2 && <1.2, random >=1.0.0.2 && <1.1, - old-time >=1.0.0.3 && <1.1, array >=0.3.0.0 && <0.3.1, - containers >=0.3.0.0 && <0.3.1, base >=4 && <5 homepage: http://roguestar.downstairspeople.org/ synopsis: Sci-fi roguelike game. Backend. description: Requires roguestar and roguestar-glut. @@ -20,11 +12,18 @@ category: Game author: Christopher Lane Hinson tested-with: GHC ==6.12.1 -executable: roguestar-engine -main-is: Main.hs -pkgconfig-depends: -hs-source-dirs: src -other-modules: TravelData VisibilityData Stats FactionData Behavior +executable roguestar-engine + main-is: Main.hs + hs-source-dirs: src + build-depends: hslogger >=1.1.0 , + priority-sync >=0.2.1.1 && <0.3, PSQueue >=1.1 && <1.2, + bytestring >=0.9.1.5, parallel >=2.2.0.1 , + stm >=2.1.1.2, data-memocombinators >=0.4.0 && <0.5, + MonadRandom >=0.1.4 && <0.2, MaybeT >=0.1.2 && <0.2, + mtl >=1.1.0.2, random >=1.0.0.2 && <1.1, + old-time >=1.0.0.3 && <1.1, array >=0.3.0.0 && <0.3.1, + containers >=0.3.0.0, base >=4 && <5 + other-modules: TravelData VisibilityData Stats FactionData Behavior Alignment PlaneData Grids Perception PlaneVisibility Turns Plane CreatureData StatsData Protocol Character Tool Substances HierarchicalDatabase Travel ToolData CharacterData Creature Facing @@ -34,6 +33,10 @@ other-modules: TravelData VisibilityData Stats FactionData Behavior Random PlayerState MakeData DBErrorFlag Construction Make Activate Contact DeviceActivation WorkCluster Planet PlanetData Logging NodeData CharacterAdvancement -ghc-prof-options: -prof -auto-all -ghc-shared-options: -prof -auto-all -ghc-options: -threaded -fno-warn-type-defaults + ghc-prof-options: -prof -auto-all + ghc-shared-options: -prof -auto-all + if impl(ghc >= 7.0) + ghc-options: -threaded -fno-warn-type-defaults -rtsopts=all + else + ghc-options: -threaded -fno-warn-type-defaults + @@ -192,9 +192,9 @@ mapRO f xs = liftM (`using` parList rwhnf) $ mapM (dbSimulate . f) xs sortByRO :: (DBReadable db,Ord b) => (forall m. DBReadable m => a -> m b) -> [a] -> db [a] sortByRO f xs = - liftM (List.map fst . sortBy (comparing snd)) $ flip mapRO xs $ \x -> + liftM (List.map fst . sortBy (comparing snd)) $ mapRO (\x -> do y <- f x - return (x,y) + return (x,y)) xs -- | Run action synthesized from a read-only action (prepare-execute pattern). atomic :: (x -> DB ()) -> (forall m. DBReadable m => m x) -> DB x diff --git a/src/Protocol.hs b/src/Protocol.hs index 3d21ac0..d62fce7 100644 --- a/src/Protocol.hs +++ b/src/Protocol.hs @@ -352,11 +352,11 @@ dbDispatchQuery ["object-details",uid] = ro $ do maybe_plane_ref <- dbGetCurrentPlane (visibles :: [Reference ()]) <- maybe (return []) - (flip dbGetVisibleObjectsForFaction Player $ \ref -> + (dbGetVisibleObjectsForFaction (\ref -> do let f = (== uid) . B.pack . show . toUID let m_wielder = coerceReference ref m_wield <- maybe (return Nothing) dbGetWielded m_wielder - return $ maybe False f m_wield || f ref) + return $ maybe False f m_wield || f ref) Player) maybe_plane_ref let creature_refs = mapMaybe (coerceReferenceTyped _creature) visibles wielded <- liftM catMaybes $ mapM dbGetWielded creature_refs |