Stop equip after combining

src/Dodge/Creature/Impulse.hs

@@ -46,7 +46,7 @@ followImpulse cr w imp = case imp of
     TurnToward p a -> crup $ creatureTurnToward p a cr
     TurnTo p -> crup $ creatureTurnTo p cr
     ChangePosture post -> crup $ cr & crStance . posture .~ post
-    UseItem -> (useItem cr, cr)
+    UseItem -> (useItemRightClick cr, cr)
     SwitchToItem i -> crup $ cr & crManipulation . manObject .~ InInventory (SelItem i NoInvSelAction)
     Melee cid' ->
         ( hitCr cid'

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,8 +1,8 @@
 module Dodge.Creature.Impulse.UseItem (
-    useItem,
+    useItemRightClick,
-    doTopInvLeftClick,
+    useItemLeftClick,
     itemEffect,
-    tryUseL,
+    useItemHotkey,
 ) where
 
 import Dodge.Hotkey
@@ -22,8 +22,8 @@ import Dodge.Reloading
 import qualified IntMapHelp as IM
 import qualified SDL
 
-useItem :: Creature -> World -> World
+useItemRightClick :: Creature -> World -> World
-useItem cr' w = fromMaybe (f w) $ do
+useItemRightClick cr' w = fromMaybe (f w) $ do
     cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
     itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
     it <- cr ^? crInv . ix itRef
@@ -113,25 +113,19 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
     onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
     onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
 
-doTopInvLeftClick :: Creature -> World -> World
+useItemLeftClick :: Creature -> World -> World
-doTopInvLeftClick cr w = fromMaybe w $ do
+useItemLeftClick cr w = fromMaybe w $ do
     guard . not $ _crInvLock cr
     invid <- cr ^? crManipulation . manObject . inInventory . ispItem
     ituse <- cr ^? crInv . ix invid . itUse
     case ituse of
-        ConsumeUse{} -> return $ useItem cr w
+        ConsumeUse{} -> return $ useItemRightClick cr w
-        EquipUse{} -> return $ useItem cr w
+        EquipUse{} -> return $ useItemRightClick cr w
-        LeftUse{} -> return $ equipAndUse (_leftUseOnEquip ituse) invid cr w
+        LeftUse{} -> return $ useItemRightClick cr w
         _ -> Nothing
 
-equipAndUse :: Bool -> Int -> Creature -> World -> World
+useItemHotkey :: Int -> Int -> World -> World
-equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of
+useItemHotkey crid invid w = fromMaybe w $ do
-    Nothing | useonequip -> tryUseL (_crID cr) invid $ useItem cr w
-        | otherwise -> useItem cr w
-    _ -> tryUseL (_crID cr) invid w
-
-tryUseL :: Int -> Int -> World -> World
-tryUseL crid invid w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix crid
     itm <- cr ^? crInv . ix invid
     luse <- itm ^? itUse . leftUse

src/Dodge/Creature/YourControl.hs

@@ -48,7 +48,7 @@ handleHotkeys w
     hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
 
 useHotKey :: World -> Int -> World
-useHotKey w invid = tryUseL 0 invid w
+useHotKey w invid = useItemHotkey 0 invid w
 
 allHotkeys :: [SDL.Scancode]
 allHotkeys = map hotkeyToScancode [minBound .. maxBound]
@@ -161,8 +161,8 @@ mouseActionsCr pkeys cr
 
 pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
 pressedMBEffectsTopInventory pkeys w
-    | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w
+    | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItemRightClick (you w) w
-    | isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w
+    | isDown SDL.ButtonLeft && inTopInv = useItemLeftClick (you w) w
     | isDown SDL.ButtonMiddle =
         w & wCam . camRot -~ rotation
     | otherwise = w

src/Dodge/Data/Item/Use.hs

@@ -42,7 +42,6 @@ data ItemUse
         , _leftHammer :: HammerPosition
         , _equipEffect :: EquipEffect
         , _leftConsumption :: LeftConsumption
-        , _leftUseOnEquip :: Bool
         }
     | ConsumeUse
         { _cUse :: Cuse

src/Dodge/Default/Item/Use.hs

@@ -18,7 +18,6 @@ defaultLeftUse =
         , _leftHammer = HammerUp
         , _equipEffect = defaultEquip
         , _leftConsumption = defaultLeftLoadable
-        , _leftUseOnEquip = False
         }
 
 defaultEquipUse :: ItemUse

src/Dodge/Inventory.hs

@@ -54,7 +54,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
             & doanyitemeffect
             & dounequipfunction         --the ordering of these is
             & pointcid . crInv %~ f     -- important
