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

Tweak inventory management

Browse Source
This commit is contained in:
justin
2021-12-01 01:55:20 +00:00
parent 0ed260c9b7
commit b9e4a80a46
12 changed files with 138 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+4 -11
View File
@@ -4,6 +4,9 @@
Basic helpers. Basic helpers.
Consider splitting. -} Consider splitting. -}
module Dodge.Base module Dodge.Base
( module Dodge.Base
, module Dodge.Base.You
)
where where
import Dodge.Data import Dodge.Data
import Dodge.WinScale import Dodge.WinScale
@@ -14,6 +17,7 @@ import Geometry
--import Picture --import Picture
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import FoldableHelp import FoldableHelp
import Dodge.Base.You
import Control.Lens import Control.Lens
import qualified Control.Foldl as L import qualified Control.Foldl as L
@@ -42,20 +46,9 @@ errorHead :: String -> [a] -> a
errorHead _ (x:_) = x errorHead _ (x:_) = x
errorHead s [] = error s errorHead s [] = error s
you :: World -> Creature
you w = _creatures w IM.! _yourID w
aCrPos :: Int -> World -> Point2 aCrPos :: Int -> World -> Point2
aCrPos i w = _crPos $ _creatures w IM.! i aCrPos i w = _crPos $ _creatures w IM.! i
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 :: World -> Maybe (Either FloorItem Button)
selectedObject w = lookup (_crInvSel ycr) $ zip [n..] $ _closeObjects w selectedObject w = lookup (_crInvSel ycr) $ zip [n..] $ _closeObjects w
src/Dodge/Base/You.hs
+17
View File
@@ -0,0 +1,17 @@
module Dodge.Base.You where
import Dodge.Data
--import Picture
import qualified IntMapHelp as IM
--import Control.Lens
you :: World -> Creature
you w = _creatures w IM.! _yourID 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)
src/Dodge/Debug/Terminal.hs
+1
View File
@@ -8,6 +8,7 @@ import Control.Lens
applyTerminalString :: String -> Universe -> Universe applyTerminalString :: String -> Universe -> Universe
applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not
applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory
& uvWorld . creatures . ix 0 . crInvCapacity .~ 50
applyTerminalString "LM" w = applyTerminalString "LOADME" w applyTerminalString "LM" w = applyTerminalString "LOADME" w
applyTerminalString _ w = w applyTerminalString _ w = w
src/Dodge/Event.hs
+3 -3
View File
@@ -110,11 +110,11 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
Nothing -> closeObjScrollDir y w Nothing -> closeObjScrollDir y w
Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
| lbDown -> w & cameraZoom +~ y | lbDown -> w & cameraZoom +~ y
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvPos yi w | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeInvCloseObjectsPos yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
(_, TweakInventory) (_, TweakInventory)
| invKeyDown && rbDown -> w & moveTweakSel yi | invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvPos yi w | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| rbDown -> w & changeTweakParam yi | rbDown -> w & changeTweakParam yi
| otherwise -> w & moveTweakSel yi | otherwise -> w & moveTweakSel yi
(_, _) -> w (_, _) -> w
src/Dodge/Event/Keyboard.hs
+6 -4
View File
@@ -9,6 +9,7 @@ import Dodge.Creature.Action
import Dodge.Event.Test import Dodge.Event.Test
import Dodge.Event.Menu import Dodge.Event.Menu
import Dodge.Menu import Dodge.Menu
import Dodge.Inventory
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import SDL import SDL
@@ -65,13 +66,14 @@ gotoTerminal w = case _menuLayers w of
spaceAction :: World -> World spaceAction :: World -> World
spaceAction w = if _carteDisplay w spaceAction w = if _carteDisplay w
then w & carteCenter .~ theLoc then w & carteCenter .~ theLoc
else case (_inventoryMode w, listToMaybe $ _closeObjects w) of else case (_inventoryMode w, selectedCloseObject w) of
(TopInventory,Just (Left flit)) -> pickUpItem 0 flit w (TopInventory,(Just (_,Left flit))) -> pickUpItem 0 flit w
(TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w --(TopInventory,(Just (_,Right but))) -> updateTopCloseObject (_btID but) $ _btEvent but but w
(TopInventory,(Just (_,Right but))) -> _btEvent but but w
_ -> w & inventoryMode .~ TopInventory _ -> w & inventoryMode .~ TopInventory
where where
theLoc = fst (_seenLocations w IM.! _selLocation w) w theLoc = fst (_seenLocations w IM.! _selLocation w) w
updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
pauseGame :: World -> World pauseGame :: World -> World
pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu])) pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu]))
src/Dodge/Inventory.hs
+36 -55
View File
@@ -8,16 +8,17 @@ module Dodge.Inventory
, rmInvItem , rmInvItem
, updateCloseObjects , updateCloseObjects
, closeObjScrollDir , closeObjScrollDir
, swapInvDir -- , swapInvDir
, changeInvPos , changeInvSel
, changeSwapInvPos , changeSwapInvSel
, changeInvCloseObjectsPos , changeAugInvSel
, crNumFreeSlots , crNumFreeSlots
, crInvSize , crInvSize
, selectedCloseObject , selectedCloseObject
) )
where where
import Dodge.Data import Dodge.Data
import Dodge.Inventory.CloseObject
import Dodge.Base import Dodge.Base
import Dodge.Base.Collide import Dodge.Base.Collide
import Geometry import Geometry
@@ -41,7 +42,6 @@ checkInvSlotsYou it w
where where
ycr = you w ycr = you w
inv = _crInv ycr inv = _crInv ycr
-- curinvsize = invSize inv
crNumFreeSlots :: Creature -> Int crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr) crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
@@ -52,6 +52,7 @@ crInvSize = invSize . _crInv
invSize :: IM.IntMap Item -> Int invSize :: IM.IntMap Item -> Int
invSize = sum . fmap _itInvSize invSize = sum . fmap _itInvSize
-- | after this the item at the inventory position will no longer exist
rmInvItem :: Int -- ^ Creature id rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position -> Int -- ^ Inventory position
-> World -> World -> World -> World
@@ -66,16 +67,17 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmou
in xs `IM.union` IM.mapKeys (subtract 1) ys in xs `IM.union` IM.mapKeys (subtract 1) ys
g x | x > invid || Just x == maxk = max 0 $ x - 1 g x | x > invid || Just x == maxk = max 0 $ x - 1
| otherwise = x | otherwise = x
{- Delete a creature's selected item, the item will no longer exist. -}
rmSelectedInvItem rmSelectedInvItem :: Int -> World -> World
:: Int -- ^ Creature id
-> World
-> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w) augmentedInvSizes = bimapAugmentInv _itInvSize closeObjectSize
(IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w)
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
(fmap f $ yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
invSelSize :: Int -> World -> Int invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
@@ -89,7 +91,7 @@ selNumPos :: Int -> World -> Int
selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w)) selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w))
where where
splitgap splitgap
| yourInvSel w < length (yourInv w) = 0 | i < length (yourInv w) = 0
| otherwise = 1 | otherwise = 1
invSelPos :: World -> Int invSelPos :: World -> Int
@@ -100,28 +102,23 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
| yourInvSel w < length (yourInv w) = 0 | yourInvSel w < length (yourInv w) = 0
| otherwise = 1 | otherwise = 1
-- this looks ugly...
updateCloseObjects :: World -> World updateCloseObjects :: World -> World
updateCloseObjects w = w & closeObjects .~ unionBy eTest oldCloseFiltered currentClose updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix 0 . crInvSel %~ updateinvsel & creatures . ix (_yourID w) . crInvSel %~ updateinvsel
where where
updateinvsel curinvsel updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1 | length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1
| otherwise = curinvsel | otherwise = curinvsel
filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
ypos = _crPos $ you w ypos = _crPos $ you w
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
activeButtons = map Right activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState) . filter ( (/=) BtNoLabel . _btState)
. IM.elems . IM.elems
$ _buttons w $ _buttons w
pos (Right x) = _btPos x currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
pos (Left x) = _flItPos x
eTest (Right x) (Right y) = _btID x == _btID y
eTest (Left x) (Left y) = _flItID x == _flItID y
eTest _ _ = False
currentClose = filt objs
oldClose = filt $ _closeObjects w oldClose = filt $ _closeObjects w
oldCloseFiltered = intersectBy eTest oldClose currentClose oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
closeObjScrollDir :: Float -> World -> World closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x closeObjScrollDir x
@@ -129,43 +126,27 @@ closeObjScrollDir x
| x < 0 = over closeObjects rotD | x < 0 = over closeObjects rotD
| otherwise = id | otherwise = id
swapInvDir :: Int -> World -> World changeInvSel :: Int -> World -> World
swapInvDir k w changeInvSel i w
| n == 0 = w
| i < n = w & creatures . ix (_yourID w) %~ updatecreature
| otherwise = w
where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
swapi = (i + k) `mod` n
updateLeftInvSel li | i == li = swapi
| swapi == li = i
| otherwise = li
i = _crInvSel $ you w
n = length $ _crInv $ _creatures w IM.! _yourID w
--numCO = length $ _closeObjects w
changeInvPos :: Int -> World -> World
changeInvPos i w
| n == 0 = w | n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i | yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n)) | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
-- arguably this should jump the invpos into the inventory proper
where where
n = length $ _crInv $ _creatures w IM.! _yourID w n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w numCO = length $ _closeObjects w
changeSwapInvPos :: Int -> World -> World changeSwapInvSel :: Int -> World -> World
changeSwapInvPos k w changeSwapInvSel k w
| n == 0 = w | n == 0 = w
| yourInvSel w < n = w | yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature & creatures . ix (_yourID w) %~ updatecreature
& creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract k
-- | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (k+n))
| otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico' | otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
& closeObjects %~ listSwapIndices (i - n) (ico' - n) & closeObjects %~ swapIndices (i - n) (ico' - n)
where where
updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi ) updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel) . (crLeftInvSel . _Just %~ updateLeftInvSel)
. (crInvSel %~ (`mod` n) . subtract k)
swapi = (i - k) `mod` n swapi = (i - k) `mod` n
updateLeftInvSel li | i == li = swapi updateLeftInvSel li | i == li = swapi
| swapi == li = i | swapi == li = i
@@ -175,18 +156,19 @@ changeSwapInvPos k w
n = length $ _crInv $ _creatures w IM.! _yourID w n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w numCO = length $ _closeObjects w
listSwapIndices :: Int -> Int -> [a] -> [a] changeAugInvSel :: Int -> World -> World
listSwapIndices i j xs = insertOver i (xs !! j) . insertOver j (xs !! i) $ xs changeAugInvSel i w
changeInvCloseObjectsPos :: Int -> World -> World
changeInvCloseObjectsPos i w
| n == 0 = w | n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
where where
n = (length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w) + length (_closeObjects w) n = length (yourInv w) + length (_closeObjects w)
bestCloseObjectIndex :: World -> Maybe Int bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = Nothing bestCloseObjectIndex w = findIndex f $ _closeObjects w
where
f (Right _) = True
f (Left flit) = _itInvSize (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
ycr = you w
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button) selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
selectedCloseObject w selectedCloseObject w
@@ -196,7 +178,6 @@ selectedCloseObject w
invsel = _crInvSel cr invsel = _crInvSel cr
cr = you w cr = you w
inv = _crInv cr inv = _crInv cr
invsize = crInvSize (you w)
selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button) selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n, _closeObjects w !! n) selectNthCloseObject w n = (length (yourInv w) + n, _closeObjects w !! n)
src/Dodge/Inventory/CloseObject.hs
+14
View File
@@ -0,0 +1,14 @@
module Dodge.Inventory.CloseObject where
import Dodge.Data
import Geometry
closeObjPos :: Either FloorItem Button -> Point2
closeObjPos e = case e of
Right x -> _btPos x
Left x -> _flItPos x
closeObjEq :: Either FloorItem Button -> Either FloorItem Button -> Bool
closeObjEq (Right x) (Right y) = _btID x == _btID y
closeObjEq (Left x) (Left y) = _flItID x == _flItID y
closeObjEq _ _ = False
src/Dodge/Item/Weapon/BulletGuns.hs
+12 -3
View File
@@ -14,10 +14,11 @@ module Dodge.Item.Weapon.BulletGuns
import Dodge.Data import Dodge.Data
import Dodge.TweakBullet import Dodge.TweakBullet
import Dodge.Default.Weapon import Dodge.Default.Weapon
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default import Dodge.Default
import Dodge.Item.Attachment import Dodge.Item.Attachment
import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.InventoryDisplay --import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Item.Weapon.AmmoParams import Dodge.Item.Weapon.AmmoParams
import Dodge.Item.Draw import Dodge.Item.Draw
import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.Bullet
@@ -28,6 +29,7 @@ import Geometry
import ShapePicture import ShapePicture
import Shape import Shape
import Data.Maybe
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Control.Lens import Control.Lens
@@ -256,10 +258,17 @@ miniGun = defaultAutoGun
, _itFloorPict = miniGunPictItem , _itFloorPict = miniGunPictItem
, _itEquipPict = pictureWeaponAim miniGunPictItem , _itEquipPict = pictureWeaponAim miniGunPictItem
, _itTweaks = defaultBulletSelTweak , _itTweaks = defaultBulletSelTweak
, _itInvSize = 2 , _itInvSize = 4
, _itInvDisplay = \it -> basicWeaponDisplay it ++ [" COLD"] , _itInvDisplay = \it -> basicWeaponDisplay it ++
["*" ++ replicate 8 ' ' ++ "*"
,"* " ++ fromMaybe " " (maybeWarmupStatus it) ++ " *"
,"*" ++ replicate 8 ' ' ++ "*" ]
-- [" " ++ replicate 8 ch
-- ," " ++ replicate 2 ch ++ fromMaybe " " (maybeWarmupStatus it) ++ replicate 2 ch
-- ," " ++ replicate 8 ch]
} & itDimension . muzzleLength .~ 15 } & itDimension . muzzleLength .~ 15
where where
--ch = '*'
recoilAmount = 5 recoilAmount = 5
[vm1,vm2,vm3,vm4] = [vm1,vm2,vm3,vm4] =
[ 0.25 [ 0.25
src/Dodge/Item/Weapon/InventoryDisplay.hs
+4 -3
View File
@@ -3,6 +3,7 @@ Display of weapon strings in the inventory.
-} -}
module Dodge.Item.Weapon.InventoryDisplay module Dodge.Item.Weapon.InventoryDisplay
( basicWeaponDisplay ( basicWeaponDisplay
, maybeWarmupStatus
) where ) where
import Dodge.Data import Dodge.Data
import Padding import Padding
@@ -26,7 +27,7 @@ basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam]
. listToMaybe . listToMaybe
$ mapMaybe ($ it) $ mapMaybe ($ it)
[ maybeModeStatus [ maybeModeStatus
, maybeWarmupStatus -- , maybeWarmupStatus
, maybeRateStatus , maybeRateStatus
] ]
@@ -45,6 +46,6 @@ maybeWarmupStatus :: Item -> Maybe String
maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
Nothing -> Nothing Nothing -> Nothing
Just m -> case m - (_warmTime . _useDelay $ _itUse it) of Just m -> case m - (_warmTime . _useDelay $ _itUse it) of
x | x <= 1 -> Just " WARM" x | x <= 1 -> Just "WARM"
| otherwise -> let n = show x | otherwise -> let n = show x
in Just $ ' ' : Prelude.take (4 - Prelude.length n) "WARM" ++ n in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n
src/Dodge/Item/Weapon/Launcher.hs
+7
View File
@@ -5,6 +5,7 @@ module Dodge.Item.Weapon.Launcher
import Dodge.Data import Dodge.Data
import Dodge.Default import Dodge.Default
import Dodge.Default.Weapon import Dodge.Default.Weapon
import Dodge.Item.Weapon.InventoryDisplay
import Dodge.Default.Shell import Dodge.Default.Shell
import Dodge.SoundLogic.LoadSound import Dodge.SoundLogic.LoadSound
import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.Explosion
@@ -67,7 +68,13 @@ launcher = defaultGun
{ _tweakSel = 0 { _tweakSel = 0
, _tweakParams = basicAmPjMoves , _tweakParams = basicAmPjMoves
} }
, _itInvSize = 3
, _itInvDisplay = \it -> basicWeaponDisplay it ++
["!" ++ replicate 8 ch ++ "!"
,"!" ++ replicate 8 ch ++ "!"]
} }
where
ch = ' '
defaultShellAmmo :: AmmoType defaultShellAmmo :: AmmoType
defaultShellAmmo = ProjectileAmmo defaultShellAmmo = ProjectileAmmo
src/Dodge/Render/HUD.hs
+29 -29
View File
@@ -13,7 +13,7 @@ import Picture
import Geometry import Geometry
import Padding import Padding
import Data.Foldable --import Data.Foldable
import Data.Maybe import Data.Maybe
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Set as S import qualified Data.Set as S
@@ -174,36 +174,36 @@ mapWall cfig w wl =
c = _wlColor wl c = _wlColor wl
selectedCloseObjectLink :: Configuration -> World -> Picture --selectedCloseObjectLink :: Configuration -> World -> Picture
selectedCloseObjectLink cfig w = mempty --selectedCloseObjectLink cfig w = mempty
{- | Pictures of popup text for items close to your position.-} {- | Pictures of popup text for items close to your position.-}
closeObjectTexts :: Configuration -> World -> Picture --closeObjectTexts :: Configuration -> World -> Picture
closeObjectTexts cfig w = pictures $ --closeObjectTexts cfig w = pictures $
renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w) -- renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
: maybeToList maybeLine -- : maybeToList maybeLine
where -- where
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x) -- colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
colAndText (Right x) = (_btText x,yellow) -- colAndText (Right x) = (_btText x,yellow)
youSel = _crInvSel $ you w -- youSel = _crInvSel $ you w
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w -- freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
invPos = fromMaybe youSel freeSlot -- invPos = fromMaybe youSel freeSlot
mayObj = listToMaybe $ _closeObjects w -- mayObj = listToMaybe $ _closeObjects w
mayIt = mayObj >>= maybeLeft -- mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x -- maybeLeft (Left x) = Just x
maybeLeft _ = Nothing -- maybeLeft _ = Nothing
pushout = 120 -- pushout = 120
objPos obj = case obj of -- objPos obj = case obj of
Left flit -> _flItPos flit -- Left flit -> _flItPos flit
Right bt -> _btPos bt -- Right bt -> _btPos bt
mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj -- mayScreenPos = fmap (worldPosToScreen w . objPos) mayObj
maybeLine = do -- maybeLine = do
itScreenPos <- mayScreenPos -- itScreenPos <- mayScreenPos
(theText,col) <- fmap colAndText mayObj -- (theText,col) <- fmap colAndText mayObj
let textWidth = 9 * fromIntegral (length theText) -- let textWidth = 9 * fromIntegral (length theText)
let p = V2 (textWidth + 15 + pushout - halfWidth cfig) -- let p = V2 (textWidth + 15 + pushout - halfWidth cfig)
( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5) -- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
return . winScale cfig . color col $ lConnect p itScreenPos -- return . winScale cfig . color col $ lConnect p itScreenPos
mainListCursor :: Color -> Int -> Configuration -> Picture mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0 mainListCursor c = openCursorAt 120 c 5 0
src/ListHelp.hs
+4
View File
@@ -2,6 +2,7 @@ module ListHelp
(module Data.List (module Data.List
,initOrNull ,initOrNull
, insertOver , insertOver
, swapIndices
)where )where
import Data.List import Data.List
@@ -11,3 +12,6 @@ initOrNull xs = init xs
insertOver :: Int -> a -> [a] -> [a] insertOver :: Int -> a -> [a] -> [a]
insertOver i x xs = take i xs ++ x : drop (i+1) xs 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