a couple more tweaks before the release

LambdaHack.cabal

@@ -1,16 +1,24 @@
 cabal-version: >= 1.2
 name:          LambdaHack
-version:       0.1.20110117
+version:       0.1.20110918
 license:       BSD3
 license-file:  LICENSE
-tested-with:   GHC==7.0.3
+tested-with:   GHC == 6.12.3, GHC == 7.3.20110911
 data-files:    LICENSE, CREDITS, DESIGN.markdown, PLAYING.markdown,
                README.markdown, src/config.default, scores
-author:        Andres Loeh <mail@andres-loeh.de>
+author:        Andres Loeh, Mikolaj Konarski
 maintainer:    Andres Loeh <mail@andres-loeh.de>
-description:   a small roguelike game
-synopsis:      a small roguelike game
+description:   This is an alpha release of LambdaHack, a roguelike game engine
+               packaged together with a small example roguelike game
+               (not yet well separated, this is one of future work directions,
+               another being the improvement of the AI monad EDSL,
+               so that the rules for synthesising monster behaviour
+               from game content are more readable and easier to debug).
+               A larger game using this engine will be Allure of the Stars
+               (http://hackage.haskell.org/package/Allure).
+synopsis:      A roguelike game engine in early development
 homepage:      http://github.com/kosmikus/LambdaHack
+bug-reports:   http://github.com/kosmikus/LambdaHack/issues
 category:      Game
 build-type:    Simple
 
@@ -27,7 +35,8 @@ executable LambdaHack
   hs-source-dirs:src
   other-modules: Action, Actions, ActorAdd, ActorKind, Actor, ActorState,
                  Color, Command, Config, ConfigDefault,
-                 Display, Dungeon, DungeonState, Effect, EffectAction, File,
+                 Display, Dungeon, DungeonState,
+                 Effect, EffectAction, File, Flavour,
                  FOV, FOV.Common, FOV.Digital, FOV.Permissive, FOV.Shadow,
                  Frequency, Geometry, GeometryRnd, Grammar,
                  HighScores, Item, ItemKind, ItemAction,
@@ -40,10 +49,16 @@ executable LambdaHack
                  random >= 1 && < 2, zlib >= 0.4 && < 1,
                  bytestring >= 0.9 && < 1, directory >= 1 && < 2,
                  mtl >= 1.1 && < 3, old-time, ConfigFile >= 1.0.6 && < 2,
-                 MissingH >= 1.1.0.3 && < 1.2, filepath >= 1.1.0.3 && < 2,
-                 template-haskell >= 2.5
+                 MissingH >= 1.1.0.3 && < 1.2, filepath >= 1.1.0.3 && < 2
   extensions:    CPP, FlexibleContexts, QuasiQuotes, MultiParamTypeClasses,
                  RankNTypes, BangPatterns
+
+  if impl(ghc < 7.0)
+     -- GHC 6.12.3 does not like template-haskell 2.6 and 7.3 does not like 2.5
+      build-depends: template-haskell >= 2.5 && < 2.6
+  else
+      build-depends: template-haskell >= 2.5
+
   if flag(curses) {
     other-modules: Display.Curses
     build-depends: hscurses >= 1.3 && < 2
@@ -59,6 +74,6 @@ executable LambdaHack
     ghc-options:   -threaded
   } }
 
-Source-repository head
+source-repository head
   type:              git
   location:          git://github.com/kosmikus/LambdaHack.git

PLAYING.markdown

@@ -83,7 +83,8 @@ the hero run in that direction until something interesting occurs.
 It is also possible to move using the numerical keypad, with Shift for running
 and the middle '5' key for waiting. (If you are using the curses frontend,
 numerical keypad may not work correctly for terminals with broken terminfo,
-e.g., gnome terminal has problems, while xterm works fine.)
+e.g., gnome terminal has problems, while xterm works fine,
+though only under older versions of hscurses.)
 
 To make a distance attack, you need to set your target first.
 The targeting commands are listed below, together with all the other

README.markdown

@@ -4,8 +4,8 @@ LambdaHack
 LambdaHack is a small [roguelike] [1] game written in [Haskell] [2].
 It is getting more and more configurable and aims to become a flexible
 rouguelike engine, suitable for large and small dungeon crawling games