---            & pointcid . crLeftInvSel . lisMPos %~ g'
 
             & removeAnySlotEquipment
             & pointcid . crEquipment . each %~ g
@@ -100,11 +99,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     g x
         | x > invid || Just x == maxk = max 0 $ x - 1
         | otherwise = x
---    g' Nothing = Nothing
---    g' (Just x)
---        | x == invid = Nothing
---        | x > invid || Just x == maxk = Just $ max 0 $ x - 1
---        | otherwise = Just x
 
 rmSelectedInvItem :: Int -> World -> World
 rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of

src/Dodge/Menu/PushPop.hs

@@ -4,7 +4,7 @@ import Dodge.Data.Universe
 import LensHelp
 
 popScreen :: Universe -> Universe
-popScreen = uvScreenLayers %~ tail
+popScreen = (uvScreenLayers . ix 0 . scDisplayTime .~ 0) . (uvScreenLayers %~ tail)
 
 pushScreen :: (Universe -> ScreenLayer) -> Universe -> Universe
 pushScreen ml u = u & uvScreenLayers .:~ ml u

src/Dodge/Render/HUD.hs

@@ -204,7 +204,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
   where
     invcursor i = fromMaybe mempty $ do
         sss' <- w ^? hud . hudElement . diSections
-        let idp = (invDisplayParams w & ldpCursorSides .~ [North, South, East, West])
+        let idp = invDisplayParams w & ldpCursorSides .~ [North, South, East, West]
         return $
             translateScreenPos cfig (idp ^. ldpPos) $
                 selSecDrawCursor 17 idp (sss' & sssExtra . sssSelPos ?~ (0, i))
@@ -261,7 +261,7 @@ lnkMidPosInvSelsCol cfig w i col = foldMap f
         lp <- selNumPos cfig (invDisplayParams w) sss 0 j
         rp <- selNumPos cfig secondColumnParams combinesss 0 i
         invcol <- selSecSelCol 0 j sss
-        return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col white white invcol
+        return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col col col invcol
 
 tweakItems :: Maybe Item -> [SelectionItem ()]
 tweakItems = textSelItems . ammoTweakStrings

src/Dodge/Render/List.hs

@@ -2,7 +2,7 @@ module Dodge.Render.List (
     renderListAt,
     drawList,
     drawSelectionList,
-    listPicturesYgapScaleYoff,
+    drawListYgapScaleYoff,
     drawListElement,
     selSecDrawCursor,
     dShadCol,
@@ -30,7 +30,7 @@ drawSelectionList ldps cfig sl =
     translateScreenPos
         cfig
         (ldps ^. ldpPos)
-        $ listPicturesYgapScaleYoff
+        $ drawListYgapScaleYoff
             (_ldpVerticalGap ldps)
             (_ldpScale ldps)
             0
@@ -72,10 +72,10 @@ getLDPWidth ldps = case _ldpWidth ldps of
         _ -> 1
 
 drawListYoff :: Int -> [Picture] -> Picture
-drawListYoff = listPicturesYgapScaleYoff 0 1
+drawListYoff = drawListYgapScaleYoff 0 1
 
-listPicturesYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
+drawListYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
-listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
+drawListYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
 
 stackPicturesAt :: [Picture] -> Picture
 stackPicturesAt = stackPicturesAtOff 0
@@ -113,8 +113,8 @@ listCursorChooseBorderScale ::
     Picture
 listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
     translate
-        ((10 * s * (fromIntegral xint) - 5 * s))
+        ((10 * fromIntegral xint - 5) * s)
-        (- (ygap + (s * 20 + ygap) * (fromIntegral yint) + 1))
+        (- (ygap + (s * 20 + ygap) * fromIntegral yint ))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
   where
@@ -162,7 +162,7 @@ renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
 drawList :: [Picture] -> Picture
-drawList = listPicturesYgapScaleYoff 0 1 0
+drawList = drawListYgapScaleYoff 0 1 0
 
 --TODO put the following functions in an appropriate place
 
@@ -172,7 +172,4 @@ dShadCol :: Color -> Picture -> Picture
 dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
 
 toTopLeft :: Configuration -> Picture -> Picture
-toTopLeft cfig = translate (- hw) (hh)
+toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig)
-  where
-    hw = halfWidth cfig
-    hh = halfHeight cfig

src/Dodge/SelectionList.hs

@@ -3,13 +3,10 @@ module Dodge.SelectionList (
     getAvailableListLines,
 ) where
 
-import Color
-import Data.Maybe
 import Dodge.Data.ScreenPos
 import Dodge.Data.Universe
 import LensHelp
 import Linear
-import Regex
 
 getAvailableListLines :: ListDisplayParams -> Configuration -> Int
 getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
@@ -25,35 +22,3 @@ getShownItems :: SelectionList a -> [SelectionItem a]
 getShownItems sl = case sl ^. slRegexList of
     [] -> sl ^. slItems
     xs -> fmap fst xs
-
-makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)]
-makeRegexList sl = case sl ^. slRegex of
-    "" | not (sl ^. slRegexInput) -> []
-    str ->
-        ( SelectionInfo
-            { _siPictures = ["FILTER: " ++ str]
-            , _siHeight = 1
-            , _siIsSelectable = False
-            , --, _siWidth = length $ "FILTER: "++str
-              _siColor = white
-            , _siOffX = 0
-            }
-        , Nothing
-        ) :
-        filter (doregex str) (zip (_slItems sl) $ fmap Just [0 ..])
-  where
-    doregex str = regexList str . _siPictures . fst
-
-setShownItems :: SelectionList a -> SelectionList a
-setShownItems sl = sl & slRegexList .~ makeRegexList sl
-
-moveSelectionListSelection :: Int -> SelectionList a -> SelectionList a
-moveSelectionListSelection yi sl = sl & slSelPos %~ f
-  where
-    f x
-        | maxsel == 0 = Nothing
-        | isNothing x = Just 0
-        | otherwise = fmap ((`mod` maxsel) . subtract yi) x
-    maxsel = case _slRegex sl of
-        "" -> length (_slItems sl)
-        _ -> length (_slRegexList sl)

