justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement combining of items

Browse Source
This commit is contained in:
justin
2021-12-03 01:56:23 +00:00
parent 8b8d75b016
commit bebc73882a
13 changed files with 190 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+33 -3
View File
@@ -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)
src/Dodge/Combine/Combinations.hs
-1
View File
@@ -43,4 +43,3 @@ combinations = map (first toMultiset)
, ( [ PIPE, PIPE ] , LONGPIPE )
, ( [ LONGPIPE, PIPE ] , VERYLONGPIPE )
]
src/Dodge/Creature.hs
+5
View File
@@ -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
src/Dodge/Creature/Action.hs
+21 -15
View File
@@ -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
src/Dodge/Data.hs
+2 -1
View File
@@ -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
src/Dodge/Event.hs
+35
View File
@@ -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))
src/Dodge/Event/Keyboard.hs
+2 -1
View File
@@ -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
src/Dodge/FloorItem.hs
+6 -1
View File
@@ -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
src/Dodge/Inventory.hs
+2 -19
View File
@@ -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
src/Dodge/Item/Weapon/BulletGuns.hs
+23
View File
@@ -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
src/Dodge/Render/HUD.hs
+43 -13
View File
@@ -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
src/Dodge/Render/List.hs
+2 -2
View File
@@ -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
src/ListHelp.hs
+16
View File
@@ -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 (!?) #-}