-of arbitrary themes. In particular, we try to keep AI independent
-of monster, item and terrain definitions.
+of arbitrary themes. In particular, we try to keep the AI code independent
+of particular monster, item and terrain definitions.
 
 
 Compilation and installation

src/Actions.hs

@@ -192,7 +192,8 @@ continueRun dir =
           -- in corridors, explore all corners and stop at all crossings
           -- TODO: even in corridors, stop if you run past an exit (rare)
           let ns = L.filter (\ x -> distance (neg dir, x) > 1
-                                    && accessible lmap loc (loc `shift` x))
+                                    && (accessible lmap loc (loc `shift` x))
+                                        || openable 1 lmap (loc `shift` x))
                             moves
               allCloseTo main = L.all (\ d -> distance (main, d) <= 1) ns
           in  case ns of
@@ -572,9 +573,8 @@ actorAttackActor source target = do
   let groupName = "sword"
       verb = attackToVerb groupName
       sloc = aloc sm
-      swordKindIndex = fromJust $ L.elemIndex ItemKind.sword ItemKind.loot
       -- The hand-to-hand "weapon", equivalent to +0 sword.
-      h2h = Item swordKindIndex 0 Nothing 1
+      h2h = Item ItemKind.swordKindId 0 Nothing 1
       str = strongestItem (aitems sm) groupName
       stack  = fromMaybe h2h str
       single = stack { icount = 1 }

src/Color.hs

@@ -50,8 +50,8 @@ colorToRGB Yellow    = "#AA5500"  -- brown
 colorToRGB Blue      = "#203AF0"
 colorToRGB Magenta   = "#AA00AA"
 colorToRGB Cyan      = "#00AAAA"
-colorToRGB White     = "#BEBABA"
-colorToRGB BrBlack   = "#6A6565"
+colorToRGB White     = "#C5BCB8"
+colorToRGB BrBlack   = "#6F5F5F"
 colorToRGB BrRed     = "#FF5555"
 colorToRGB BrGreen   = "#75FF45"
 colorToRGB BrYellow  = "#FFE855"

src/Display/Curses.hs

@@ -80,7 +80,7 @@ keyTranslate e =
     C.KeyBeg         -> K.Begin
     C.KeyB2          -> K.Begin
     C.KeyClear       -> K.Begin
-    -- No KP_ keys in hscurses and they do not seem actively maintained.
+    -- No KP_ keys; see https://github.com/skogsbaer/hscurses/issues/10
     -- For now, movement keys are more important than hero selection:
     C.KeyChar c
       | c `elem` ['1'..'9'] -> K.KP c

src/Display/Gtk.hs

@@ -79,7 +79,7 @@ startup k =
                                _ -> return False)
 
     let black = Color minBound minBound minBound  -- Color.defBG == Color.Black
-        white = Color 0xAAAA 0xAAAA 0xAAAA        -- Color.defFG == Color.White
+        white = Color 0xC500 0xBC00 0xB800        -- Color.defFG == Color.White
     widgetModifyBase tv StateNormal black
     widgetModifyText tv StateNormal white
 

src/Display/Vty.hs

@@ -65,7 +65,7 @@ nextEvent session =
 
 -- A hack to get bright colors via the bold attribute. Depending on terminal
 -- settings this is needed or not and the characters really get bold or not.
--- HCurses does this by default, but vty refuses to get crazy.
+-- HSCurses does this by default, but in Vty you have to request the hack.
 hack c a = if Color.isBright c then with_style a bold else a
 
 setAttr (fg, bg) =

src/EffectAction.hs

@@ -209,9 +209,9 @@ focusIfAHero target =
 summonHeroes :: Int -> Loc -> Action ()
 summonHeroes n loc =
   assert (n > 0) $ do
-  newHeroIndex <- gets (fst . scounter)
+  newHeroId <- gets (fst . scounter)
   modify (\ state -> iterate (addHero loc) state !! n)
-  assertTrue $ selectPlayer (AHero newHeroIndex)
+  assertTrue $ selectPlayer (AHero newHeroId)
   -- Display status line for the new hero.
   display >> return ()
 

