Make buttons without labels inactive

app/Main.hs

@@ -63,7 +63,8 @@ main = do
                       blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
                       renderTree (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)
                                             (_windowX w,_windowY w) 
-                                            (picToLTree (Just 1) $ fixedCoordPictures w)
+                                            --(picToLTree (Just 1) $ fixedCoordPictures w)
+                                            (picToLTree Nothing $ fixedCoordPictures w)
                       endRenderTicks <- SDL.ticks
                       playSoundQueue (_soundData preData) (_soundQueue w)
                       newSoundData <- playAndUpdate (_sounds w) (_soundData preData)

src/Dodge/CreatureActions.hs

@@ -5,6 +5,7 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.WorldActions
+import Dodge.Inventory
 
 import Geometry
 import Picture
@@ -244,39 +245,6 @@ useItem2 n (Weapon {_wpFire=eff}) w = eff n w
 useItem2 n (Throwable {_twFire = eff}) w = eff n w
 useItem2 _ _ w = w
 
-rmInvItem :: Int -> World -> World
-rmInvItem n w = 
-    let i = _crInvSel (_creatures w IM.! n)
-        item = _crInv (_creatures w IM.! n) IM.! i
-        itRef = creatures . ix n . crInv . ix i
-    in  case item of
-            Consumable {_itAmount = 1} -> set itRef NoItem w    
-            Craftable {_itAmount = 1} -> set itRef NoItem w    
-            Equipment {_itAmount = 1} -> set itRef NoItem w    
-            Throwable {_itAmount = 1} -> set itRef NoItem w    
-            Consumable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w    
-            Craftable {_itAmount = x} -> over (itRef . itAmount)  (\y-> y-1) w    
-            Equipment {_itAmount = x} -> over (itRef . itAmount)  (\y-> y-1) w    
-            Throwable {_itAmount = x} -> over (itRef . itAmount)  (\y-> y-1) w    
-            _ -> set itRef NoItem w
-
-dropItem :: World -> World
-dropItem w = case yourItem w of
-    NoItem -> w
-    it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
-                            $ updateLocation
-                            $ soundOnce putDownSound 
-                            $ set randGen g w
-      where (rot, g) = randomR (-pi,pi) $ _randGen w
-            offset = _crRad (you w) *.* unitVectorAtAngle rot
-            updateLocation w = case it ^? itID of
-                                  Just (Just i)  -> w & itemPositions . ix i .~ OnFloor flid
-                                  _ -> w
-            flid = newKey $ _floorItems w
-            theflit = FlIt {_flIt = set itAmount 1 it
-                            ,_flItPos = offset +.+ _crPos (you w)
-                            ,_flItRot = rot
-                            ,_flItID = flid}
 
 useItemAmmoCheck :: Int -> World -> World
 useItemAmmoCheck n w 
@@ -292,40 +260,6 @@ useItemAmmoCheck n w
                              _         -> False
 
 
