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

Delete cruft, add Reader monad to some internal ai

Browse Source
This commit is contained in:
jgk
2021-05-16 21:42:11 +02:00
parent 0798cc0b0e
commit d7fcdbf550
69 changed files with 721 additions and 2894 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory.hs
+25 -30
View File
@@ -2,30 +2,27 @@ module Dodge.Inventory
where
import Dodge.Data
import Dodge.Base
--import Dodge.SoundLogic
import Geometry
import Data.Maybe
import Data.List
import Data.Function (on)
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Lens
checkInvSlotsYou' :: Maybe Item -> World -> Maybe Int
checkInvSlotsYou' it w = fmap fst $ find cond invListSelFirst
where cond (_,NoItem) = True
cond (_,it' ) = itNotFull it' && fmap _itName it == Just (_itName it')
youCr = you w
youSel = _crInvSel youCr
invList = _crInv youCr
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
checkInvSlotsYou' it w = fst <$> find cond invListSelFirst
where
cond (_,NoItem) = True
cond (_,it' ) = itNotFull it' && fmap _itName it == Just (_itName it')
youCr = you w
youSel = _crInvSel youCr
invList = _crInv youCr
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst
checkInvSlotsYou it w = fst <$> find cond invListSelFirst
where
cond (_,NoItem) = True
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
@@ -36,8 +33,9 @@ checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst
checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
checkInvSlots it its = fmap fst $ find cond $ IM.toList its
where cond (_,NoItem) = True
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
where
cond (_,NoItem) = True
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
addItem :: Item -> Item -> Item
addItem it NoItem = it
@@ -57,7 +55,7 @@ rmInvItem
rmInvItem n i w =
let item = _crInv (_creatures w IM.! n) IM.! i
itRef = creatures . ix n . crInv . ix i
in case item of
in case item of
Consumable {_itAmount = 1} -> set itRef NoItem w
Craftable {_itAmount = 1} -> set itRef NoItem w
Equipment {_itAmount = 1} -> set itRef NoItem w
@@ -67,28 +65,25 @@ rmInvItem n i w =
Equipment {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
Throwable {_itAmount = x} -> over (itRef . itAmount) (\y-> y-1) w
_ -> set itRef NoItem w
{-
Delete a creature's selected item, the item will no longer exist.
-}
{- Delete a creature's selected item, the item will no longer exist. -}
rmSelectedInvItem
:: Int -- ^ Creature id
-> World
-> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
-- for now, left are floor items, right are buttons
closestActiveObject :: World -> Maybe (Either FloorItem Button)
closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ actObjs
where ypos = _crPos $ you w
actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w)
$ map Left (IM.elems $ _floorItems w) ++ activeButtons -- map Right (IM.elems $ _buttons w)
pos (Right x) = _btPos x
pos (Left x) = _flItPos x
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
. IM.elems
$ _buttons w
closestActiveObject w = listToMaybe $ sortOn (dist ypos . pos) actObjs
where
ypos = _crPos $ you w
actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w)
$ map Left (IM.elems $ _floorItems w) ++ activeButtons -- map Right (IM.elems $ _buttons w)
pos (Right x) = _btPos x
pos (Left x) = _flItPos x
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
. IM.elems
$ _buttons w
updateCloseObjects :: World -> World
updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered currentClose