src/Flavour.hs

@@ -0,0 +1,21 @@
+module Flavour where
+
+import qualified Data.List as L
+import Color
+
+-- TODO: add more variety, as the number of items increases
+type Flavour = (Color, Bool)  -- the flag tells to use fancy color names
+
+zipPlain cs = L.zip cs (repeat False)
+zipFancy cs = L.zip cs (repeat True)
+darkCol    = [Red .. Cyan]
+brightCol  = [BrRed .. BrCyan]  -- BrBlack is not really that bright
+stdCol     = darkCol ++ brightCol
+stdFlav    = zipPlain stdCol ++ zipFancy stdCol
+
+flavourToName :: Flavour -> String
+flavourToName (c, False) = colorToName c
+flavourToName (c, True) = colorToName' c
+
+flavourToColor :: Flavour -> Color
+flavourToColor (c, _) = c

src/Grammar.hs

@@ -11,7 +11,7 @@ import ActorKind
 import State
 import ItemKind
 import Effect
-
+import Flavour
 
 suffixS :: String -> String
 suffixS word = case last word of

src/HighScores.hs

@@ -79,7 +79,6 @@ showScore (pos, score) =
       time  = calendarTimeToString . toUTCTime . date $ score
       big   = "                                                 "
       lil   = "              "
-      -- TODO: later: https://github.com/kosmikus/LambdaHack/issues#issue/9
       steps = negTurn score `div` (-10)
   in
    printf

src/Item.hs

@@ -4,6 +4,7 @@ import Data.Binary
 import Data.Set as S
 import Data.List as L
 import qualified Data.IntMap as IM
+import qualified Data.Map as M
 import Data.Maybe
 import Data.Char
 import Data.Function
@@ -12,10 +13,11 @@ import Control.Monad
 import Random
 import ItemKind
 import qualified Color
+import Flavour
 
 data Item = Item
-  { ikind    :: !Int,  -- TODO: perhaps make a newtype instead of the Int
-    ipower   :: !Int,  -- https://github.com/Mikolaj/LambdaHack/issues#issue/11
+  { ikind    :: !ItemKindId,
+    ipower   :: !Int,  -- TODO: see the TODO about jpower
     iletter  :: Maybe Char,  -- ^ inventory identifier
     icount   :: !Int }
   deriving Show
@@ -25,39 +27,39 @@ instance Binary Item where
     put ikind >> put ipower >> put iletter >> put icount
   get = liftM4 Item get get get get
 
-type Assocs = IM.IntMap Flavour
+type Assocs = M.Map ItemKindId Flavour  -- TODO: rewrite and move elsewhere
 
-type Discoveries = S.Set Int
+type Discoveries = S.Set ItemKindId
 
 -- | Assinges flavours to item kinds. Assures no flavor is repeated,
 -- except for items with only one permitted flavour.
-rollAssocs :: Int -> ItemKind ->
-              Rnd (IM.IntMap Flavour, S.Set Flavour) ->
-              Rnd (IM.IntMap Flavour, S.Set Flavour)
-rollAssocs key kind rnd =
-  if L.length (jflavour kind) == 1
+rollAssocs :: ItemKindId -> [Flavour] ->
+              Rnd (Assocs, S.Set Flavour) ->
+              Rnd (Assocs, S.Set Flavour)
+rollAssocs key flavours rnd =
+  if L.length flavours == 1
   then rnd
   else do
     (assocs, available) <- rnd
-    let proper = S.fromList (jflavour kind) `S.intersection` available
+    let proper = S.fromList flavours `S.intersection` available
     flavour <- oneOf (S.toList proper)
-    return (IM.insert key flavour assocs, S.delete flavour available)
+    return (M.insert key flavour assocs, S.delete flavour available)
 
 -- | Randomly chooses flavour for all item kinds for this game.
 dungeonAssocs :: Rnd Assocs
 dungeonAssocs =
   liftM fst $
-  IM.foldWithKey rollAssocs (return (IM.empty, S.fromList stdFlav)) dungeonLoot
+  M.foldWithKey rollAssocs (return (M.empty, S.fromList stdFlav)) itemFlavours
 
-getFlavour :: Assocs -> Int -> Flavour
+getFlavour :: Assocs -> ItemKindId -> Flavour
 getFlavour assocs ik =
   let kind = ItemKind.getIK ik
   in  case jflavour kind of
         []  -> error "getFlavour"
         [f] -> f
-        _:_ -> assocs IM.! ik
+        _:_ -> assocs M.! ik
 
-viewItem :: Int -> Assocs -> (Char, Color.Color)
+viewItem :: ItemKindId -> Assocs -> (Char, Color.Color)
 viewItem ik assocs = (jsymbol (getIK ik), flavourToColor $ getFlavour assocs ik)
 
 itemLetter :: ItemKind -> Maybe Char
@@ -66,9 +68,7 @@ itemLetter ik = if jsymbol ik == '$' then Just '$' else Nothing
 -- | Generate an item.
 newItem :: Int -> Rnd Item
 newItem lvl = do
-  let dLoot = IM.assocs dungeonLoot
-      fik = Frequency $ L.zip (L.map (jfreq . snd) dLoot) (L.map fst dLoot)
-  ikChosen <- frequency fik
+  ikChosen <- frequency itemFrequency
   let kind = getIK ikChosen
   count <- rollQuad lvl (jcount kind)
   if count == 0

src/ItemKind.hs

@@ -1,11 +1,18 @@
-module ItemKind where
+module ItemKind
+  (ItemKind(..), ItemKindId, getIK, itemFrequency, itemFlavours, swordKindId)
+  where
 
+import Data.Binary
 import qualified Data.List as L
+import qualified Data.Map as M
 import qualified Data.IntMap as IM
+import Control.Monad
+import Data.Maybe
 
 import Color
 import Effect
 import Random
+import Flavour
 
 -- TODO: jpower is out of place here. It doesn't make sense for all items,
 -- and will mean different things for different items. Perhaps it should
@@ -26,26 +33,31 @@ data ItemKind = ItemKind
   }
   deriving (Show, Eq, Ord)
 