-closestItem :: World -> Maybe Int
-closestItem w = fmap fst $ listToMaybe $ sortBy cf $ IM.toList 
-                    $ fmap (dist yourP . _flItPos) $ _floorItems w
-    where yourP = _crPos $ you w
-          cf (_,x) (_,y) = compare x y
-
-pickUpItem' :: FloorItem -> World -> World
-pickUpItem' flit w = case maybeInvSlot of
-    Nothing -> w
-    Just i  -> soundOnce pickUpSound
-               $ updateItLocation i
-               $ w & floorItems %~ IM.delete (_flItID flit)
-                   & creatures . ix 0 . crInv . ix i %~ addItem' it
-    where 
-        it = _flIt flit
-        maybeInvSlot = checkInvSlots it (_crInv (_creatures w IM.! 0))
-        updateItLocation invid w' 
-            = case _itID it of Nothing -> w'
-                               Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
-
-checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
-checkInvSlots it its = fmap fst $ find cond $ IM.toList its
-    where cond (_,NoItem) = True
-          cond (_,it'   ) = itNotFull it' && _itName it == _itName it'
-
-addItem' :: Item -> Item -> Item
-addItem' it NoItem = it
-addItem' it it'    = it' & itAmount +~ 1
-
-numInventorySlots :: Int 
-numInventorySlots = 9
-
-itNotFull :: Item -> Bool
-itNotFull it = _itMaxStack it > _itAmount it
 
 createItemAt :: Point2 -> FloorItem -> World -> World
 createItemAt p it w = over floorItems (IM.insert i (set flItPos p 
@@ -360,3 +294,36 @@ reverseDir n = over (creatures . ix n . crDir) (+ pi)
 
 turnBy :: Float -> Int -> World -> World
 turnBy a n = over (creatures . ix n . crDir) (+ a)
+
+dropItem :: World -> World
+dropItem w = case yourItem w of
+    NoItem -> w
+    it -> rmInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
+                            $ updateLocation
+                            $ soundOnce putDownSound 
+                            $ set randGen g w
+      where (rot, g) = randomR (-pi,pi) $ _randGen w
+            offset = _crRad (you w) *.* unitVectorAtAngle rot
+            updateLocation w = case it ^? itID of
+                                  Just (Just i)  -> w & itemPositions . ix i .~ OnFloor flid
+                                  _ -> w
+            flid = newKey $ _floorItems w
+            theflit = FlIt {_flIt = set itAmount 1 it
+                            ,_flItPos = offset +.+ _crPos (you w)
+                            ,_flItRot = rot
+                            ,_flItID = flid}
+
+pickUpItem' :: FloorItem -> World -> World
+pickUpItem' flit w = case maybeInvSlot of
+    Nothing -> w
+    Just i  -> soundOnce pickUpSound
+               $ updateItLocation i
+               $ w & floorItems %~ IM.delete (_flItID flit)
+                   & creatures . ix 0 . crInv . ix i %~ addItem it
+    where 
+        it = _flIt flit
+        maybeInvSlot = checkInvSlots it (_crInv (_creatures w IM.! 0))
+        updateItLocation invid w' 
+            = case _itID it of Nothing -> w'
+                               Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
+

src/Dodge/KeyEvents.hs

@@ -4,6 +4,7 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.CreatureActions
 import Dodge.SoundLogic
+import Dodge.Inventory
 
 import Geometry
 
@@ -170,15 +171,6 @@ mouseActionsWorld keys w
           ---theItem   = _crInv (you w) IM.! _crInvSel (you w)
           rotation  = angleBetween (_mousePos w) (_lbClickMousePos w)
 
--- for now, left are floor items, right are buttons
-closestActiveObject :: World -> Maybe (Either FloorItem Button)
-closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ actObjs
-    where ypos = _crPos $ you w
-          actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w) 
-                        $ map Left (IM.elems $ _floorItems w) ++ map Right (IM.elems $ _buttons w)
-          pos (Right x) = _btPos x
-          pos (Left x)  = _flItPos x
-
 spaceAction :: World -> World
 spaceAction w = case closestActiveObject w of
     Just (Left flit) -> pickUpItem' flit w

src/Dodge/Rendering.hs

@@ -2,6 +2,8 @@ module Dodge.Rendering where
 -- imports {{{
 import Dodge.Data
 import Dodge.Base
+import Dodge.Inventory
+
 import Geometry
 import Picture
 
@@ -27,6 +29,7 @@ fixedCoordPictures w = pictures
 --             [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
              [ scaler $ hudDrawings w
              , scaler $ onLayer MenuLayer menuScreen
+             , onLayer InvLayer $ activeObjectText w
              ]
     where scaler = scale (2 / _windowX w) (2 / _windowY w)
           menuScreen :: Picture
@@ -52,6 +55,18 @@ fixedCoordPictures w = pictures
                                     ]
                 where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
 
+activeObjectText :: World -> Picture
+activeObjectText w = case closestActiveObject w of
+    Nothing -> Blank
+    Just (Right bt)  -> pictures 
+                            [ scale (2/_windowX w) (2/_windowY w) 
+                                    $ translate (0.25*_windowX w) (0.25*_windowY w)
+                                    $ scale 0.1 0.1 $ text $ _btText bt
+                            , line [ (0,0),(0.5,0.5)]
+                            ]
+        where btp = _btPos bt
+    Just (Left flit) -> blank
+
 worldPictures :: World -> Picture
 worldPictures w
     = pictures $ concat [ decPicts 
@@ -86,9 +101,6 @@ worldPictures w
           yourPos = _crPos $ you w
           yourRot = _crDir $ you w
           yourRad = _crRad $ you w
-         -- itFloorPicts = zipWith (uncurry translate) (map _flItPos (IM.elems (_floorItems w)))
-         --                                       (map (_itFloorPict . _flIt) (IM.elems (_floorItems w)))
-         --
           scaler = onLayer LabelLayer . setLayer 1
           itLabels     = map (scaler . drawItemName w) (IM.elems (_floorItems w))
           ppLabels     = map (scaler . drawPPText w) (IM.elems (_pressPlates w))
@@ -378,21 +390,12 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
                                     , tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
                                     , tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
                                     ]
---                                = t $ rotate (_cameraRot w)
---                                    $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
---                                                 , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
---                                                 ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white 
---                                                 $ scale 0.1 0.1 $ text $ _btText bt
---                                                 ]
                  | otherwise = blank
     where tranItPos' = uncurry translate (_btPos bt) . rotate (_cameraRot w)
           t = rotate (0 - (_cameraRot w)) 
                 . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
                 . rotate (_cameraRot w)
           zoom = _cameraZoom w
---    where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
---          zoom = _cameraZoom w
---          scLine = dShadCol white . line . fmap (sqrt zoom *.*)
 
 drawPPText :: World -> PressPlate -> Picture
 drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100