src/Dodge/SelectionSections/Draw.hs

@@ -10,7 +10,7 @@ import Picture.Base
 drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
 drawSelectionSections sss ldp cfig =
     translateScreenPos cfig (ldp ^. ldpPos) $
-        listPicturesYgapScaleYoff
+        drawListYgapScaleYoff
             (_ldpVerticalGap ldp)
             (_ldpScale ldp)
             0

src/Dodge/Update/Input/InGame.hs

@@ -253,7 +253,8 @@ tryCombine :: SelectionSections CombinableItem -> World -> World
 tryCombine sss w = fromMaybe w $ do
     (i, j) <- sss ^? sssExtra . sssSelPos . _Just
     CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
-    return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
+    return $ createAndSelectItem it (foldr (rmInvItem 0) w (sort is))
+        & cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
 
 maybeExitCombine :: Universe -> Universe
 maybeExitCombine u

src/Dodge/Update/Input/ScreenLayer.hs

@@ -79,44 +79,21 @@ mouseClickOptionsList screen u = fromMaybe u $ do
                 return $ f u
             _ -> u
 
-mouseOverSelectionList ::
+mouseOverSelectionList :: ListDisplayParams -> ScreenLayer -> Universe -> Universe
-    ListDisplayParams ->
-    ScreenLayer ->
-    Universe ->
-    Universe
 mouseOverSelectionList ldps screen u = fromMaybe u $ do
     yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
-    guard $
+    guard $ mmoving || (_scDisplayTime screen <= 1)
-        (mmoving || (_scDisplayTime screen <= 1))
+    let myi = do
-            && isselectable yi
+            guard (yi >= 0 && yi < ymax && isselectable yi)
-            && yi >= 0
+            return yi
-            && yi < ymax
+    return $ u & uvScreenLayers . _head . scSelectionList . slSelPos .~ myi
-    --      && x > xl && x < xr
-    return $ u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yi
   where
-    --    | x > xl && x < xr
-    --        && ylower == yupper
-    --        && (mmoving || (_scDisplayTime screen <= 1)) -- slight hack
-    --        && isselectable =
-    --        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
-    --    | otherwise = u
-
-    sl = _scSelectionList screen
     isselectable yi =
         fromMaybe False $
             u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
-    ymax = maybe 0 length $ sl ^? slItems
+    ymax = maybe 0 length $ screen ^? scSelectionList . slItems
     mmoving = u ^. uvWorld . input . mouseMoving
 
---    ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
---    yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
---    xl = _ldpPosX ldps - hw
---    xr = xl + _ldpScale ldps * 26 * 9
---    V2 _ y = u ^. uvWorld . input . mousePos
---    cfig = u ^. uvConfig
---    hh = halfHeight cfig
---    hw = halfWidth cfig
-
 ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
 ldpVerticalSelection cfig ldp (V2 _ y)
     | yupper == ylower = Just yupper