diff --git a/Display/Curses.hs b/Display/Curses.hs
--- a/Display/Curses.hs
+++ b/Display/Curses.hs
@@ -1,9 +1,9 @@
 module Display.Curses
   (displayId, startup, shutdown,
-   display, nextEvent, setBG, setFG, Session,
+   display, nextEvent, setBG, setFG, setBold, Session,
    white, black, yellow, blue, magenta, red, green, attr, Display.Curses.Attr) where
 
-import UI.HSCurses.Curses as C
+import UI.HSCurses.Curses as C hiding (setBold)
 import qualified UI.HSCurses.CursesHelper as C
 import Data.List as L
 import Data.Map as M
@@ -68,6 +68,8 @@
       C.KeyChar ':' -> return "colon"
       C.KeyChar ',' -> return "comma"
       C.KeyChar ' ' -> return "space"
+      C.KeyChar '?' -> return "question"
+      C.KeyChar '*' -> return "asterisk"
       C.KeyChar '\ESC' -> return "Escape"
       C.KeyChar c   -> return [c]
       C.KeyExit     -> return "Escape"
@@ -108,5 +110,6 @@
 red     = Red
 green   = Green
 
+setBold (f, b) = (f, b)
 setFG c (_, b) = (Just c, b)
-setBG c (f, b) = (f, Just c)
+setBG c (f, _) = (f, Just c)
diff --git a/Display/Gtk.hs b/Display/Gtk.hs
--- a/Display/Gtk.hs
+++ b/Display/Gtk.hs
@@ -1,6 +1,6 @@
 module Display.Gtk
   (displayId, startup, shutdown, 
-   display, nextEvent, setBG, setFG, Session,
+   display, nextEvent, setBG, setFG, setBold, Session,
    white, black, yellow, blue, magenta, red, green, attr, Attr) where
 
 import Control.Monad
@@ -125,18 +125,19 @@
     mapM_ (\ c -> textBufferApplyTag tb (tts ! c) ib ie) a
 
 nextEvent :: Session -> IO String
-nextEvent session = readChan (schan session)
+nextEvent = readChan . schan
 
-setBG c = (BG c :)
-setFG c = (FG c :)
-blue    = Blue
-magenta = Magenta
-red     = Red
-yellow  = Yellow
-green   = Green
-white   = White
-black   = Black
-attr    = []
+setBold   = id  -- not supported yet
+setBG c   = (BG c :)
+setFG c   = (FG c :)
+blue      = Blue
+magenta   = Magenta
+red       = Red
+yellow    = Yellow
+green     = Green
+white     = White
+black     = Black
+attr      = []
 
 type Attr = [AttrKey]
 
diff --git a/Display/Vty.hs b/Display/Vty.hs
--- a/Display/Vty.hs
+++ b/Display/Vty.hs
@@ -1,6 +1,6 @@
 module Display.Vty
   (displayId, startup, shutdown,
-   display, nextEvent, setBG, setFG, Session,
+   display, nextEvent, setBold, setBG, setFG, Session,
    white, black, yellow, blue, magenta, red, green, attr, Attr) where
 
 import Graphics.Vty as V
@@ -15,10 +15,7 @@
 type Session = V.Vty
 
 startup :: (Session -> IO ()) -> IO ()
-startup k =
-  do
-    session <- V.mkVty
-    k session
+startup k = V.mkVty >>= k
 
 display :: Area -> Session -> (Loc -> (Attr, Char)) -> String -> String -> IO ()
 display ((y0,x0),(y1,x1)) vty f msg status =
@@ -27,9 +24,9 @@
                       L.map (\ (x,y) -> let (a,c) = f (y,x) in renderChar a c)))
               [ [ (x,y) | x <- [x0..x1] ] | y <- [y0..y1] ]
     in  V.update vty (Pic NoCursor 
-         ((renderBS attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1-x0+1) msg)))) <->
+         (renderBS attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1 - x0 + 1) msg))) <->
           img <-> 
-          (renderBS attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1-x0+1) status))))))
+          renderBS attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1 - x0 + 1) status)))))
 
 toWidth :: Int -> String -> String
 toWidth n x = take n (x ++ repeat ' ')
@@ -45,6 +42,8 @@
       V.EvKey (KASCII ':') [] -> return "colon"
       V.EvKey (KASCII ',') [] -> return "comma"
       V.EvKey (KASCII ' ') [] -> return "space"
+      V.EvKey (KASCII '?') [] -> return "question"
+      V.EvKey (KASCII '*') [] -> return "asterisk"
       V.EvKey (KASCII c) []   -> return [c]
       V.EvKey KEsc []         -> return "Escape"
       V.EvKey KEnter []       -> return "Return"
diff --git a/Display2.hs b/Display2.hs
--- a/Display2.hs
+++ b/Display2.hs
@@ -11,9 +11,10 @@
 import Level
 import Perception
 import Monster
+import Item
 
 -- | Displays a message on a blank screen. Waits for confirmation.
-displayBlankConfirm :: Session -> String -> IO ()
+displayBlankConfirm :: Session -> String -> IO Bool
 displayBlankConfirm session txt =
   let x = txt ++ more
   in  do
@@ -21,19 +22,24 @@
         getConfirm session
 
 -- | Waits for a space or return.
-getConfirm :: Session -> IO ()
+getConfirm :: Session -> IO Bool
 getConfirm session =
+  getOptionalConfirm session return (const $ getConfirm session)
+
+getOptionalConfirm :: Session -> (Bool -> IO a) -> (String -> IO a) -> IO a
+getOptionalConfirm session h k =
   do
     e <- nextEvent session
-    handleModifier e (getConfirm session) $
+    handleModifier e (getOptionalConfirm session h k) $
       case e of
-        "space"  -> return ()
-        "Return" -> return ()
-        _        -> getConfirm session 
+        "space"  -> h True
+        "Return" -> h True
+        "Escape" -> h False
+        _        -> k e
 
 -- | Handler that ignores modifier events as they are
 --   currently produced by the Gtk frontend.
-handleModifier :: String -> IO () -> IO () -> IO ()
+handleModifier :: String -> IO a -> IO a -> IO a
 handleModifier e h k =
   case e of
     "Shift_R"   -> h
@@ -63,12 +69,35 @@
     "n" -> h (1,1)
     _   -> k
 
+splitOverlay :: Int -> String -> [[String]]
+splitOverlay s xs = splitOverlay' (lines xs)
+  where
+    splitOverlay' ls
+      | length ls <= s = [ls]  -- everything fits on one screen
+      | otherwise      = let (pre,post) = splitAt (s - 1) ls
+                         in  (pre ++ [more]) : splitOverlay' post
 
+-- | Returns a function that looks up the characters in the
+-- string by location. Takes the height of the display plus
+-- the string. Returns also the number of screens required
+-- to display all of the string.
+stringByLocation :: Y -> String -> (Int, Loc -> Maybe Char)
+stringByLocation sy xs =
+  let
+    ls   = splitOverlay sy xs
+    m    = M.fromList (zip [0..] (L.map (M.fromList . zip [0..]) (concat ls)))
+    k    = length ls
+  in
+    (k, \ (y,x) -> M.lookup y m >>= \ n -> M.lookup x n)
+
 displayLevel :: Session -> Level -> Perception -> State -> Message -> IO ()
-displayLevel session (lvl@(Level nm sz ms smap nlmap lmeta))
+displayLevel session lvl per state msg = displayOverlay session lvl per state msg "" >> return ()
+
+displayOverlay :: Session -> Level -> Perception -> State -> Message -> String -> IO Bool
+displayOverlay session (lvl@(Level nm sz@(sy,sx) ms smap nlmap lmeta))
                      per
-                     (state@(State { splayer = player@(Monster { mhp = php, mdir = pdir, mloc = ploc }), stime = time }))
-                     msg =
+                     (state@(State { splayer = player@(Monster { mhp = php, mdir = pdir, mloc = ploc }), stime = time, sassocs = assocs }))
+                     msg overlay =
     let
       reachable = preachable per
       visible   = pvisible per
@@ -83,28 +112,38 @@
                        else if rea then setBG magenta
                                    else id
                   else \ vis rea -> id
-      disp msg = 
+      (n,over) = stringByLocation (sy+1) overlay -- n is the number of overlay screens
+      gold    = maybe 0 (icount . fst) $ findItem (\ i -> iletter i == Just '$') (mitems player)
+      disp n msg = 
         display ((0,0),sz) session 
                  (\ loc -> let tile = nlmap `lAt` loc
                                sml  = ((smap ! loc) - time) `div` 100
                                vis  = S.member loc visible
                                rea  = S.member loc reachable
                                (rv,ra) = case L.find (\ m -> loc == mloc m) (player:ms) of
-                                           _ | sTer > 0          -> viewTerrain sTer (tterrain tile)
+                                           _ | sTer > 0          -> viewTerrain sTer False (tterrain tile)
                                            Just m | sOmn || vis  -> viewMonster (mtype m) 
                                            _ | sSml && sml >= 0  -> viewSmell sml
-                                             | otherwise         -> viewTile tile
+                                             | otherwise         -> viewTile vis tile assocs
                                vision = lVision vis rea
                            in
-                             (ra . vision $
-                              attr, rv))
+                             case over (loc `shift` ((sy+1) * n, 0)) of
+                               Just c  ->  (attr, c)
+                               _       ->  (ra . vision $ attr, rv))
                 msg
-                (take 40 (levelName nm ++ repeat ' ') ++ take 10 ("HP: " ++ show php ++ repeat ' ') ++
+                (take 40 (levelName nm ++ repeat ' ') ++
+                 take 10 ("$: " ++ show gold ++ repeat ' ') ++
+                 take 10 ("HP: " ++ show php ++ repeat ' ') ++
                  take 10 ("T: " ++ show (time `div` 10) ++ repeat ' '))
-      msgs = splitMsg (snd sz) msg
-      perf []     = disp ""
-      perf [xs]   = disp xs
-      perf (x:xs) = disp (x ++ more) >> getConfirm session >> perf xs
-    in perf msgs
+      msgs = splitMsg sx msg
+      perf k []     = perfo k ""
+      perf k [xs]   = perfo k xs
+      perf k (x:xs) = disp n (x ++ more) >> getConfirm session >>= \ b ->
+                      if b then perf k xs else return False
+      perfo k xs
+        | k < n - 1 = disp k xs >> getConfirm session >>= \ b ->
+                      if b then perfo (k+1) xs else return False
+        | otherwise = disp k xs >> return True
+    in perf 0 msgs
 
 
diff --git a/Dungeon.hs b/Dungeon.hs
--- a/Dungeon.hs
+++ b/Dungeon.hs
@@ -1,5 +1,6 @@
 module Dungeon where
 
+import Prelude hiding (floor)
 import Control.Monad
 
 import Data.Map as M
@@ -22,10 +23,18 @@
           Rnd Room    {- this is the upper-left and lower-right corner of the room -}
 mkRoom bd (ym,xm)((y0,x0),(y1,x1)) =
   do
-    (ry0,rx0) <- locInArea ((y0+bd,x0+bd),(y1-bd-ym+1,x1-bd-xm+1))
-    (ry1,rx1) <- locInArea ((ry0+ym-1,rx0+xm-1),(y1-bd,x1-bd))
+    (ry0,rx0) <- locInArea ((y0 + bd,x0 + bd),(y1 - bd - ym + 1,x1 - bd - xm + 1))
+    (ry1,rx1) <- locInArea ((ry0 + ym - 1,rx0 + xm - 1),(y1 - bd,x1 - bd))
     return ((ry0,rx0),(ry1,rx1))
 
+mkNoRoom :: Int ->      {- border columns -}
+            Area ->     {- this is an area, not the room itself -}
+            Rnd Room    {- this is the upper-left and lower-right corner of the room -}
+mkNoRoom bd ((y0,x0),(y1,x1)) =
+  do
+    (ry,rx) <- locInArea ((y0 + bd,x0 + bd),(y1 - bd,x1 - bd))
+    return ((ry,rx),(ry,rx))
+
 mkCorridor :: HV -> (Loc,Loc) -> Area -> Rnd [(Y,X)] {- straight sections of the corridor -}
 mkCorridor hv ((y0,x0),(y1,x1)) b =
   do
@@ -61,7 +70,7 @@
   where
     corridorUpdate _ (Tile (Wall hv) is,u)    = (Tile (Opening hv) is,u)
     corridorUpdate _ (Tile (Opening hv) is,u) = (Tile (Opening hv) is,u)
-    corridorUpdate _ (Tile Floor is,u)        = (Tile Floor is,u)
+    corridorUpdate _ (Tile (Floor l) is,u)    = (Tile (Floor l) is,u)
     corridorUpdate (x,u) _                    = (x,u)
 digCorridor _ l = l
   
@@ -72,69 +81,94 @@
            LevelName -> Rnd (Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)
 bigroom (LevelConfig { levelSize = (sy,sx) }) nm =
   do
-    let lmap = digRoom ((1,1),(sy-1,sx-1)) (emptyLMap (sy,sx))
+    let lmap = digRoom Light ((1,1),(sy-1,sx-1)) (emptyLMap (sy,sx))
     let smap = M.fromList [ ((y,x),-100) | y <- [0..sy], x <- [0..sx] ]
     let lvl = Level nm (sy,sx) [] smap lmap ""
     -- locations of the stairs
-    su <- findLoc lvl (const ((==Floor) . tterrain))
-    sd <- findLoc lvl (\ l t -> tterrain t == Floor && distance (su,l) > 676)
-    return $ (\ lu ld ->
-      let flmap = maybe id (\ l -> M.insert su (newTile (Stairs Up   l))) lu $
-                  maybe id (\ l -> M.insert sd (newTile (Stairs Down l))) ld $
+    su <- findLoc lvl (const floor)
+    sd <- findLoc lvl (\ l t -> floor t && distance (su,l) > 676)
+    return (\ lu ld ->
+      let flmap = maybe id (\ l -> M.insert su (newTile (Stairs Light Up   l))) lu $
+                  maybe id (\ l -> M.insert sd (newTile (Stairs Light Down l))) ld
                   lmap
       in  Level nm (sy,sx) [] smap flmap "bigroom", su, sd)
 
 data LevelConfig =
   LevelConfig {
-    levelGrid         :: (Y,X),
-    minRoomSize       :: (Y,X),
-    border            :: Int,      -- must be at least 2!
-    levelSize         :: (Y,X),    -- lower right point
-    extraConnects     :: Int,
-    minStairsDistance :: Int,      -- must not be too large
-    doorChance        :: Rational,
-    doorOpenChance    :: Rational,
-    doorSecretChance  :: Rational,
+    levelGrid         :: Rnd (Y,X),
+    minRoomSize       :: Rnd (Y,X),
+    darkRoomChance    :: Rnd Bool,
+    border            :: Int,       -- must be at least 2!
+    levelSize         :: (Y,X),     -- lower right point
+    extraConnects     :: (Y,X) -> Int, 
+                                    -- relative to grid
+                                    -- (in fact a range, because of duplicate connects)
+    noRooms           :: (Y,X) -> Rnd Int,
+                                    -- range, relative to grid
+    minStairsDistance :: Int,       -- must not be too large
+    doorChance        :: Rnd Bool,
+    doorOpenChance    :: Rnd Bool,
+    doorSecretChance  :: Rnd Bool,
     doorSecretMax     :: Int,
-    nrItems           :: (Int,Int)
+    nrItems           :: Rnd Int,   -- range
+    depth             :: Int        -- general indicator of difficulty
   }
     
-defaultLevelConfig :: LevelConfig
-defaultLevelConfig =
+defaultLevelConfig :: Int -> LevelConfig
+defaultLevelConfig d =
   LevelConfig {
-    levelGrid         = (3,3), -- (7,10), -- (3,3), -- (2,5)
-    minRoomSize       = (2,2),
+    levelGrid         = do
+                          y <- randomR (2,4)
+                          x <- randomR (3,5)
+                          return (y,x),
+    minRoomSize       = return (2,2),
+    darkRoomChance    = chance $ 1%((22 - (2 * fromIntegral d)) `max` 2),
     border            = 2,
-    levelSize         = (22,79), -- (77,231),  -- (22,79),
-    extraConnects     = 3,     -- 6
+    levelSize         = (22,79),
+    extraConnects     = \ (y,x) -> (y*x) `div` 3,   
+    noRooms           = \ (y,x) -> randomR (0,(y*x) `div` 3),
     minStairsDistance = 676,
-    doorChance        = 1%2,
-    doorOpenChance    = 1%2,
-    doorSecretChance  = 1%3,
+    doorChance        = chance $ 1%2,
+    doorOpenChance    = chance $ 1%2,
+    doorSecretChance  = chance $ 1%3,
     doorSecretMax     = 15,
-    nrItems           = (3,7)  -- range
+    nrItems           = randomR (3,7),
+    depth             = d
   }
 
-largeLevelConfig :: LevelConfig
-largeLevelConfig =
-  defaultLevelConfig {
-    levelGrid         = (7,10),
+largeLevelConfig :: Int -> LevelConfig
+largeLevelConfig d =
+  (defaultLevelConfig d) {
+    levelGrid         = return (7,10),
     levelSize         = (77,231),
-    extraConnects     = 10
+    extraConnects     = const 10
   }
 
 level :: LevelConfig ->
          LevelName -> Rnd (Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)
 level cfg nm =
   do
-    let gs = M.toList (grid (levelGrid cfg) ((0,0),levelSize cfg))
+    lgrid    <- levelGrid cfg
+    lminroom <- minRoomSize cfg
+    let gs = M.toList (grid lgrid ((0,0),levelSize cfg))
+    -- grid locations of "no-rooms"
+    nrnr <- noRooms cfg lgrid
+    nr   <- replicateM nrnr (do
+                               let (y,x) = lgrid
+                               yg <- randomR (0,y-1)
+                               xg <- randomR (0,x-1)
+                               return (yg,xg))
     rs0 <- mapM (\ (i,r) -> do
-                              r' <- mkRoom (border cfg) (minRoomSize cfg) r
+                              r' <- if i `elem` nr
+                                      then mkNoRoom (border cfg) r
+                                      else mkRoom (border cfg) lminroom r
                               return (i,r')) gs
-    let rooms = L.map snd rs0
+    let rooms :: [(Loc, Loc)]
+        rooms = L.map snd rs0
+    dlrooms <- (mapM (\ r -> darkRoomChance cfg >>= \ c -> return (r, toDL (not c))) rooms) :: Rnd [((Loc, Loc), DL)]
     let rs = M.fromList rs0
-    connects <- connectGrid (levelGrid cfg)
-    addedConnects <- replicateM (extraConnects cfg) (randomConnection (levelGrid cfg))
+    connects <- connectGrid lgrid
+    addedConnects <- replicateM (extraConnects cfg lgrid) (randomConnection lgrid)
     let allConnects = L.nub (addedConnects ++ connects)
     cs <- mapM
            (\ (p0,p1) -> do
@@ -144,7 +178,8 @@
     let smap = M.fromList [ ((y,x),-100) | let (sy,sx) = levelSize cfg,
                                            y <- [0..sy], x <- [0..sx] ]
     let lmap :: LMap
-        lmap = foldr digCorridor (foldr digRoom (emptyLMap (levelSize cfg)) rooms) cs
+        lmap = foldr digCorridor (foldr (\ (r, dl) m -> digRoom dl r m) 
+                                        (emptyLMap (levelSize cfg)) dlrooms) cs
     let lvl = Level nm (levelSize cfg) [] smap lmap "" 
     -- convert openings into doors
     dlmap <- fmap M.fromList . mapM
@@ -153,12 +188,12 @@
                     Tile (Opening hv) _ ->
                       do
                         -- chance for doors
-                        rb <- chance (doorChance cfg)
+                        rb <- doorChance cfg
                         -- chance for a door to be open
-                        ro <- chance (doorOpenChance cfg)
+                        ro <- doorOpenChance cfg
                         rs <- if ro then return Nothing
                                     else do -- chance for a door to be secret
-                                            rsc <- chance (doorSecretChance cfg)
+                                            rsc <- doorSecretChance cfg
                                             fmap Just
                                                  (if rsc then randomR (1, doorSecretMax cfg)
                                                          else return 0)
@@ -168,44 +203,49 @@
                     _ -> return o) .
                 M.toList $ lmap
     -- determine number of items, items and locations for the items
-    nri <- randomR (nrItems cfg)
+    nri <- nrItems cfg
     is  <- replicateM nri $
            do
-             l <- findLoc lvl (const ((==Floor) . tterrain))
-             t <- newItem itemFrequency 
+             l <- findLoc lvl (const floor)
+             t <- newItem (depth cfg) itemFrequency 
              return (l,t)
     -- locations of the stairs
-    su <- findLoc lvl (const ((==Floor) . tterrain))
-    sd <- findLoc lvl (\ l t -> tterrain t == Floor && distance (su,l) > minStairsDistance cfg)
+    su <- findLoc lvl (const floor)
+    sd <- findLoc lvl (\ l t -> floor t && distance (su,l) > minStairsDistance cfg)
     let meta = show allConnects
-    return $ (\ lu ld ->
-      let flmap = maybe id (\ l -> M.insert su (newTile (Stairs Up   l))) lu $
-                  maybe id (\ l -> M.insert sd (newTile (Stairs Down l))) ld $
-                  foldr (\ (l,it) f -> M.update (\ (t,r) -> Just (t { titems = it : titems t }, r)) l . f) id is $
+    return (\ lu ld ->
+      let flmap = maybe id (\ l -> M.update (\ (t,r) -> Just $ newTile (Stairs (toDL $ light t) Up   l)) su) lu $
+                  maybe id (\ l -> M.update (\ (t,r) -> Just $ newTile (Stairs (toDL $ light t) Down l)) sd) ld $
+                  foldr (\ (l,it) f -> M.update (\ (t,r) -> Just (t { titems = it : titems t }, r)) l . f) id is
                   dlmap
       in  Level nm (levelSize cfg) [] smap flmap meta, su, sd)
 
 emptyLMap :: (Y,X) -> LMap
 emptyLMap (my,mx) = M.fromList [ ((y,x),newTile Rock) | x <- [0..mx], y <- [0..my] ]
 
-digRoom :: Room -> LMap -> LMap
-digRoom ((y0,x0),(y1,x1)) l =
-  let rm = M.fromList $ [ ((y,x),newTile Floor) | x <- [x0..x1], y <- [y0..y1] ]
-                     ++ [ ((y,x),newTile (Wall Horiz)) | x <- [x0-1..x1+1], y <- [y0-1,y1+1] ]
-                     ++ [ ((y,x),newTile (Wall Vert)) | x <- [x0-1,x1+1], y <- [y0..y1] ]
+-- | If the room has size 1, it is assumed to be a no-room, and a single
+-- corridor field will be digged instead of a room.
+digRoom :: DL -> Room -> LMap -> LMap
+digRoom dl ((y0,x0),(y1,x1)) l
+  | y0 == y1 && x0 == x1 =
+  M.insert (y0,x0) (newTile Corridor) l
+  | otherwise =
+  let rm = M.fromList $ [ ((y,x),newTile (Floor dl))   | x <- [x0..x1],     y <- [y0..y1]    ]
+                     ++ [ ((y,x),newTile (Wall p)) | (x,y,p) <- [(x0-1,y0-1,UL),(x1+1,y0-1,UR),(x0-1,y1+1,DL),(x1+1,y1+1,DR)] ]
+                     ++ [ ((y,x),newTile (Wall p)) | x <- [x0..x1], (y,p) <- [(y0-1,U),(y1+1,D)] ]
+                     ++ [ ((y,x),newTile (Wall p)) | (x,p) <- [(x0-1,L),(x1+1,R)],  y <- [y0..y1]    ]
   in M.unionWith const rm l
 
 addMonster :: Level -> Player -> Rnd Level
 addMonster lvl@(Level { lmonsters = ms, lmap = lmap })
            player@(Monster { mloc = ploc }) =
   do
-    -- TODO: remove the hardcoded chance
-    rc <- chance (1 % if L.null ms then 50 else 700)
+    rc <- monsterGenChance (lname lvl) ms
     if rc
      then do
-            -- TODO: new monsters always be generated in a place that isn't
+            -- TODO: new monsters should always be generated in a place that isn't
             -- visible by the player (if possible -- not possible for bigrooms)
-            sm <- findLoc lvl (\ l t -> tterrain t == Floor && 
+            sm <- findLoc lvl (\ l t -> floor t && 
                                         not (l `L.elem` L.map mloc (player : ms)) &&
                                         distance (ploc, l) > 400)
             m <- newMonster sm monsterFrequency
diff --git a/FOV.hs b/FOV.hs
--- a/FOV.hs
+++ b/FOV.hs
@@ -20,7 +20,7 @@
 scan tr l d (s,e) = 
     let ps = downBias (s * fromIntegral d)   -- minimal progress to check
         pe = upBias (e * fromIntegral d)     -- maximal progress to check
-        st = if open (l `at` tr (d,ps)) then (Just s) -- start in light
+        st = if open (l `at` tr (d,ps)) then Just s   -- start in light
                                         else Nothing  -- start in shadow
     in 
         -- trace (show (d,s,e,ps,pe)) $
@@ -47,14 +47,14 @@
       | otherwise = scan' Nothing (ps+1) pe
                                       -- continue in shadow
 
-tr0 (oy,ox) (d,p) = (oy+d,ox+p)
-tr1 (oy,ox) (d,p) = (oy+d,ox-p)
-tr2 (oy,ox) (d,p) = (oy-d,ox+p)
-tr3 (oy,ox) (d,p) = (oy-d,ox-p)
-tr4 (oy,ox) (d,p) = (oy+p,ox+d)
-tr5 (oy,ox) (d,p) = (oy+p,ox-d)
-tr6 (oy,ox) (d,p) = (oy-p,ox+d)
-tr7 (oy,ox) (d,p) = (oy-p,ox-d)
+tr0 (oy,ox) (d,p) = (oy + d,ox + p)
+tr1 (oy,ox) (d,p) = (oy + d,ox - p)
+tr2 (oy,ox) (d,p) = (oy - d,ox + p)
+tr3 (oy,ox) (d,p) = (oy - d,ox - p)
+tr4 (oy,ox) (d,p) = (oy + p,ox + d)
+tr5 (oy,ox) (d,p) = (oy + p,ox - d)
+tr6 (oy,ox) (d,p) = (oy - p,ox + d)
+tr7 (oy,ox) (d,p) = (oy - p,ox - d)
 
 fullscan loc lvl = 
   S.unions $
diff --git a/File.hs b/File.hs
--- a/File.hs
+++ b/File.hs
@@ -14,9 +14,9 @@
       LBS.length d `seq` return d
 
 strictDecodeCompressedFile :: Binary a => FilePath -> IO a
-strictDecodeCompressedFile f = fmap decode (strictReadCompressedFile f)
+strictDecodeCompressedFile = fmap decode . strictReadCompressedFile
 
 encodeCompressedFile :: Binary a => FilePath -> a -> IO ()
-encodeCompressedFile f x = LBS.writeFile f (Z.compress (encode x))
+encodeCompressedFile f = LBS.writeFile f . Z.compress . encode
   -- note that LBS.writeFile opens the file in binary mode
 
diff --git a/Frequency.hs b/Frequency.hs
--- a/Frequency.hs
+++ b/Frequency.hs
@@ -28,4 +28,4 @@
 scale n (Frequency xs) = Frequency (map (\ (p, x) -> (n * p, x)) xs)
 
 uniform :: [a] -> Frequency a
-uniform xs = Frequency (map (\ x -> (1, x)) xs)
+uniform = Frequency . map (\ x -> (1, x))
diff --git a/Geometry.hs b/Geometry.hs
--- a/Geometry.hs
+++ b/Geometry.hs
@@ -29,6 +29,9 @@
 adjacent :: Loc -> Loc -> Bool
 adjacent s t = distance (s,t) <= 2
 
+surroundings :: Loc -> [Loc]
+surroundings l = map (l `shift`) moves
+
 diagonal :: Loc -> Bool
 diagonal (y,x) = y*x /= 0
 
@@ -40,3 +43,18 @@
 
 moves :: [Dir]
 moves = [ (x,y) | x <- [-1..1], y <- [-1..1], x /= 0 || y /= 0 ]
+
+up, down, left, right :: Dir
+upleft, upright, downleft, downright :: Dir
+upleft    = up `shift` left
+upright   = up `shift` right
+downleft  = down `shift` left
+downright = down `shift` right
+up        = (-1,0)
+down      = (1,0)
+left      = (0,-1)
+right     = (0,1)
+
+horiz, vert :: [Dir]
+horiz = [left, right]
+vert  = [up, down]
diff --git a/Item.hs b/Item.hs
--- a/Item.hs
+++ b/Item.hs
@@ -1,9 +1,11 @@
 module Item where
 
 import Data.Binary
+import Data.Map as M
 import Data.Set as S
 import Data.List as L
 import Data.Maybe
+import Data.Char
 import Control.Monad
 
 import Display
@@ -11,88 +13,222 @@
 import Random
 
 data Item = Item
-             { itype   :: ItemType,   
+             { icount  :: Int,
+               itype   :: ItemType,   
                iletter :: Maybe Char }  -- inventory identifier
   deriving Show
 
 data ItemType =
    Ring
  | Scroll
- | Potion
+ | Potion PotionType
  | Wand
  | Amulet
  | Gem
  | Gold
- deriving Show
+ deriving (Eq, Ord, Show)
 
+data PotionType =
+   PotionWater
+ | PotionHealing
+ deriving (Eq, Ord, Show)
+
+data Appearance =
+   Clear
+ | White
+ deriving (Eq, Show)
+
+type Assocs = M.Map ItemType Appearance
+type Discoveries = S.Set ItemType
+
+potionType :: PotionType -> String -> String
+potionType PotionWater   s = s ++ " of water"
+potionType PotionHealing s = s ++ " of healing"
+
+appearance :: Appearance -> String -> String
+appearance Clear s = "clear " ++ s
+appearance White s = "white " ++ s
+
 instance Binary Item where
-  put (Item itype iletter) = put itype >> put iletter
-  get = liftM2 Item get get
+  put (Item icount itype iletter) = put icount >> put itype >> put iletter
+  get = liftM3 Item get get get
 
 instance Binary ItemType where
-  put Ring   = putWord8 0
-  put Scroll = putWord8 1
-  put Potion = putWord8 2
-  put Wand   = putWord8 3
-  put Amulet = putWord8 4
-  put Gem    = putWord8 5
-  put Gold   = putWord8 6
+  put Ring       = putWord8 0
+  put Scroll     = putWord8 1
+  put (Potion t) = putWord8 2 >> put t
+  put Wand       = putWord8 3
+  put Amulet     = putWord8 4
+  put Gem        = putWord8 5
+  put Gold       = putWord8 6
   get = do
           tag <- getWord8
           case tag of
             0 -> return Ring
             1 -> return Scroll
-            2 -> return Potion
+            2 -> liftM Potion get
             3 -> return Wand
             4 -> return Amulet
             5 -> return Gem
             6 -> return Gold
 
+instance Binary PotionType where
+  put PotionWater   = putWord8 0
+  put PotionHealing = putWord8 1
+  get = do
+          tag <- getWord8
+          case tag of
+            0 -> return PotionWater
+            1 -> return PotionHealing
+
+instance Binary Appearance where
+  put Clear = putWord8 0
+  put White = putWord8 1
+  get = do
+          tag <- getWord8
+          case tag of
+            0 -> return Clear
+            1 -> return White
+
 itemFrequency :: Frequency ItemType
 itemFrequency =
   Frequency
   [
-    (10, Gold),
-    (3, Gem),
-    (2, Ring),
-    (4, Scroll),
-    (2, Wand),
-    (1, Amulet),
-    (4, Potion)
+    (100, Gold),
+    (30,  Gem),
+    (20,  Ring),
+    (40,  Scroll),
+    (20,  Wand),
+    (10,  Amulet),
+    (30,  Potion PotionWater),
+    (10,  Potion PotionHealing)
   ]
 
+itemQuantity :: Int -> ItemType -> Rnd Int
+itemQuantity n Gold = (2 * n) *~ d 8
+itemQuantity _ _    = return 1
+
+itemLetter :: ItemType -> Maybe Char
+itemLetter Gold = Just '$'
+itemLetter _    = Nothing
+
 -- | Generate an item.
-newItem :: Frequency ItemType -> Rnd Item
-newItem ftp =
+newItem :: Int -> Frequency ItemType -> Rnd Item
+newItem n ftp =
   do
     tp <- frequency ftp
-    return (Item tp Nothing)
+    nr <- itemQuantity n tp
+    return (Item nr tp (itemLetter tp))
 
 -- | Assigns a letter to an item, for inclusion
--- in the inventory of the player. Takes a starting
--- letter.
-assignLetter :: Char -> [Item] -> Maybe Char
-assignLetter c is =
-    listToMaybe (L.filter (\x -> not (x `member` current)) candidates)
+-- in the inventory of the player. Takes a remembered
+-- letter and a starting letter.
+assignLetter :: Maybe Char -> Char -> [Item] -> Maybe Char
+assignLetter r c is =
+    case r of
+      Just l | l `L.elem` allowed -> Just l
+      _ -> listToMaybe free
+             
   where
     current    = S.fromList (concatMap (maybeToList . iletter) is)
     allLetters = ['a'..'z'] ++ ['A'..'Z']
-    candidates = take (length allLetters) (drop (fromJust (findIndex (==c) allLetters)) (cycle allLetters))
+    candidates = take (length allLetters) (drop (fromJust (L.findIndex (==c) allLetters)) (cycle allLetters))
+    free       = L.filter (\x -> not (x `S.member` current)) candidates
+    allowed    = '$' : free
 
-viewItem :: ItemType -> (Char, Attr -> Attr)
-viewItem Ring   = ('=', id)
-viewItem Scroll = ('?', id)
-viewItem Potion = ('!', id)
-viewItem Wand   = ('/', id)
-viewItem Gold   = ('$', setFG yellow)
-viewItem Gem    = ('*', setFG red)
-viewItem _      = ('~', id)
+cmpLetter :: Char -> Char -> Ordering
+cmpLetter x y = compare (isUpper x, toLower x) (isUpper y, toLower y)
 
-objectItem :: ItemType -> String
-objectItem Ring   = "a ring"
-objectItem Scroll = "a scroll"
-objectItem Potion = "a potion"
-objectItem Wand   = "a wand"
-objectItem Amulet = "an amulet"
-objectItem Gem    = "a gem"
-objectItem Gold   = "some gold"
+cmpLetter' :: Maybe Char -> Maybe Char -> Ordering
+cmpLetter' Nothing  Nothing   = EQ
+cmpLetter' Nothing  (Just _)  = GT
+cmpLetter' (Just _) Nothing   = LT
+cmpLetter' (Just l) (Just l') = cmpLetter l l'
+
+maxBy :: (a -> a -> Ordering) -> a -> a -> a
+maxBy cmp x y = case cmp x y of
+                  LT  ->  y
+                  _   ->  x
+
+maxLetter = maxBy cmpLetter
+
+mergeLetter :: Maybe Char -> Maybe Char -> Maybe Char
+mergeLetter = mplus
+
+letterRange :: [Char] -> String
+letterRange xs = sectionBy (sortBy cmpLetter xs) Nothing
+  where
+    succLetter c d = ord d - ord c == 1
+
+    sectionBy []     Nothing                  = ""
+    sectionBy []     (Just (c,d))             = finish (c,d)
+    sectionBy (x:xs) Nothing                  = sectionBy xs (Just (x,x))
+    sectionBy (x:xs) (Just (c,d)) | succLetter d x
+                                              = sectionBy xs (Just (c,x))
+                                  | otherwise
+                                              = finish (c,d) ++ sectionBy xs (Just (x,x))
+
+    finish (c,d) | c == d         = [c]
+                 | succLetter c d = [c,d]
+                 | otherwise      = [c,'-',d]
+
+letterLabel :: Maybe Char -> String
+letterLabel Nothing  = "    "
+letterLabel (Just c) = c : " - "
+
+viewItem :: ItemType -> Assocs -> (Char, Attr -> Attr)
+viewItem i a = viewItem' i (M.lookup i a)
+  where
+    viewItem' Ring        _            = ('=', id)
+    viewItem' Scroll      _            = ('?', id)
+    viewItem' (Potion {}) (Just Clear) = ('!', setBold . setFG blue)
+    viewItem' (Potion {}) (Just White) = ('!', setBold . setFG white)
+    viewItem' (Potion {}) _            = ('!', id)
+    viewItem' Wand        _            = ('/', id)
+    viewItem' Gold        _            = ('$', setBold . setFG yellow)
+    viewItem' Gem         _            = ('*', setFG red)
+    viewItem' Amulet      _            = ('"', id)
+    viewItem' _           _            = ('~', id)
+
+-- | Adds an item to a list of items, joining equal items.
+-- Also returns the joined item.
+joinItem :: Item -> [Item] -> (Item,[Item])
+joinItem i is = case findItem (\ j -> itype i == itype j) is of
+                  Nothing     -> (i, i : is)
+                  Just (j,js) -> let n = i { icount = icount i + icount j,
+                                             iletter = mergeLetter (iletter j) (iletter i) }
+                                 in (n, n : js)
+
+-- | Finds an item in a list of items.
+findItem :: (Item -> Bool) -> [Item] -> Maybe (Item, [Item])
+findItem p is = findItem' [] is
+  where
+    findItem' acc []     = Nothing
+    findItem' acc (i:is)
+      | p i              = Just (i, reverse acc ++ is)
+      | otherwise        = findItem' (i:acc) is
+
+makeObject :: Int -> (String -> String) -> String -> String
+makeObject 1 adj obj = let b = adj obj
+                       in  case b of
+                             (c:_) | c `elem` "aeio" -> "an " ++ b
+                             _                       -> "a " ++ b
+makeObject n adj obj = show n ++ " " ++ adj (obj ++ "s")
+
+objectItem :: Assocs -> Discoveries -> Int -> ItemType -> String
+objectItem _ _ n Ring       = makeObject n id "ring"
+objectItem _ _ n Scroll     = makeObject n id "scroll"
+objectItem a d n (Potion t) = makeObject n (identified a d (Potion t)) "potion"
+objectItem _ _ n Wand       = makeObject n id "wand"
+objectItem _ _ n Amulet     = makeObject n id "amulet"
+objectItem _ _ n Gem        = makeObject n id "gem"
+objectItem _ _ n Gold       = makeObject n id "gold piece"
+
+identified :: Assocs -> Discoveries -> ItemType -> String -> String
+identified a d i
+  | i `S.member` d = case i of
+                       Potion t -> potionType t
+                       _        -> ("really strange " ++)
+  | otherwise      = case M.lookup i a of
+                       Just ap  -> appearance ap
+                       _        -> ("really strange " ++)
diff --git a/LambdaHack.cabal b/LambdaHack.cabal
--- a/LambdaHack.cabal
+++ b/LambdaHack.cabal
@@ -1,6 +1,6 @@
 cabal-version: >= 1.2
 name:          LambdaHack
-version:       0.1.20080413
+version:       0.1.20090606
 license:       GPL
 license-file:  COPYING
 data-files:    README
@@ -26,18 +26,18 @@
                  Level, Message, Monster, Perception, Random,
                  Save, Setup, State, Strategy, Style, Turn,
                  Version
-  build-depends: base >= 3, containers >= 0.1, binary >= 0.4,
-                 random >= 1, zlib >= 0.4, bytestring >= 0.9,
-                 directory >= 1, mtl >= 1.1
+  build-depends: base >= 3 && < 4, containers >= 0.1 && < 1, binary >= 0.4 && < 1,
+                 random >= 1 && < 2, zlib >= 0.4 && < 1, bytestring >= 0.9 && < 1,
+                 directory >= 1 && < 2, mtl >= 1.1 && < 2
   extensions:    CPP
   if flag(curses) {
     other-modules: Display.Curses
-    build-depends: hscurses >= 1.3
+    build-depends: hscurses >= 1.3 && < 2
     cpp-options:   -DCURSES
     extra-libraries: curses
   } else { if flag(gtk) {
     other-modules: Display.Gtk
-    build-depends: gtk >= 0.9.12
+    build-depends: gtk >= 0.9.12 && < 0.11
     cpp-options:   -DGTK
   } else {
     other-modules: Display.Vty
diff --git a/LambdaHack.hs b/LambdaHack.hs
--- a/LambdaHack.hs
+++ b/LambdaHack.hs
@@ -2,6 +2,7 @@
 
 import System.Directory
 import Control.Monad
+import Data.Map as M
 
 import State
 import Geometry
@@ -12,6 +13,7 @@
 import Random
 import Save
 import Turn
+import Item
 
 main :: IO ()
 main = startup start
@@ -37,7 +39,7 @@
   do
     -- generate dungeon with 10 levels
     levels <- rndToIO $
-              mapM (\n -> (if n == 3 then bigroom else level) defaultLevelConfig $
+              mapM (\n -> (if n == 3 then bigroom else level) (defaultLevelConfig n) $
               LambdaCave n) [1..10]
     let connect :: Maybe (Maybe DungeonLoc) ->
                    [(Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)] ->
@@ -49,6 +51,11 @@
                             in  x' : z : zs
     let lvls = connect (Just Nothing) levels
     let (lvl,dng) = (head lvls, dungeon (tail lvls))
-    let state = defaultState ((\ (_,x,_) -> x) (head levels)) dng
+    -- generate item associations
+    let assocs = M.fromList
+                   [ (Potion PotionWater,   Clear),
+                     (Potion PotionHealing, White) ]
+    let state = (defaultState ((\ (_,x,_) -> x) (head levels)) dng)
+                  { sassocs = assocs }
     handle session lvl state (perception_ state lvl) msg
 
diff --git a/Level.hs b/Level.hs
--- a/Level.hs
+++ b/Level.hs
@@ -21,6 +21,16 @@
 data LevelName = LambdaCave Int | Exit
   deriving (Show, Eq, Ord)
 
+-- | Chance that a new monster is generated. Currently depends on the
+-- number of monsters already present, and on the level. In the future,
+-- the strength of the character and the strength of the monsters present
+-- could further influence the chance, and the chance could also affect
+-- which monster is generated.
+monsterGenChance :: LevelName -> [Monster] -> Rnd Bool
+monsterGenChance (LambdaCave n) [] = chance $ 1%50
+monsterGenChance (LambdaCave n) _  = chance $ 1%((1000 - (fromIntegral n * 50)) `max` 300)
+monsterGenChance _              _  = return False
+
 instance Binary LevelName where
   put (LambdaCave n) = put n
   get = liftM LambdaCave get
@@ -108,37 +118,85 @@
 unknown = Tile Unknown []
 
 data Terrain = Rock
-             | Opening HV
-             | Floor
+             | Opening Pos
+             | Floor DL
              | Unknown
              | Corridor
-             | Wall HV
-             | Stairs VDir (Maybe DungeonLoc)
-             | Door HV (Maybe Int) -- Nothing: open, Just 0: closed, otherwise secret
+             | Wall Pos
+             | Stairs DL VDir (Maybe DungeonLoc)
+             | Door Pos (Maybe Int) -- Nothing: open, Just 0: closed, otherwise secret
   deriving Show
 
 instance Binary Terrain where
-  put Rock         = putWord8 0
-  put (Opening d)  = putWord8 1 >> put d
-  put Floor        = putWord8 2
-  put Unknown      = putWord8 3
-  put Corridor     = putWord8 4
-  put (Wall d)     = putWord8 5 >> put d
-  put (Stairs d n) = putWord8 6 >> put d >> put n
-  put (Door d o)   = putWord8 7 >> put d >> put o
+  put Rock            = putWord8 0
+  put (Opening p)     = putWord8 1 >> put p
+  put (Floor dl)      = putWord8 2 >> put dl
+  put Unknown         = putWord8 3
+  put Corridor        = putWord8 4
+  put (Wall p)        = putWord8 5 >> put p
+  put (Stairs dl d n) = putWord8 6 >> put dl >> put d >> put n
+  put (Door p o)      = putWord8 7 >> put p >> put o
   get = do
           tag <- getWord8
           case tag of
             0 -> return Rock
             1 -> liftM Opening get
-            2 -> return Floor
+            2 -> liftM Floor get
             3 -> return Unknown
             4 -> return Corridor
             5 -> liftM Wall get
-            6 -> liftM2 Stairs get get
+            6 -> liftM3 Stairs get get get
             7 -> liftM2 Door get get
             _ -> fail "no parse (Tile)"
 
+data DL = Dark | Light
+  deriving (Eq, Show, Bounded)
+
+-- | All the wall types that are possible:
+--
+--     * 'UL': upper left
+--
+--     * 'U': upper
+--
+--     * 'UR': upper right
+--
+--     * 'L': left
+--
+--     * 'R': right
+--
+--     * 'DL': lower left
+--
+--     * 'D': lower
+--
+--     * 'DR': lower right
+--
+-- I am tempted to add even more (T-pieces and crossings),
+-- but currently, we don't need them.
+data Pos = UL | U | UR | L | R | DL | D | DR
+  deriving (Eq, Show, Bounded)
+
+instance Binary Pos where
+  put UL = putWord8 0
+  put U  = putWord8 1
+  put UR = putWord8 2
+  put L  = putWord8 3
+  put R  = putWord8 4
+  put DL = putWord8 5
+  put D  = putWord8 6
+  put DR = putWord8 7
+
+  get = do
+          tag <- getWord8
+          case tag of
+            0 -> return UL
+            1 -> return U
+            2 -> return UR
+            3 -> return L
+            4 -> return R
+            5 -> return DL
+            6 -> return D
+            7 -> return DR
+
 data HV = Horiz | Vert
   deriving (Eq, Show, Bounded)
 
@@ -158,6 +216,11 @@
   put Vert  = put False
   get = get >>= \ b -> if b then return Horiz else return Vert
 
+instance Binary DL where
+  put Dark  = put False
+  put Light = put True
+  get = get >>= \ b -> if b then return Light else return Dark
+
 data VDir = Up | Down
   deriving (Eq, Show)
 
@@ -169,18 +232,22 @@
 instance Eq Terrain where
   Rock == Rock = True
   Opening d == Opening d' = d == d'
-  Floor == Floor = True
+  Floor l == Floor l' = l == l'
   Unknown == Unknown = True
   Corridor == Corridor = True
-  Wall d == Wall d' = d == d'
-  Stairs d _ == Stairs d' _ = d == d'
-  Door d o == Door d' o' = d == d' && o == o'
+  Wall p == Wall p' = p == p'
+  Stairs dl d t == Stairs dl' d' t' = dl == dl' && d == d' && t == t'
+  Door p o == Door p' o' = p == p' && o == o'
   _ == _ = False
 
 -- | blocks moves and vision
 closed :: Tile -> Bool
 closed = not . open
 
+floor :: Tile -> Bool
+floor (Tile { tterrain = Floor _ }) = True
+floor _                             = False
+
 secret :: Maybe Int -> Bool
 secret (Just n) | n /= 0 = True
 secret _ = False
@@ -189,35 +256,63 @@
 toOpen True = Nothing
 toOpen False = Just 0
 
+fromDL :: DL -> Bool
+fromDL Dark = False
+fromDL Light = True
+
+toDL :: Bool -> DL
+toDL False = Dark
+toDL True  = Light
+
 -- | allows moves and vision
 open :: Tile -> Bool
-open (Tile Floor _) = True
-open (Tile (Opening _) _)  = True
-open (Tile (Door _ o) _)   = isNothing o
-open (Tile Corridor _)     = True
-open (Tile (Stairs _ _) _) = True
-open _                     = False
+open (Tile (Floor {}) _)     = True
+open (Tile (Opening {}) _)   = True
+open (Tile (Door _ o) _)     = isNothing o
+open (Tile Corridor _)       = True
+open (Tile (Stairs {}) _)    = True
+open _                       = False
 
 -- | is lighted on its own
 light :: Tile -> Bool
-light (Tile Floor _)            = True
-light (Tile (Opening _) _)      = True
-light (Tile (Door _ Nothing) _) = True -- open doors are all visible currently
-light (Tile (Stairs _ _) _)     = True
-light (Tile (Wall _) _)         = False
+light (Tile (Floor l) _)        = fromDL l
+light (Tile (Stairs l _ _) _)   = fromDL l
 light _                         = False
 
--- | reflects light from adjacent positions;
--- exclusively passive: cannot be seen from an adjacent position in darkness
-passive :: Tile -> (Bool,[(Y,X)])  -- exclusively passive?
-passive (Tile (Wall Horiz) _) = (True, vert ++ [(-1,1),(1,1),(-1,-1),(1,-1)]) -- for corners
-passive (Tile (Wall Vert) _)  = (True, horiz)
-passive (Tile (Door Horiz (Just 0)) _) = (False, vert)
-passive (Tile (Door Vert (Just 0)) _)  = (False, horiz)
-passive (Tile (Door Horiz (Just n)) _) = (True, vert)
-passive (Tile (Door Vert (Just n)) _)  = (True, horiz)
-passive _                     = (False, [])
+-- | Passive tiles reflect light from some other (usually adjacent)
+-- positions. This function returns the offsets from which light is
+-- reflected. Not all passively lighted tiles reflect from all directions.
+-- Walls, for instance, cannot usually be seen from the outside.
+passive :: Tile -> [Dir]  
+passive (Tile (Wall p) _)          = posToDir p
+passive (Tile (Opening _) _)       = moves
+passive (Tile (Door p Nothing) _)  = moves
+passive (Tile (Door p (Just 0)) _) = moves
+                                     -- doors can be seen from all sides
+passive (Tile (Door p (Just n)) _) = posToDir p
+                                     -- secret doors are like walls
+passive (Tile (Stairs _ _ _) _)    = moves
+passive _                          = []
 
+-- | Perceptible is similar to passive, but describes which tiles can
+-- be seen from which adjacent fields in the dark.
+perceptible :: Tile -> [Dir]
+perceptible (Tile Rock _) = []
+perceptible p = case passive p of
+                 [] -> moves
+                 ds -> ds
+
+-- | Maps wall types to lists of expected floor positions.
+posToDir :: Pos -> [Dir]
+posToDir UL = [downright]
+posToDir U  = [down]
+posToDir UR = [downleft]
+posToDir L  = [right]
+posToDir R  = [left]
+posToDir DL = [upright]
+posToDir D  = [up]
+posToDir DR = [upleft]
+
 -- checks for the presence of monsters (and items); it does *not* check
 -- if the tile is open ...
 unoccupied :: [Monster] -> LMap -> Loc -> Bool
@@ -236,13 +331,10 @@
   in  open tgt &&
       (not (diagonal dir) || 
        case (tterrain src, tterrain tgt) of
-         (Door _ _, _) -> False
-         (_, Door _ _) -> False
+         (Door {}, _)  -> False
+         (_, Door {})  -> False
          _             -> True)
 
-horiz = [(0,-1),(0,1)]
-vert  = [(-1,0),(1,0)]
-
 findLocInArea :: Area -> (Loc -> Bool) -> Rnd Loc
 findLocInArea a@((y0,x0),(y1,x1)) p =
   do
@@ -338,33 +430,40 @@
   | x0 <= x1  = [x0..x1]
   | otherwise = [x0,x0-1..x1]
 
-viewTile :: Tile -> (Char, Attr -> Attr)
-viewTile (Tile t [])    = viewTerrain 0 t
-viewTile (Tile t (i:_)) = viewItem (itype i)
+viewTile :: Bool -> Tile -> Assocs -> (Char, Attr -> Attr)
+viewTile b (Tile t [])    a = viewTerrain 0 b t 
+viewTile b (Tile t (i:_)) a = viewItem (itype i) a
 
 -- | Produces a textual description of the items at a location. It's
 -- probably correct to use 'at' rather than 'rememberAt' at this point,
 -- although we could argue that 'rememberAt' reflects what the player can
 -- perceive more correctly ...
-lookAt :: Bool -> LMap -> Loc -> String
-lookAt detailed lvl loc
-  | L.null is && detailed = lookTerrain (tterrain (lvl `at` loc))
-  | otherwise             = isd
+--
+-- The "detailed" variant is for use with an explicit look command.
+lookAt :: Bool -> Assocs -> Discoveries -> LMap -> Loc -> String
+lookAt detailed a d lvl loc
+  | detailed  = lookTerrain (tterrain (lvl `at` loc)) ++ " " ++ isd
+  | otherwise = isd
   where
     is  = titems (lvl `at` loc)
-    isd = unwords $ L.map (objectItem . itype) $ is
-
+    isd = case is of
+            []    -> ""
+            [i]   -> "You see " ++ objectItem a d (icount i) (itype i) ++ "."
+            [i,j] -> "You see " ++ objectItem a d (icount i) (itype i) ++ " and "
+                                ++ objectItem a d (icount j) (itype j) ++ "."
+            _     -> "There are several objects here" ++
+                     if detailed then ":" else "."
 
 -- | Produces a textual description for terrain, used if no objects
 -- are present.
 lookTerrain :: Terrain -> String
-lookTerrain Floor            = "empty floor"
-lookTerrain Corridor         = "empty corridor"
-lookTerrain (Opening _)      = "an opening"
-lookTerrain (Stairs Up _)    = "staircase up"
-lookTerrain (Stairs Down _)  = "staircase down"
-lookTerrain (Door _ Nothing) = "an open door"
-lookTerrain _                = ""
+lookTerrain (Floor _)          = "Floor."
+lookTerrain Corridor           = "Corridor."
+lookTerrain (Opening _)        = "An opening."
+lookTerrain (Stairs _ Up _)    = "A staircase up."
+lookTerrain (Stairs _ Down _)  = "A staircase down."
+lookTerrain (Door _ Nothing)   = "An open door."
+lookTerrain _                  = ""
 
 -- | The parameter "n" is the level of evolution:
 --
@@ -373,36 +472,37 @@
 -- 2: doors added
 -- 3: corridors and openings added
 -- 4: only rooms
-viewTerrain :: Int -> Terrain -> (Char, Attr -> Attr)
-viewTerrain n Rock              = (' ', id)
-viewTerrain n (Opening d)
-  | n <= 3                      = ('.', id)
-  | otherwise                   = viewTerrain 0 (Wall d)
-viewTerrain n Floor             = ('.', id)
-viewTerrain n Unknown           = (' ', id)
-viewTerrain n Corridor
-  | n <= 3                      = ('#', id)
-  | otherwise                   = viewTerrain 0 Rock
-viewTerrain n (Wall Horiz)      = ('-', id)
-viewTerrain n (Wall Vert)       = ('|', id)
-viewTerrain n (Stairs Up _)
-  | n <= 1                      = ('<', id)
-  | otherwise                   = viewTerrain 0 Floor
-viewTerrain n (Stairs Down _)
-  | n <= 1                      = ('>', id)
-  | otherwise                   = viewTerrain 0 Floor
-viewTerrain n (Door d (Just 0))
-  | n <= 2                      = ('+', setFG yellow)
-  | otherwise                   = viewTerrain n (Opening d)
-viewTerrain n (Door d (Just _))
-  | n <= 2                      = viewTerrain n (Wall d) -- secret door
-  | otherwise                   = viewTerrain n (Opening d)
-viewTerrain n (Door Horiz Nothing)
-  | n <= 2                      = ('|', setFG yellow)
-  | otherwise                   = viewTerrain n (Opening Horiz)
-viewTerrain n (Door Vert Nothing)
-  | n <= 2                      = ('-', setFG yellow)
-  | otherwise                   = viewTerrain n (Opening Vert)
+--
+-- The Bool indicates whether the loc is currently visible.
+viewTerrain :: Int -> Bool -> Terrain -> (Char, Attr -> Attr)
+viewTerrain n b Rock              = (' ', id)
+viewTerrain n b (Opening d)
+  | n <= 3                        = ('.', id)
+  | otherwise                     = viewTerrain 0 b (Wall d)
+viewTerrain n b (Floor Light)     = ('.', id)
+viewTerrain n b (Floor Dark)      = if b then ('.', id) else (' ', id)
+viewTerrain n b Unknown           = (' ', id)
+viewTerrain n b Corridor
+  | n <= 3                        = ('#', id)
+  | otherwise                     = viewTerrain 0 b Rock
+viewTerrain n b (Wall p)
+  | p `elem` [L, R]               = ('|', id)
+  | otherwise                     = ('-', id)
+viewTerrain n b (Stairs _ Up _)
+  | n <= 1                        = ('<', id)
+  | otherwise                     = viewTerrain 0 b (Floor Dark)
+viewTerrain n b (Stairs _ Down _)
+  | n <= 1                        = ('>', id)
+  | otherwise                     = viewTerrain 0 b (Floor Dark)
+viewTerrain n b (Door d (Just 0))
+  | n <= 2                        = ('+', setFG yellow)
+  | otherwise                     = viewTerrain n b (Opening d)
+viewTerrain n b (Door d (Just _))
+  | n <= 2                        = viewTerrain n b (Wall d) -- secret door
+  | otherwise                     = viewTerrain n b (Opening d)
+viewTerrain n b (Door p Nothing)
+  | n <= 2                        = (if p `elem` [L, R] then '-' else '|', setFG yellow)
+  | otherwise                     = viewTerrain n b (Opening p)
 
 viewSmell :: Int -> (Char, Attr -> Attr)
 viewSmell n = let k | n > 9    = '*'
diff --git a/Perception.hs b/Perception.hs
--- a/Perception.hs
+++ b/Perception.hs
@@ -18,16 +18,31 @@
 perception :: Loc -> LMap -> Perception
 perception ploc lmap =
   let
+    -- This part is simple. "reachable" contains everything that is on an
+    -- unblocked path from the player position.
     reachable  = fullscan ploc lmap
-    actVisible = S.filter (\ loc -> light (lmap `at` loc)) reachable
-    pasVisible = S.filter (\ loc -> let (x,p) = passive (lmap `at` loc)
-                                    in  any (\ d -> S.member (shift loc d) actVisible) p ||
-                                        (not x && adjacent loc ploc))
-                                    -- the above "not x" prevents walls from
-                                    -- being visible from the outside when
-                                    -- adjacent
+    -- In "actVisible", we store the locations that have light and are
+    -- reachable. Furthermore, the player location itself is always
+    -- visible.
+    actVisible = S.filter (\ loc -> light (lmap `at` loc)) reachable `S.union` S.singleton ploc
+    srnd       = S.fromList $ surroundings ploc
+    -- In "dirVisible", we store locations in the surroundings that are
+    -- perceptible from the current position.
+    dirVisible = S.filter (\ loc -> let p = perceptible (lmap `at` loc) :: [Dir]
+                                    in  any (\ d -> shift loc d == ploc) p)
+                          (S.fromList $ surroundings ploc)
+    ownVisible = S.union actVisible dirVisible
+    -- Something is "pasVisible" if it is reachable passively visible from an
+    -- "actVisible" location, *or* if it is in the surroundings and passively
+    -- visible from a "dirVisible" location. (This is complicated, and I'd
+    -- like to simplify it, but for now, it seems to at least do what I
+    -- want.)
+    pasVisible = S.filter (\ loc -> let p = passive (lmap `at` loc)
+                                        dp = S.member loc srnd
+                                        s = if dp then ownVisible else actVisible
+                                    in  any (\ d -> S.member (shift loc d) s) p)
                           reachable
-    visible = S.union pasVisible actVisible
+    visible = S.unions [pasVisible, actVisible, dirVisible]
   in
     Perception reachable visible
 
diff --git a/README b/README
--- a/README
+++ b/README
@@ -1,6 +1,12 @@
 
 Installation via Cabal.
 
-There are two displays to choose from. One based on vty,
-one based on gtk2hs. The gtk2hs variant is the default.
-To get the other, pass -f-gtk to Setup configure.
+There are three displays to choose from, depending on
+the flags passed to Setup configure:
+
+  * gtk2hs  (the default)
+  * vty     (Setup configure -f-gtk)
+  * curses  (Setup configure -fcurses)
+
+The curses display is the newest and least tested,
+the other two should be stable.
diff --git a/Random.hs b/Random.hs
--- a/Random.hs
+++ b/Random.hs
@@ -9,7 +9,7 @@
 type Rnd a = State R.StdGen a
 
 randomR :: (R.Random a) => (a, a) -> Rnd a
-randomR r = State (R.randomR r)
+randomR = State . R.randomR
 
 binaryChoice :: a -> a -> Rnd a
 binaryChoice p0 p1 =
@@ -25,6 +25,10 @@
     k <- randomR (1,d)
     return (k <= n)
 
+-- | d for die/dice
+d :: Int -> Rnd Int
+d x = randomR (1,x)
+
 oneOf :: [a] -> Rnd a
 oneOf xs =
   do
@@ -50,3 +54,14 @@
     let (x,g') = runState r g
     R.setStdGen g'
     return x
+
+-- ** Arithmetic operations on Rnd.
+
+infixl 7 *~
+infixl 6 ~+~
+
+(~+~) :: Num a => Rnd a -> Rnd a -> Rnd a
+(~+~) = liftM2 (+)
+
+(*~) :: Num a => Int -> Rnd a -> Rnd a
+x *~ r = liftM sum (replicateM x r)
diff --git a/Save.hs b/Save.hs
--- a/Save.hs
+++ b/Save.hs
@@ -7,8 +7,20 @@
 import Level
 import State
 
+-- | Name of the save game. TODO: It should be possible to play
+-- multiple games next to each other (for instance, in a multi-user
+-- environment), so the savegames should contain the character name
+-- and the user id or something like that.
 savefile = "LambdaHack.save"
 
+-- | We save a simple serialized version of the current level and
+-- the current state. The 'False' is used only as an EOF marker.
+saveGame :: Level -> State -> IO ()
+saveGame lvl state = encodeCompressedFile savefile (lvl,state,False)
+
+-- | Restore a saved game. Returns either the current level and
+-- game state, or a string containing an error message if restoring
+-- the game fails.
 restoreGame :: IO (Either (Level, State) String)
 restoreGame =
   E.catch (do
@@ -20,5 +32,3 @@
                     _ -> return (Right $ "Restore failed: " ++
                                  (unwords . lines) (show e)))
 
-saveGame :: Level -> State -> IO ()
-saveGame lvl state = encodeCompressedFile savefile (lvl,state,False)
diff --git a/State.hs b/State.hs
--- a/State.hs
+++ b/State.hs
@@ -1,32 +1,48 @@
 module State where
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 import Control.Monad
 import Data.Binary
 
 import Monster
 import Geometry
 import Level
+import Item
 
+-- | The 'State' contains all the game state except the current dungeon
+-- level which we usually keep separate.
 data State = State
-               { splayer  :: Monster,
-                 ssensory :: SensoryMode,
-                 sdisplay :: DisplayMode,
-                 stime    :: Time,
-                 sdungeon :: Dungeon
+               { splayer      :: Monster,
+                 shistory     :: [String],
+                 ssensory     :: SensoryMode,
+                 sdisplay     :: DisplayMode,
+                 stime        :: Time,
+                 sassocs      :: Assocs,       -- ^ how does every item appear
+                 sdiscoveries :: Discoveries,  -- ^ items (types) have been discovered
+                 sdungeon     :: Dungeon       -- ^ all but current dungeon level
                }
   deriving Show
 
 defaultState ploc dng =
   State
     (defaultPlayer ploc)
+    []
     Implicit Normal
     0
+    M.empty
+    S.empty
     dng
 
 updatePlayer :: State -> (Monster -> Monster) -> State
 updatePlayer s f = s { splayer = f (splayer s) }
 
+updateHistory :: State -> ([String] -> [String]) -> State
+updateHistory s f = s { shistory = f (shistory s) }
+
+updateDiscoveries :: State -> (Discoveries -> Discoveries) -> State
+updateDiscoveries s f = s { sdiscoveries = f (sdiscoveries s) }
+
 toggleVision :: State -> State
 toggleVision s = s { ssensory = if ssensory s == Vision then Implicit else Vision }
 
@@ -40,14 +56,27 @@
 toggleTerrain s = s { sdisplay = case sdisplay s of Terrain 1 -> Normal; Terrain n -> Terrain (n-1); _ -> Terrain 4 }
 
 instance Binary State where
-  put (State player sense disp time dng) =
+  put (State player hst sense disp time assocs discs dng) =
     do
       put player
+      put hst
       put sense
       put disp
       put time
+      put assocs
+      put discs
       put dng
-  get = liftM5 State get get get get get
+  get =
+    do
+      player <- get
+      hst    <- get
+      sense  <- get
+      disp   <- get
+      time   <- get
+      assocs <- get
+      discs  <- get
+      dng    <- get
+      return (State player hst sense disp time assocs discs dng)
 
 data SensoryMode =
     Implicit
diff --git a/Strategy.hs b/Strategy.hs
--- a/Strategy.hs
+++ b/Strategy.hs
@@ -14,7 +14,7 @@
 instance Monad Strategy where
   return x = Strategy $ return (Frequency [(1, x)])
   m >>= f  = Strategy $
-               filter (\ (Frequency xs) -> not (null xs)) $
+               filter (\ (Frequency xs) -> not (null xs))
                [ Frequency [ (p * q, b) 
                            | (p, a) <- runFrequency x,
                              y <- runStrategy (f a),
diff --git a/Turn.hs b/Turn.hs
--- a/Turn.hs
+++ b/Turn.hs
@@ -4,6 +4,8 @@
 import Data.Map as M
 import Data.Set as S
 import Data.Char
+import Data.Maybe
+import Data.Function
 
 import State
 import Geometry
@@ -85,7 +87,7 @@
          handleMonsters session nlvl (updatePlayer state (const np)) per
                         (addMsg oldmsg msg))
       (handleMonsters session nlvl state per oldmsg)
-      nlvl player per
+      nlvl player (sassocs state) (sdiscoveries state) per
       (AMonster act)
       nl
 
@@ -137,9 +139,8 @@
 -- | Display current status and handle the turn of the player.
 handle :: Session -> Level -> State -> Perception -> String -> IO ()
 handle session (lvl@(Level nm sz ms smap lmap lmeta))
-               (state@(State { splayer = player@(Monster { mhp = php, mdir = pdir, mloc = ploc, mitems = pinv, mtime = ptime }), stime = time }))
+               (state@(State { splayer = player@(Monster { mhp = php, mdir = pdir, mloc = ploc, mitems = pinv, mtime = ptime }), stime = time, sassocs = assocs, sdiscoveries = discs }))
                per oldmsg =
-  do
     -- check for player death
     if php <= 0
       then do
@@ -147,14 +148,18 @@
              getConfirm session
              shutdown session
       else -- check if the player can make another move yet
-           if ptime > time then handleMonsters session lvl state per oldmsg 
+           if ptime > time then
+             do
+               -- do not make intermediate redraws while running
+               maybe (displayLevel session lvl per state "") (const $ return ()) pdir
+               handleMonsters session lvl state per oldmsg 
            -- NOTE: It's important to call handleMonsters here, not loop,
            -- because loop does all sorts of calculations that are only
            -- really necessary after the player has moved.
       else do
              displayCurrent oldmsg
-             let h = do
-                       e <- nextEvent session
+             let h = nextEvent session >>= h'
+                 h' e =
                        handleDirection e (move h) $ 
                          handleDirection (L.map toLower e) run $
                          handleModifier e h $
@@ -166,19 +171,23 @@
                            "less"    -> lvlchange Up h
                            "greater" -> lvlchange Down h
 
+                           -- items
                            "comma"   -> pickup h
+                           "d"       -> drop h
+                           "i"       -> inventory h
+                           "q"       -> drink h
 
                            -- saving or ending the game
-                           "S"       -> saveGame lvl state >> shutdown session
+                           "S"       -> saveGame lvl mstate >> shutdown session
                            "Q"       -> shutdown session
-                           "Escape"  -> shutdown session
+                           "Escape"  -> displayCurrent "Press Q to quit." >> h
 
                            -- wait
                            "space"   -> loop session nlvl nstate ""
                            "period"  -> loop session nlvl nstate ""
 
                            -- look
-                           "colon"   -> displayCurrent (lookAt True nlmap ploc) >> h
+                           "colon"   -> lookAround h
 
                            -- display modes
                            "V"       -> handle session nlvl (toggleVision state) per oldmsg
@@ -187,7 +196,11 @@
                            "T"       -> handle session nlvl (toggleTerrain state) per oldmsg
 
                            -- meta information
-                           "M"       -> displayCurrent lmeta >> h
+                           "M"       -> displayCurrent' "" (unlines (shistory mstate) ++ more) >>= \ b ->
+                                        if b then getOptionalConfirm session
+                                                    (const (displayCurrent "" >> h)) h'
+                                             else displayCurrent "" >> h
+                           "I"       -> displayCurrent lmeta >> h
                            "v"       -> displayCurrent version >> h
 
                            s   -> displayCurrent ("unknown command (" ++ s ++ ")") >> h
@@ -195,11 +208,19 @@
 
  where
 
+  -- we record the oldmsg in the history
+  mstate = if L.null oldmsg then state else updateHistory state (take 500 . ((oldmsg ++ " "):))
+    -- TODO: make history max configurable
+
   reachable = preachable per
   visible   = pvisible per
 
-  displayCurrent = displayLevel session nlvl per state
+  displayCurrent :: String -> IO ()
+  displayCurrent  = displayLevel session nlvl per state
 
+  displayCurrent' :: String -> String -> IO Bool
+  displayCurrent' = displayOverlay session nlvl per state
+
   -- update player memory
   nlmap = foldr (\ x m -> M.update (\ (t,_) -> Just (t,t)) x m) lmap (S.toList visible)
   nlvl = updateLMap lvl (const nlmap)
@@ -208,32 +229,60 @@
   -- player HP regeneration, TODO: remove hardcoded max and time interval
   nplayer = player { mtime = time + mspeed player,
                      mhp   = if time `mod` 1500 == 0 then (php + 1) `min` playerHP else php }
-  nstate  = updatePlayer state (const nplayer)
+  nstate  = updatePlayer mstate (const nplayer)
 
   -- picking up items
-  pickup abort =
+  pickup abort = pickupItem
+                   displayCurrent
+                   (\ l p -> loop session l (updatePlayer nstate (const p)))
+                   abort
+                   nlvl nplayer assocs discs
+
+  -- dropping items
+  drop abort = dropItem
+                 session
+                 displayCurrent
+                 displayCurrent'
+                 (\ l p -> loop session l (updatePlayer nstate (const p)))
+                 abort
+                 nlvl nplayer assocs discs
+
+  -- drinking potions
+  drink abort = drinkPotion
+                  session
+                  displayCurrent
+                  displayCurrent'
+                  (\ l p d -> loop session l
+                                (updateDiscoveries (updatePlayer nstate (const p)) (S.union d)))
+                  abort
+                  nlvl nplayer assocs discs
+      
+  -- display inventory
+  inventory abort 
+    | L.null (mitems player) =
+      displayCurrent "You are not carrying anything." >> abort
+    | otherwise =
     do
+      displayItems displayCurrent' assocs discs 
+                   "This is what you are carrying:" True (mitems player)
+      getConfirm session
+      displayCurrent ""
+      abort  -- looking at inventory doesn't take any time
+      
+  -- look around at current location
+  lookAround abort =
+    do
       -- check if something is here to pick up
       let t = nlmap `at` ploc
-      case titems t of
-        []      ->  displayCurrent "nothing here" >> abort
-        (i:rs)  ->  
-          case assignLetter (mletter nplayer) (mitems nplayer) of
-            Just l  ->
-              let msg = -- (complete sentence, more adequate for monsters)
-                        {-
-                        subjectMonster (mtype player) ++ " " ++
-                        compoundVerbMonster (mtype player) "pick" "up" ++ " " ++
-                        objectItem (itype i) ++ "."
-                        -}
-                        [l] ++ " - " ++ objectItem (itype i)
-                  nt = t { titems = rs }
-                  plmap = M.insert ploc (nt, nt) nlmap
-                  iplayer = nplayer { mitems  = i { iletter = Just l } : mitems nplayer,
-                                      mletter = l }
-              in  loop session (updateLMap lvl (const plmap))
-                                     (updatePlayer nstate (const iplayer)) msg
-            Nothing -> displayCurrent "cannot carry anymore" >> abort
+      if length (titems t) <= 2
+        then displayCurrent (lookAt True assocs discs nlmap ploc) >> abort
+        else
+          do
+             displayItems displayCurrent' assocs discs
+                          (lookAt True assocs discs nlmap ploc) False (titems t)
+             getConfirm session
+             displayCurrent ""
+             abort  -- looking around doesn't take any time
 
   -- open and close doors
   openclose o abort =
@@ -259,14 +308,14 @@
         _ -> displayCurrent "never mind" >> abort
   -- search for secret doors
   search abort =
-    let searchTile (Tile (Door hv (Just n)) x,t') = Just $ (Tile (Door hv (Just (max (n - 1) 0))) x, t')
+    let searchTile (Tile (Door hv (Just n)) x,t') = Just (Tile (Door hv (Just (max (n - 1) 0))) x, t')
         searchTile t                              = Just t
         slmap = foldl (\ l m -> update searchTile (shift ploc m) l) nlmap moves
     in  loop session (updateLMap lvl (const slmap)) nstate ""
   -- perform a level change
   lvlchange vdir abort =
     case nlmap `at` ploc of
-      Tile (Stairs vdir' next) is
+      Tile (Stairs _ vdir' next) is
        | vdir == vdir' -> -- ok
           case next of
             Nothing      -> -- exit dungeon
@@ -293,22 +342,22 @@
         False   -- attacks are disallowed while running
         (\ l p -> loop session l (updatePlayer nstate (const p)))
         abort
-        nlvl mplayer per APlayer dir
+        nlvl mplayer assocs discs per APlayer dir
   continueRun dir =
     let abort = handle session nlvl (updatePlayer state (const $ player { mdir = Nothing })) per oldmsg
         dloc  = shift ploc dir
     in  case (oldmsg, nlmap `at` ploc) of
-          (_:_, _)                 -> abort
-          (_, Tile (Opening _) _)  -> abort
-          (_, Tile (Door _ _) _)   -> abort
-          (_, Tile (Stairs _ _) _) -> abort
+          (_:_, _)                   -> abort
+          (_, Tile (Opening {}) _)   -> abort
+          (_, Tile (Door {}) _)      -> abort
+          (_, Tile (Stairs {}) _)    -> abort
           _
             | accessible nlmap ploc dloc ->
                 moveOrAttack
                   False    -- attacks are disallowed while running
                   (\ l p -> loop session l (updatePlayer nstate (const p)))
                   abort
-                  nlvl nplayer per APlayer dir
+                  nlvl nplayer assocs discs per APlayer dir
           (_, Tile Corridor _)  -- direction change restricted to corridors
             | otherwise ->
                 let ns  = L.filter (\ x -> distance (neg dir,x) > 1
@@ -325,19 +374,198 @@
                      True   -- attacks are allowed
                      (\ l p -> loop session l (updatePlayer nstate (const p)))
                      abort
-                     nlvl nplayer per APlayer dir
+                     nlvl nplayer assocs discs per APlayer dir
 
+-- | Drinking potions.
+drinkPotion ::   Session ->                                    -- session
+                 (String -> IO ()) ->                          -- how to display
+                 (String -> String -> IO Bool) ->              -- overlay display
+                 (Level -> Player -> Discoveries -> String -> IO a) ->     
+                                                               -- success continuation
+                 IO a ->                                       -- failure continuation
+                 Level ->                                      -- the level
+                 Player ->                                     -- the player
+                 Assocs ->
+                 Discoveries ->
+                 IO a
+drinkPotion session displayCurrent displayCurrent' continue abort
+            nlvl@(Level { lmap = nlmap }) nplayer@(Monster { mloc = ploc }) assocs discs
+    | L.null (mitems nplayer) =
+      displayCurrent "You are not carrying anything." >> abort
+    | otherwise =
+    do
+      i <- getPotions session displayCurrent displayCurrent' assocs discs
+                      "What to drink?" (mitems nplayer)
+      case i of
+        Just i'@(Item { itype = Potion ptype }) ->
+                   let iplayer = nplayer { mitems = deleteBy ((==) `on` iletter) i' (mitems nplayer) }
+                       t = nlmap `at` ploc
+                       msg = subjectMonster (mtype nplayer) ++ " " ++
+                             verbMonster (mtype nplayer) "drink" ++ " " ++
+                             objectItem assocs discs (icount i') (itype i') ++ ". " ++
+                             pmsg ptype
+                       pmsg PotionWater   = "Tastes like water."
+                       pmsg PotionHealing = "You feel better."
+                       fplayer PotionWater   = iplayer
+                       fplayer PotionHealing = iplayer { mhp = 20 }
+                   in  continue nlvl
+                                (fplayer ptype) (S.singleton (itype i')) msg
+        Just _  -> displayCurrent "you cannot drink that" >> abort
+        Nothing -> displayCurrent "never mind" >> abort
+
+
+-- | Dropping items.
+dropItem ::   Session ->                                    -- session
+              (String -> IO ()) ->                          -- how to display
+              (String -> String -> IO Bool) ->              -- overlay display
+              (Level -> Player -> String -> IO a) ->        -- success continuation
+              IO a ->                                       -- failure continuation
+              Level ->                                      -- the level
+              Player ->                                     -- the player
+              Assocs ->
+              Discoveries ->
+              IO a
+dropItem session displayCurrent displayCurrent' continue abort
+         nlvl@(Level { lmap = nlmap }) nplayer@(Monster { mloc = ploc }) assocs discs
+    | L.null (mitems nplayer) =
+      displayCurrent "You are not carrying anything." >> abort
+    | otherwise =
+    do
+      i <- getAnyItem session displayCurrent displayCurrent' assocs discs
+                      "What to drop?" (mitems nplayer)
+      case i of
+        Just i' -> let iplayer = nplayer { mitems = deleteBy ((==) `on` iletter) i' (mitems nplayer) }
+                       t = nlmap `at` ploc
+                       nt = t { titems = snd (joinItem i' (titems t)) }
+                       plmap = M.insert ploc (nt, nt) nlmap
+                       msg = subjectMonster (mtype nplayer) ++ " " ++
+                             verbMonster (mtype nplayer) "drop" ++ " " ++
+                             objectItem assocs discs (icount i') (itype i') ++ "."
+                   in  continue (updateLMap nlvl (const plmap))
+                                iplayer msg
+        Nothing -> displayCurrent "never mind" >> abort
+
+
+
+
+-- | Picking up items.
+pickupItem :: (String -> IO ()) ->                          -- how to display
+              (Level -> Player -> String -> IO a) ->        -- success continuation
+              IO a ->                                       -- failure continuation
+              Level ->                                      -- the level
+              Player ->                                     -- the player
+              Assocs ->
+              Discoveries ->
+              IO a
+pickupItem displayCurrent continue abort
+           nlvl@(Level { lmap = nlmap }) nplayer@(Monster { mloc = ploc }) assocs discs =
+    do
+      -- check if something is here to pick up
+      let t = nlmap `at` ploc
+      case titems t of
+        []      ->  displayCurrent "nothing here" >> abort
+        (i:rs)  ->  
+          case assignLetter (iletter i) (mletter nplayer) (mitems nplayer) of
+            Just l  ->
+              let msg = -- (complete sentence, more adequate for monsters)
+                        {-
+                        subjectMonster (mtype player) ++ " " ++
+                        compoundVerbMonster (mtype player) "pick" "up" ++ " " ++
+                        objectItem (icount i) (itype i) ++ "."
+                        -}
+                        letterLabel (iletter ni) ++ objectItem assocs discs (icount ni) (itype ni)
+                  nt = t { titems = rs }
+                  plmap = M.insert ploc (nt, nt) nlmap
+                  (ni,nitems) = joinItem (i { iletter = Just l }) (mitems nplayer)
+                  iplayer = nplayer { mitems  = nitems,
+                                      mletter = maxLetter l (mletter nplayer) }
+              in  continue (updateLMap nlvl (const plmap))
+                           iplayer msg
+            Nothing -> displayCurrent "cannot carry anymore" >> abort
+
+getPotions :: Session ->
+              (String -> IO ()) ->
+              (String -> String -> IO Bool) ->
+              Assocs ->
+              Discoveries ->
+              String ->
+              [Item] ->
+              IO (Maybe Item)
+getPotions session displayCurrent displayCurrent' assocs discs prompt is =
+  getItem session displayCurrent displayCurrent' assocs discs
+          prompt (\ i -> case itype i of Potion {} -> True; _ -> False)
+          "Potions in your inventory:" is
+
+getAnyItem :: Session ->
+              (String -> IO ()) ->
+              (String -> String -> IO Bool) ->
+              Assocs ->
+              Discoveries ->
+              String ->
+              [Item] ->
+              IO (Maybe Item)
+getAnyItem session displayCurrent displayCurrent' assocs discs prompt is =
+  getItem session displayCurrent displayCurrent' assocs discs
+          prompt (const True) "Objects in your inventory:" is
+
+getItem :: Session ->
+           (String -> IO ()) ->
+           (String -> String -> IO Bool) ->
+           Assocs ->
+           Discoveries ->
+           String ->
+           (Item -> Bool) ->
+           String ->
+           [Item] ->
+           IO (Maybe Item) 
+getItem session displayCurrent displayCurrent' assocs discs prompt p ptext is0 =
+  let is = L.filter p is0
+      choice | L.null is = "[*]"
+             | otherwise = "[" ++ letterRange (concatMap (maybeToList . iletter) is) ++ " or ?*]"
+      r = do
+            displayCurrent (prompt ++ " " ++ choice)
+            let h = nextEvent session >>= h'
+                h' e =
+                    handleModifier e h $
+                      case e of
+                        "question" -> do
+                                        b <- displayItems displayCurrent' assocs discs
+                                                          ptext True is
+                                        if b then getOptionalConfirm session (const r) h'
+                                             else r 
+                        "asterisk" -> do
+                                        b <- displayItems displayCurrent' assocs discs
+                                                          "Objects in your inventory:" True is0
+                                        if b then getOptionalConfirm session (const r) h'
+                                             else r
+                        [l]        -> return (find (\ i -> maybe False (== l) (iletter i)) is0)
+                        _          -> return Nothing
+            h
+  in r
+
+displayItems displayCurrent' assocs discs msg sorted is =
+    do
+      let inv = unlines $
+                L.map (\ (Item { icount = c, iletter = l, itype = t }) -> 
+                         letterLabel l ++ objectItem assocs discs c t ++ " ")
+                      ((if sorted then sortBy (cmpLetter' `on` iletter) else id) is)
+      let ovl = inv ++ more
+      displayCurrent' msg ovl
+
+
 moveOrAttack :: Bool ->                                     -- allow attacks?
                 (Level -> Player -> String -> IO a) ->      -- success continuation
                 IO a ->                                     -- failure continuation
                 Level ->                                    -- the level
                 Player ->                                   -- the player
+                Assocs ->
+                Discoveries ->
                 Perception ->                               -- perception of the player
                 Actor ->                                    -- who's moving?
                 Dir -> IO a
 moveOrAttack allowAttacks
              continue abort
-             nlvl@(Level { lmap = nlmap }) player per
+             nlvl@(Level { lmap = nlmap }) player assocs discs per
              actor dir
       -- to prevent monsters from hitting themselves
     | dir == (0,0) = continue nlvl player ""
@@ -374,7 +602,7 @@
     | accessible nlmap aloc naloc = 
         updateActor (\ m -> m { mloc = naloc })
                     (\ _ l p -> continue l p (if actor == APlayer
-                                              then lookAt False nlmap naloc else ""))
+                                              then lookAt False assocs discs nlmap naloc else ""))
                     actor nlvl player
     | otherwise = abort
     where am :: Monster
@@ -384,7 +612,7 @@
           source = nlmap `at` aloc
           naloc  = shift aloc dir
           target = nlmap `at` naloc
-          attackedPlayer   = if mloc player == naloc then [APlayer] else []
+          attackedPlayer   = [ APlayer | mloc player == naloc ]
           attackedMonsters = L.map AMonster $
                              findIndices (\ m -> mloc m == naloc) (lmonsters nlvl)
           attacked :: [Actor]