diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index a735985a4..531327e0f 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -1,18 +1,21 @@ {-# LANGUAGE TupleSections #-} module Dodge.Combine where +import Dodge.Base.You import Dodge.Data --import Dodge.Combine.Data import Dodge.Combine.Combinations import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Craftable +import Control.Lens import Data.Bifunctor ---import qualified Data.IntMap.Strict as IM +import qualified Data.IntMap.Strict as IM --import qualified Data.IntSet as IS import qualified Data.Map.Strict as M +import Data.Maybe -pureCombine :: [ (M.Map CombineType Int, Item) ] -pureCombine = map (first toMultiset) +itemCombinations :: [ (M.Map CombineType Int, Item) ] +itemCombinations = map (first toMultiset) [ p [PIPE,HARDWARE] bangStick , p [LONGPIPE,HARDWARE] bangCane , p [VERYLONGPIPE,HARDWARE] bangRod @@ -21,3 +24,30 @@ pureCombine = map (first toMultiset) ] where p = (,) + +combineToItem :: M.Map CombineType Int -> Maybe Item +combineToItem m = lookup m itemCombinations + +combineItemList :: IM.IntMap CombineType -> [([Int],Item)] +combineItemList m = mapMaybe (pushoutmaybe . second (combineToItem . toMultiset) . unzip) + . powlistN 4 + $ IM.toList m + where + pushoutmaybe (_,Nothing) = Nothing + pushoutmaybe (x,Just y) = Just (x,y) + +combineItemListYou :: World -> [([Int],Item)] +combineItemListYou = combineItemList . fmap _itCombineType . yourInv + +combineListYou :: World -> [([Int],CombineType)] +combineListYou = combineList . fmap _itCombineType . yourInv + +toggleCombineInv :: World -> World +toggleCombineInv w = case _inventoryMode w of + CombineInventory _ -> w & inventoryMode .~ TopInventory + _ -> w & enterCombineInv + +enterCombineInv :: World -> World +enterCombineInv w = w & inventoryMode .~ CombineInventory mi + where + mi = const 0 <$> listToMaybe (combineListYou w) diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index e2276e915..6419e696c 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -43,4 +43,3 @@ combinations = map (first toMultiset) , ( [ PIPE, PIPE ] , LONGPIPE ) , ( [ LONGPIPE, PIPE ] , VERYLONGPIPE ) ] - diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 8e28cc1bb..719e94dd9 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -17,6 +17,7 @@ import Dodge.Item.Weapon.Grenade import Dodge.Item.Weapon.Booster import Dodge.Item.Weapon.Utility import Dodge.Item.Weapon.Drone +import Dodge.Item.Craftable --import Dodge.Creature.ReaderUpdate --import Dodge.Creature.AlertLevel --import Dodge.Creature.SetTarget @@ -171,6 +172,10 @@ startInventory = IM.fromList $ zip [0..] startInvList stackedInventory :: IM.IntMap Item stackedInventory = IM.fromList $ zip [0..] [spreadGun + , pipe + , makeTypeCraft LONGPIPE + , makeTypeCraft VERYLONGPIPE + , makeTypeCraft HARDWARE ,rewindGun ,tractorGun ,longGun diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 6dc82052f..0e70c2209 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -14,6 +14,7 @@ module Dodge.Creature.Action , copyInvItemToFloor , youDropItem , pickUpItem + , pickUpItemID ) where import Dodge.Path @@ -221,21 +222,6 @@ youDropItem w = case yourItem w ^? _Just . itCurseStatus of copyInvItemToFloor :: Creature -> Int -> World -> World copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) (_crInv cr IM.! i) -{- | Pick up a specific item. -} -pickUpItem :: Int -> FloorItem -> World -> World -pickUpItem cid flit w = case maybeInvSlot of - Nothing -> w - Just i -> w - & soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing - & updateItLocation i - & floorItems %~ IM.delete (_flItID flit) - & creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it - where - it = _flIt flit - maybeInvSlot = checkInvSlotsYou it w - updateItLocation invid w' = case _itID it of - Nothing -> w' - Just j -> w' & itemPositions . ix j .~ InInv 0 invid sizeSelf :: Float -> Creature -> World -> Maybe World sizeSelf x cr w @@ -259,3 +245,23 @@ sizeSelf x cr w raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) cid = _crID cr cpos = _crPos cr + +pickUpItemID :: Int -> Int -> World -> World +pickUpItemID cid flid w = pickUpItem cid (_floorItems w IM.! flid) w + + +{- | Pick up a specific item. -} +pickUpItem :: Int -> FloorItem -> World -> World +pickUpItem cid flit w = case maybeInvSlot of + Nothing -> w + Just i -> w + & soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing + & updateItLocation i + & floorItems %~ IM.delete (_flItID flit) + & creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it + where + it = _flIt flit + maybeInvSlot = checkInvSlotsYou it w + updateItLocation invid w' = case _itID it of + Nothing -> w' + Just j -> w' & itemPositions . ix j .~ InInv 0 invid diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index c9bdaffc8..d41d259fc 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -167,7 +167,7 @@ data MenuOption data InventoryMode = TopInventory | TweakInventory - | CombineInventory + | CombineInventory {_combineInvSel :: Maybe Int} | InspectInventory | LockedInventory deriving (Eq, Ord, Show) @@ -940,3 +940,4 @@ makeLenses ''LSParam makeLenses ''ItemParams makeLenses ''ItemTweaks makeLenses ''Maybe' +makeLenses ''InventoryMode diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 58f8e60f6..2d2badfab 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -13,6 +13,7 @@ module Dodge.Event ( handleEvent ) where import Dodge.Event.Keyboard +import Dodge.Combine --import Dodge.Event.Menu import Dodge.Data import Dodge.Base @@ -21,10 +22,14 @@ import Dodge.PreloadData --import Dodge.Creature.Action import Dodge.SoundLogic import Dodge.Inventory +import Dodge.Inventory.PickUp --import Geometry --import Preload.Update import qualified IntMapHelp as IM +import ListHelp +import Dodge.FloorItem +--import Data.Monoid import Data.Maybe import Control.Lens --import Data.Maybe @@ -92,8 +97,23 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w | but == ButtonMiddle || _carteDisplay (_uvWorld w) = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) + | but == ButtonLeft = case _inventoryMode (_uvWorld w) of + CombineInventory mi -> Just $ fromMaybe w $ do -- ugly + i <- mi + return $ over uvWorld (doCombine i) w + _ -> Just w | otherwise = Just w +doCombine :: Int -> World -> World +doCombine i w = case combineItemListYou w !? i of + Nothing -> w + Just (is,it) -> enterCombineInv + . uncurry (putItemInInvID yid) + . copyItemToFloorID (_crPos $ you w) it + $ foldr (rmInvItem yid) w is & enterCombineInv + where + yid = _yourID w + handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe handleMouseWheelEvent mwev w = case _menuLayers w of [] -> case mouseWheelEventPos mwev of @@ -117,14 +137,29 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w | rbDown -> w & changeTweakParam yi | otherwise -> w & moveTweakSel yi + (_, CombineInventory _) -> w + & inventoryMode . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) (_, _) -> w where + numcombs = length $ combineListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations w) + 1 rbDown = ButtonRight `S.member` _mouseButtons w lbDown = ButtonLeft `S.member` _mouseButtons w invKeyDown = ScancodeCapsLock `S.member` _keys w +-- nice idea, but the chain of setters and getters seems prohibitive +--scrollOver :: Foldable t +-- => ASetter s s Int Int -- index setter +-- -> Getting (First (t a)) s (t a) -- pointer to object of size +-- -> Float -- direction +-- -> s -> s +--scrollOver theset theget y w = case w ^? theget of +-- Just t -> w & theset %~ ( (`mod` length t) . (subtract y')) +-- Nothing -> w +-- where +-- y' = round $ signum y + moveTweakSel :: Int -> World -> World moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index f3c61caa2..8728dcaa1 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -3,6 +3,7 @@ module Dodge.Event.Keyboard ( handleKeyboardEvent ) where import Dodge.Data +import Dodge.Combine import Dodge.Save import Dodge.Base import Dodge.Reloading @@ -50,7 +51,7 @@ handlePressedKeyInGame scode w = case scode of ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w ScancodeT -> Just $ testEvent w ScancodeX -> Just $ w & inventoryMode %~ toggleInv TweakInventory - ScancodeC -> Just $ w & inventoryMode %~ toggleInv CombineInventory + ScancodeC -> Just $ toggleCombineInv w ScancodeI -> Just $ w & inventoryMode %~ toggleInv InspectInventory _ -> Just w diff --git a/src/Dodge/FloorItem.hs b/src/Dodge/FloorItem.hs index b3045cc37..59b9b6cda 100644 --- a/src/Dodge/FloorItem.hs +++ b/src/Dodge/FloorItem.hs @@ -1,5 +1,6 @@ module Dodge.FloorItem (copyItemToFloor + ,copyItemToFloorID ) where import Dodge.Data import Dodge.Base @@ -12,7 +13,11 @@ import Data.Maybe {- | Copy an item to the floor. -} copyItemToFloor :: Point2 -> Item -> World -> World -copyItemToFloor pos it w = w' +copyItemToFloor pos it = snd . copyItemToFloorID pos it + +{- | Copy an item to the floor, returns the floor item's id. -} +copyItemToFloorID :: Point2 -> Item -> World -> (Int, World) +copyItemToFloorID pos it w = (,) flid $ w' & floorItems %~ IM.insert flid theflit & updateLocation where diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index be5a69641..b86c04432 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -19,6 +19,7 @@ module Dodge.Inventory where import Dodge.Data import Dodge.Inventory.CloseObject +import Dodge.Inventory.CheckSlots import Dodge.Base import Dodge.Base.Collide import Geometry @@ -32,25 +33,6 @@ import Data.Maybe --import System.Random import Control.Lens --- | checks whether or not an item will fit in your inventory --- if so return Just the next slot to be used -checkInvSlotsYou :: Item -> World -> Maybe Int -checkInvSlotsYou it w - | crNumFreeSlots ycr >= _itInvSize it - = Just $ maybe 0 ((+1) . fst) $ IM.lookupMax inv - | otherwise = Nothing - where - ycr = you w - inv = _crInv ycr - -crNumFreeSlots :: Creature -> Int -crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr) - -crInvSize :: Creature -> Int -crInvSize = invSize . _crInv - -invSize :: IM.IntMap Item -> Int -invSize = sum . fmap _itInvSize -- | after this the item at the inventory position will no longer exist rmInvItem :: Int -- ^ Creature id @@ -87,6 +69,7 @@ closeObjectSize e = case e of Left flit -> _itInvSize $ _flIt flit Right _ -> 1 + selNumPos :: Int -> World -> Int selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w)) where diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 2f791e074..62118131d 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -125,8 +125,31 @@ bangStick = defaultGun } , _itTweaks = defaultBulletSelTweak } +bangCane,bangRod :: Item bangCane = bangStick + { _itParams = BulletShooter + { _muzVel = 0.8 + , _rifling = 0.9 + , _bore = 2 + , _gunBarrels = SingleBarrel 0.05 + } + , _itFloorPict = autoGunPic + } & itUse . useAim . aimSpeed .~ 0.4 + & itUse . useAim . aimRange .~ 1 + & itUse . useAim . aimStance .~ TwoHandTwist + & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5} bangRod = bangCane + { _itParams = BulletShooter + { _muzVel = 0.8 + , _rifling = 1 + , _bore = 2 + , _gunBarrels = SingleBarrel 0.05 + } + , _itFloorPict = longGunSPic + } & itUse . useAim . aimSpeed .~ 0.2 + & itUse . useAim . aimRange .~ 1 + & itUse . useAim . aimStance .~ TwoHandTwist + & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5} pistol :: Item pistol = defaultGun diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index d5166c0b9..6f773ace6 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -4,15 +4,17 @@ module Dodge.Render.HUD ) where import Dodge.Data import Dodge.WinScale +import Dodge.Combine import Dodge.Base import Dodge.Base.Window -import Dodge.Combine.Combinations +--import Dodge.Combine.Combinations import Dodge.Inventory import Dodge.Render.Connectors import Dodge.Render.List import Picture import Geometry import Padding +import ListHelp --import Data.Foldable import Data.Maybe @@ -20,6 +22,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Set as S import Control.Lens import SDL (MouseButton (..)) +--import Data.List --import Data.Bifunctor hudDrawings :: Configuration -> World -> Picture @@ -35,7 +38,8 @@ subInventoryDisplay :: Configuration -> World -> Picture subInventoryDisplay cfig w = case _inventoryMode w of LockedInventory -> mempty -- topInvCursor col cursPos cfig w TopInventory -> pictures - [ --closeObjectTexts cfig w + [ --closeObjectTexts cfig w + selcursor ] TweakInventory -> pictures [ mCurs it cfig w @@ -43,9 +47,17 @@ subInventoryDisplay cfig w = case _inventoryMode w of , cursorsZ cfig cursPos it , displayMidList cfig (ammoTweakStrings it) "TWEAK" ] - CombineInventory -> - displayMidList cfig (combineListStrings w) "COMBINE" --- invHead cfig "COMBINE" + CombineInventory mi -> pictures + [ invHead cfig "COMBINE" + , listTextPicturesAt 150 60 cfig $ map text $ combineListStrings w + , fromMaybe mempty $ do + i <- mi + return $ listCursorAt 150 60 cfig i white 10 1 + , fromMaybe mempty $ do + i <- mi + lnks <- combineListLnks w !? i + return $ uncurry (lnkMidPosInvSels cfig w) lnks + ] InspectInventory -> invHead cfig "INSPECT" where itCol = fromMaybe (greyN 0.5) . (^? _Just . itInvColor) @@ -53,6 +65,24 @@ subInventoryDisplay cfig w = case _inventoryMode w of it = yourItem w col = itCol it cursPos = invSelPos w + selcursor + | IM.null inv && null (_closeObjects w) = mempty + | otherwise = listCursorAt 0 0 cfig curpos white curx cury + inv = _crInv cr + curpos = invSelPos w + curx = 10 + cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w) + cr = _creatures w IM.! 0 + +lnkMidPosInvSels :: Configuration -> World -> Int -> [Int] -> Picture +lnkMidPosInvSels cfig w i is = winScale cfig . color white + . concatMap + (zConnect rp) $ map (lp . flip selNumPos w) is + where + lp ipos = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)) + rp = (V2 (155 - hw) ( hh - (20 * fromIntegral i + 77.5))) + hh = halfHeight cfig + hw = halfWidth cfig cursorsZ :: Configuration -> Int -> Maybe Item -> Picture cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of @@ -64,8 +94,12 @@ cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of hw = halfWidth cfig sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)) + combineListStrings :: World -> [String] -combineListStrings = map (show . snd) . combineList . fmap _itCombineType . yourInv +combineListStrings = map (show . snd) . combineListYou + +combineListLnks :: World -> [(Int,[Int])] +combineListLnks = zip [0..] . map fst . combineListYou ammoTweakStrings :: Maybe Item -> [String] ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of @@ -107,12 +141,8 @@ invHead cfig s = winScale cfig displayInv :: Int -> Configuration -> World -> Picture displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist <> equipcursor - <> selcursor <> closeobjectcursor where - selcursor - | IM.null inv && null (_closeObjects w) = mempty - | otherwise = listCursorAt 0 0 cfig curpos white curx cury closeobjectcursor = case selectedCloseObject w of Nothing -> mempty Just (i,_) -> listCursorAt 50 0 cfig (selNumPos i w) blue 15 (invSelSize i w) @@ -124,9 +154,9 @@ displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist 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 = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w) + --curpos = invSelPos w + --curx = 10 + --cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w) equipcursor = case _crLeftInvSel cr of Nothing -> mempty Just invid -> openCursorAt 20 yellow 0 0 (selNumPos invid w) cfig diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 72b89e697..f1530f977 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -35,14 +35,14 @@ listCursorAt xoff yoff cfig yint col cursxsize cursysize = winScale cfig listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture listTextPictureAt xoff yoff cfig yint = winScale cfig - . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1))) + . translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint+1))) . scale 0.1 0.1 where hw = halfWidth cfig hh = halfHeight cfig renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture -renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str) +renderListAt tx ty cfig = listTextPicturesAt tx (negate ty) cfig . map (\(str,col) -> color col $ text str) -- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..] --TODO put the following functions in an appropriate place diff --git a/src/ListHelp.hs b/src/ListHelp.hs index aa062f13b..eee1e3135 100644 --- a/src/ListHelp.hs +++ b/src/ListHelp.hs @@ -3,6 +3,7 @@ module ListHelp ,initOrNull , insertOver , swapIndices + , (!?) )where import Data.List @@ -15,3 +16,18 @@ insertOver i x xs = take i xs ++ x : drop (i+1) xs swapIndices :: Int -> Int -> [a] -> [a] swapIndices i j xs = insertOver i (xs !! j) . insertOver j (xs !! i) $ xs + +--copied from Data.List.Extra: +-- | A total variant of the list index function `(!!)`. +-- +-- > [2,3,4] !? 1 == Just 3 +-- > [2,3,4] !? (-1) == Nothing +-- > [] !? 0 == Nothing +(!?) :: [a] -> Int -> Maybe a +xs !? n + | n < 0 = Nothing + -- Definition adapted from GHC.List + | otherwise = foldr (\x r k -> case k of + 0 -> Just x + _ -> r (k-1)) (const Nothing) xs n +{-# INLINABLE (!?) #-}