-type Flavour = (Color, Bool)  -- the flag tells to use fancy color names
+newtype ItemKindId = ItemKindId Int
+  deriving (Show, Eq, Ord)
+
+instance Binary ItemKindId where
+  put (ItemKindId i) = put i
+  get = liftM ItemKindId get
+
+itemAssocs :: [(Int, ItemKind)]
+itemAssocs = L.zip [0..] loot
 
-zipPlain cs = L.zip cs (repeat False)
-zipFancy cs = L.zip cs (repeat True)
-darkCol    = [Red .. Cyan]
-brightCol  = [BrRed .. BrCyan]  -- BrBlack is not really that bright
-stdCol     = darkCol ++ brightCol
-stdFlav    = zipPlain stdCol ++ zipFancy stdCol
+itemContent :: IM.IntMap ItemKind
+itemContent = IM.fromDistinctAscList itemAssocs
 
-flavourToName :: Flavour -> String
-flavourToName (c, False) = colorToName c
-flavourToName (c, True) = colorToName' c
+getIK :: ItemKindId -> ItemKind
+getIK (ItemKindId i) = itemContent IM.! i
 
-flavourToColor :: Flavour -> Color
-flavourToColor (c, _) = c
+itemFrequency :: Frequency ItemKindId
+itemFrequency = Frequency [(jfreq ik, ItemKindId i) | (i, ik) <- itemAssocs]
 
-dungeonLoot :: IM.IntMap ItemKind
-dungeonLoot = IM.fromDistinctAscList (L.zip [0..] loot)
+itemFlavours :: M.Map ItemKindId [Flavour]
+itemFlavours =
+  M.fromDistinctAscList [(ItemKindId i, jflavour ik) | (i, ik) <- itemAssocs]
 
-getIK ik = dungeonLoot IM.! ik
+swordKindId :: ItemKindId
+swordKindId = ItemKindId $ fromJust $ L.elemIndex sword loot
 
 loot :: [ItemKind]
 loot =

src/State.hs

@@ -52,7 +52,7 @@ defaultState dng lvl =
     []
     Implicit Normal
     0
-    IM.empty
+    M.empty
     S.empty
     dng
     lvl