diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index ce7cf467b..b87fc2861 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -48,8 +48,20 @@ you w = _creatures w IM.! _yourID w aCrPos :: Int -> World -> Point2 aCrPos i w = _crPos $ _creatures w IM.! i -yourItem :: World -> Item -yourItem w = _crInv (you w) IM.! _crInvSel (you w) +yourItem :: World -> Maybe Item +yourItem w = _crInv (you w) IM.!? _crInvSel (you w) + +yourInv :: World -> IM.IntMap Item +yourInv w = _crInv (you w) + +yourInvSel :: World -> Int +yourInvSel w = _crInvSel (you w) + +selectedObject :: World -> Maybe (Either FloorItem Button) +selectedObject w = lookup (_crInvSel ycr) $ zip [n..] $ _closeObjects w + where + ycr = you w + n = length $ _crInv ycr crItem :: World -> Int -> Item crItem w cid = _crInv cr IM.! _crInvSel cr diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 55f4d1713..3fa247e6d 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -232,7 +232,7 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid . mayberem {- | Get your creature to drop the item under the cursor. -} youDropItem :: World -> World -youDropItem w = case yourItem w ^? itCurseStatus of +youDropItem w = case yourItem w ^? _Just . itCurseStatus of Just Uncursed -> w & dropItem cr (_crInvSel cr) & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing @@ -250,7 +250,7 @@ pickUpItem cid flit w = case maybeInvSlot of Just i -> w & soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing & updateItLocation i - & floorItems %~ IM.delete (_flItID flit) + & floorItems %~ IM.delete (_flItID flit) & creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it where it = _flIt flit diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index e9282c28b..6f3328c95 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -25,6 +25,7 @@ import Dodge.Inventory --import Preload.Update import qualified IntMapHelp as IM +import Data.Maybe import Control.Lens --import Data.Maybe --import Data.Char @@ -105,15 +106,15 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of | rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) (_, TopInventory) - | rbDown -> case yourItem w ^? itScroll of + | rbDown -> case yourItem w ^? _Just . itScroll of Nothing -> closeObjScrollDir y w Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) | lbDown -> w & cameraZoom +~ y - | invKeyDown -> swapInvDir yi $ stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w - | otherwise -> stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w + | invKeyDown -> swapInvDir yi $ stopSoundFrom (CrReloadSound 0) $ changeInvPos yi w + | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeInvCloseObjectsPos yi w (_, TweakInventory) | invKeyDown && rbDown -> w & moveTweakSel yi - | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ dirInvPos yi w + | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvPos yi w | rbDown -> w & changeTweakParam yi | otherwise -> w & moveTweakSel yi (_, _) -> w @@ -125,7 +126,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of invKeyDown = ScancodeCapsLock `S.member` _keys w moveTweakSel :: Int -> World -> World -moveTweakSel i w = case yourItem w ^? itTweaks . tweakParams of +moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) . itTweaks . tweakSel %~ (`mod` length l) . subtract i _ -> w @@ -135,7 +136,7 @@ changeTweakParam i w = w ( (itTweaks . tweakParams . ix paramid . curTweak .~ x) . _doTweak params x) where - tweaks = _itTweaks $ yourItem w + tweaks = _itTweaks . fromJust $ yourItem w params = _tweakParams tweaks IM.! paramid x = (_curTweak params + i) `mod` _maxTweak params paramid = _tweakSel tweaks diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 9a07e303e..3f2fd9941 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -5,14 +5,17 @@ module Dodge.Inventory , updateCloseObjects , closeObjScrollDir , swapInvDir - , dirInvPos + , changeInvPos + , changeInvCloseObjectsPos + , crNumFreeSlots + , crInvSize ) where import Dodge.Data import Dodge.Base import Dodge.Base.Collide import Geometry -import FoldableHelp +--import FoldableHelp import Padding import qualified IntMapHelp as IM @@ -25,28 +28,26 @@ import Control.Lens -- if so return Just the next slot to be used checkInvSlotsYou :: Item -> World -> Maybe Int checkInvSlotsYou it w - | _crInvCapacity ycr >= curinvsize + _itInvSize it + | crNumFreeSlots ycr >= _itInvSize it = Just $ maybe 0 ((+1) . fst) $ IM.lookupMax inv | otherwise = Nothing where ycr = you w inv = _crInv ycr - curinvsize = sum $ fmap _itInvSize inv +-- curinvsize = invSize inv ----- | Finds first available slot where a new item may be placed in the inventory ---checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int ---checkInvSlots it = checkInvSlotsH it . IM.toList +crNumFreeSlots :: Creature -> Int +crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr) -itNotFull :: Item -> Bool -itNotFull it = case it ^? itMaxStack of - Just themax -> themax > _itAmount it - Nothing -> False +crInvSize :: Creature -> Int +crInvSize = invSize . _crInv -rmInvItem - :: Int -- ^ Creature id +invSize :: IM.IntMap Item -> Int +invSize = sum . fmap _itInvSize + +rmInvItem :: Int -- ^ Creature id -> Int -- ^ Inventory position - -> World - -> World + -> World -> World rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmount of Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itAmount %~ subtract 1 _ -> w & creatures . ix cid . crInv %~ f @@ -56,8 +57,8 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmou maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid f inv = let (xs,ys) = IM.split invid inv in xs `IM.union` IM.mapKeys (subtract 1) ys - g x | x > invid || Just x == maxk = x - 1 - | otherwise = x + g x | x > invid || Just x == maxk = max 0 $ x - 1 + | otherwise = x {- Delete a creature's selected item, the item will no longer exist. -} rmSelectedInvItem :: Int -- ^ Creature id @@ -91,7 +92,9 @@ closeObjScrollDir x | otherwise = id swapInvDir :: Int -> World -> World -swapInvDir k w = w & creatures . ix (_yourID w) %~ updatecreature +swapInvDir k w + | n == 0 = w + | otherwise = w & creatures . ix (_yourID w) %~ updatecreature where updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi ) . (crLeftInvSel . _Just %~ updateLeftInvSel) @@ -102,8 +105,16 @@ swapInvDir k w = w & creatures . ix (_yourID w) %~ updatecreature i = _crInvSel $ you w n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w -dirInvPos :: Int -> World -> World -dirInvPos i w = w - & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i +changeInvPos :: Int -> World -> World +changeInvPos i w + | n == 0 = w + | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i where n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w + +changeInvCloseObjectsPos :: Int -> World -> World +changeInvCloseObjectsPos i w + | n == 0 = w + | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i + where + n = (length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w) + length (_closeObjects w) diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index 53bffbe89..d24bb4feb 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -43,7 +43,7 @@ poisonSprayer = defaultAutoGun [ ammoCheckI , withSoundForI foamSprayLoopS 5 , useAmmo 1 - , spreadNumI +-- , spreadNumI ] & useAim . aimSpeed .~ 0.2 & useAim . aimRange .~ 0 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index f85cef03f..5a3347d46 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -1,8 +1,7 @@ {-# LANGUAGE TupleSections #-} module Dodge.Render.HUD ( hudDrawings - ) - where + ) where import Dodge.Data import Dodge.WinScale import Dodge.Base @@ -14,6 +13,7 @@ import Picture import Geometry import Padding +import Data.Foldable import Data.Maybe import qualified Data.IntMap.Strict as IM import qualified Data.Set as S @@ -25,23 +25,16 @@ hudDrawings :: Configuration -> World -> Picture hudDrawings cfig w = pictures [ winScale cfig . dShadCol white $ displayHP 0 cfig w , renderListAt (halfWidth cfig) 0 cfig $ map (,white) (_testString w w) - , selectionText - ] - where - selectionText = if _carteDisplay w + , if _carteDisplay w then drawLocations cfig w - else drawInventory cfig w - - -drawInventory :: Configuration -> World -> Picture -drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w + else subInventoryDisplay cfig w `appendPic` displayInv 0 cfig w + ] subInventoryDisplay :: Configuration -> World -> Picture subInventoryDisplay cfig w = case _inventoryMode w of LockedInventory -> mempty -- topInvCursor col cursPos cfig w TopInventory -> pictures - [ closeObjectTexts cfig w --- , topInvCursor col cursPos cfig w + [ --closeObjectTexts cfig w ] TweakInventory -> pictures [ mCurs it cfig w @@ -52,20 +45,45 @@ subInventoryDisplay cfig w = case _inventoryMode w of CombineInventory -> invHead cfig "COMBINE" InspectInventory -> invHead cfig "INSPECT" where - itCol = fromMaybe (greyN 0.5) . (^? itInvColor) - cr = you w + itCol = fromMaybe (greyN 0.5) . (^? _Just . itInvColor) + --cr = you w it = yourItem w col = itCol it - cursPos = crInvSelPos cr + cursPos = invSelPos w -crInvSelSize :: Creature -> Int -crInvSelSize cr = _itInvSize $ _crInv cr IM.! _crInvSel cr +--crInvSelSize :: Creature -> Int +--crInvSelSize cr = fromMaybe 1 $ fmap _itInvSize $ _crInv cr IM.!? _crInvSel cr -crInvSelPos :: Creature -> Int -crInvSelPos cr = sum . fmap _itInvSize . fst $ IM.split (_crInvSel cr) (_crInv cr) +--crInvSelPos :: Creature -> Int +--crInvSelPos cr = foldl' (+) 0 . fmap _itInvSize . fst $ IM.split (_crInvSel cr) (_crInv cr) -cursorsZ :: Configuration -> Int -> Item -> Picture -cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of +invSelPos :: World -> Int +invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w)) + where + invsel = yourInvSel w + splitgap + | yourInvSel w < length (yourInv w) = 0 + | otherwise = 1 + +augmentedInvSizes :: World -> IM.IntMap Int +augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w) + (IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w) +--augmentedInvSizesWithGap :: World -> IM.IntMap Int +--augmentedInvSizesWithGap w = IM.union (safeUpdateMax (Just . (+1)) $ fmap _itInvSize $ yourInv w) +-- (IM.fromAscList $ zip [length (yourInv w) ..] $ (map closeObjectSize $ _closeObjects w)) +-- +--safeUpdateMax :: (a -> Maybe a) -> IM.IntMap a -> IM.IntMap a +--safeUpdateMax f m +-- | IM.null m = m +-- | otherwise = IM.updateMax f m + +closeObjectSize :: Either FloorItem Button -> Int +closeObjectSize e = case e of + Left flit -> _itInvSize $ _flIt flit + Right bt -> 1 + +cursorsZ :: Configuration -> Int -> Maybe Item -> Picture +cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of Nothing -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5)) Just jpos -> f $ zConnect sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5))) where @@ -74,13 +92,13 @@ cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of hw = halfWidth cfig sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)) -ammoTweakStrings :: Item -> [String] -ammoTweakStrings it = case it ^? itTweaks . tweakParams of +ammoTweakStrings :: Maybe Item -> [String] +ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of Just l -> map tweakString $ IM.elems l _ -> ["NOT TWEAKABLE"] -mCurs :: Item -> Configuration -> World -> Picture -mCurs it cfig w = case it ^? itTweaks . tweakSel of +mCurs :: Maybe Item -> Configuration -> World -> Picture +mCurs it cfig w = case it ^? _Just . itTweaks . tweakSel of Nothing -> [] Just i | ButtonRight `S.member` _mouseButtons w -> @@ -111,19 +129,41 @@ invHead cfig s = winScale cfig --{-# INLINE renderItemMapAt #-} --renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList - displayInv :: Int -> Configuration -> World -> Picture -displayInv n cfig w = listTextPicturesAt 0 0 cfig (concatMap itemToTextPictures $ IM.elems $ _crInv cr) +displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist <> equipcursor - <> listCursorAt 0 0 cfig curpos white curx cury + <> selcursor where - curpos = crInvSelPos $ you w + selcursor + | IM.null inv && null (_closeObjects w) = mempty + | otherwise = listCursorAt 0 0 cfig curpos white curx cury + inv = _crInv cr + invlist = (concatMap itemToTextPictures $ IM.elems inv) + ++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w) + nfreeslots = crNumFreeSlots cr + displayFreeSlots = case nfreeslots of + 0 -> [color invDimColor . text $ " INVENTORY FULL"] + 1 -> [color invDimColor . text $ " +1 FREE SLOT"] + x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"] + curpos = invSelPos w curx = 10 - cury = crInvSelSize $ you w + --cury = crInvSelSize $ you w + cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w) equipcursor = case _crLeftInvSel cr of Nothing -> mempty Just invid -> openCursorAt 20 yellow 0 0 invid cfig cr = _creatures w IM.! n +invDimColor :: Color +invDimColor = greyN 0.7 +closeObjectToTextPictures :: Int -> Either FloorItem Button -> [Picture] +closeObjectToTextPictures nfreeslots e = case e of + Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ _itInvDisplay it it + Right bt -> [color yellow $ textindent $ _btText bt] + where + textindent = text . (" "++) + applycolor it + | nfreeslots >= _itInvSize it = color $ _itInvColor it + | otherwise = color invDimColor drawLocations :: Configuration -> World -> Picture drawLocations cfig w = pictures $ @@ -160,6 +200,26 @@ mapWall cfig w wl = n2 = 20 *.* vNormal t (x,y) = _wlLine wl c = _wlColor wl + +bestCloseObjectIndex :: World -> Maybe Int +bestCloseObjectIndex w = Nothing + +selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button) +selectedCloseObject w + | invsel > length inv = Just $ selectNthCloseObject w (invsel - length inv) + | otherwise = fmap (selectNthCloseObject w) $ bestCloseObjectIndex w + where + invsel = _crInvSel cr + cr = you w + inv = _crInv cr + invsize = crInvSize (you w) + +selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button) +selectNthCloseObject w n = undefined + +selectedCloseObjectLink :: Configuration -> World -> Picture +selectedCloseObjectLink cfig w = mempty + {- | Pictures of popup text for items close to your position.-} closeObjectTexts :: Configuration -> World -> Picture closeObjectTexts cfig w = pictures $ @@ -197,8 +257,6 @@ itemToTextPictures it = itemText it itemText :: Item -> [Picture] {-# INLINE itemText #-} ---itemText NoItem = dShadCol (greyN 0.5) $ text "----" ---itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it) itemText it = case _itCurseStatus it of UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it) -- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90))) diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index f46cefd6b..72b89e697 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -42,22 +42,9 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig hh = halfHeight cfig renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture -renderListAt tx ty cfig = - concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..] +renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str) +-- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..] -listPairAt - :: Float -- ^ x offset - -> Float -- ^ y offset - -> Configuration - -> Int -- ^ y offset (discrete) - -> (String,Color) -- ^ The text item - -> Picture -{-# INLINE listPairAt #-} -listPairAt xoff yoff cfig yint (s,col) - = translate (xoff + 15 - halfWidth cfig) (yoff + halfHeight cfig - (20 * (fromIntegral yint+1))) - . scale 0.1 0.1 - . dShadCol col - $ text s --TODO put the following functions in an appropriate place {- | Colour picture and add black drop shadow. -} dShadCol :: Color -> Picture -> Picture diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index e186cb152..23117260d 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -38,7 +38,7 @@ moveCamera w = w where aimRangeFactor | _cameraZoom w == 0 = 0 - | otherwise = fromMaybe 0 (yourItem w ^? itUse . useAim . aimRange) / _cameraZoom w + | otherwise = fromMaybe 0 (yourItem w ^? _Just . itUse . useAim . aimRange) / _cameraZoom w aimingMult | SDL.ButtonRight `S.member` _mouseButtons w = 1 | otherwise = 0 @@ -46,9 +46,9 @@ moveCamera w = w idealPos = camCenter +.+ rotateV (_cameraRot w) (aimRangeFactor * aimingMult *.* _mousePos w) camCenter = ypos +.+ scopeOffset - scopeOffset = fromMaybe (V2 0 0) $ yourItem w ^? itAttachment . scopePos + scopeOffset = fromMaybe (V2 0 0) $ yourItem w ^? _Just . itAttachment . scopePos sightFrom - | fromMaybe False $ yourItem w ^? itAttachment . scopeIsCamera + | fromMaybe False $ yourItem w ^? _Just . itAttachment . scopeIsCamera = camCenter | otherwise = ypos @@ -159,7 +159,7 @@ autoZoomCamera cfig w = w & cameraZoom %~ changeZoom wallZoom = farWallDist camPos cfig w idealZoom | SDL.ButtonRight `S.member` _mouseButtons w - = theScopeZoom * maybe zoomNoItem zoomFromItem (yourItem w ^? itUse . useAim . aimZoom) wallZoom + = theScopeZoom * maybe zoomNoItem zoomFromItem (yourItem w ^? _Just . itUse . useAim . aimZoom) wallZoom | otherwise = zoomNoItem wallZoom -- = maybe zoomNoItem zoomFromItem (yourItem w ^? itZoom) wallZoom changeZoom curZoom @@ -169,7 +169,7 @@ autoZoomCamera cfig w = w & cameraZoom %~ changeZoom -- these speeds are inverted, larger means slower zoomInSpeed = 25 zoomOutSpeed = 15 - theScopeZoom = fromMaybe 1 $ yourItem w ^? itAttachment . scopeZoom + theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itAttachment . scopeZoom farWallDist :: Point2 -> Configuration -> World -> Float farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps