diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index fe2d40318..af489bf47 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/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' diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 13e02c46f..5a106bc0d 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -1,8 +1,8 @@ module Dodge.Creature.Impulse.UseItem ( - useItem, - doTopInvLeftClick, + useItemRightClick, + 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 -useItem cr' w = fromMaybe (f w) $ do +useItemRightClick :: Creature -> World -> World +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 -doTopInvLeftClick cr w = fromMaybe w $ do +useItemLeftClick :: Creature -> World -> World +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 - EquipUse{} -> return $ useItem cr w - LeftUse{} -> return $ equipAndUse (_leftUseOnEquip ituse) invid cr w + ConsumeUse{} -> return $ useItemRightClick cr w + EquipUse{} -> return $ useItemRightClick cr w + LeftUse{} -> return $ useItemRightClick cr w _ -> Nothing -equipAndUse :: Bool -> Int -> Creature -> World -> World -equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of - 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 +useItemHotkey :: Int -> Int -> World -> World +useItemHotkey crid invid w = fromMaybe w $ do cr <- w ^? cWorld . lWorld . creatures . ix crid itm <- cr ^? crInv . ix invid luse <- itm ^? itUse . leftUse diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index d9b611c0b..cca3be130 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/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 && inTopInv = doTopInvLeftClick (you w) w + | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItemRightClick (you w) w + | isDown SDL.ButtonLeft && inTopInv = useItemLeftClick (you w) w | isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation | otherwise = w diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index 9fd0b7dfa..9559b2ccb 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -42,7 +42,6 @@ data ItemUse , _leftHammer :: HammerPosition , _equipEffect :: EquipEffect , _leftConsumption :: LeftConsumption - , _leftUseOnEquip :: Bool } | ConsumeUse { _cUse :: Cuse diff --git a/src/Dodge/Default/Item/Use.hs b/src/Dodge/Default/Item/Use.hs index 9b2dacf6d..af363c03e 100644 --- a/src/Dodge/Default/Item/Use.hs +++ b/src/Dodge/Default/Item/Use.hs @@ -18,7 +18,6 @@ defaultLeftUse = , _leftHammer = HammerUp , _equipEffect = defaultEquip , _leftConsumption = defaultLeftLoadable - , _leftUseOnEquip = False } defaultEquipUse :: ItemUse diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 049c2dc06..f0ea63b11 100644 --- a/src/Dodge/Inventory.hs +++ b/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 diff --git a/src/Dodge/Menu/PushPop.hs b/src/Dodge/Menu/PushPop.hs index 26854e23b..ad897ed04 100644 --- a/src/Dodge/Menu/PushPop.hs +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 28e13e4e9..e8fc6872b 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index eadff0548..93431e757 100644 --- a/src/Dodge/Render/List.hs +++ b/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 -listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..] +drawListYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture +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)) - (- (ygap + (s * 20 + ygap) * (fromIntegral yint) + 1)) + ((10 * fromIntegral xint - 5) * s) + (- (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) - where - hw = halfWidth cfig - hh = halfHeight cfig +toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig) diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index f1424ab7d..32a953aed 100644 --- a/src/Dodge/SelectionList.hs +++ b/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) diff --git a/src/Dodge/SelectionSections/Draw.hs b/src/Dodge/SelectionSections/Draw.hs index d2549d481..72ad22bc3 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/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 diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 7fa147a5c..a598faa0b 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/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 diff --git a/src/Dodge/Update/Input/ScreenLayer.hs b/src/Dodge/Update/Input/ScreenLayer.hs index e1cb3907d..6425d027c 100644 --- a/src/Dodge/Update/Input/ScreenLayer.hs +++ b/src/Dodge/Update/Input/ScreenLayer.hs @@ -79,44 +79,21 @@ mouseClickOptionsList screen u = fromMaybe u $ do return $ f u _ -> u -mouseOverSelectionList :: - ListDisplayParams -> - ScreenLayer -> - Universe -> - Universe +mouseOverSelectionList :: ListDisplayParams -> ScreenLayer -> Universe -> Universe mouseOverSelectionList ldps screen u = fromMaybe u $ do yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos) - guard $ - (mmoving || (_scDisplayTime screen <= 1)) - && isselectable yi - && yi >= 0 - && yi < ymax - -- && x > xl && x < xr - return $ u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yi + guard $ mmoving || (_scDisplayTime screen <= 1) + let myi = do + guard (yi >= 0 && yi < ymax && isselectable yi) + return yi + return $ u & uvScreenLayers . _head . scSelectionList . slSelPos .~ myi 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