From 052bc8455a99e7f1a90b6c9354e54cff10de02cc Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 23 Dec 2019 12:19:51 -0500 Subject: Add a drop command Add a drop command, bound to 'd', which prompts the character for an item in their inventory, removes it from the inventory, and places it on the ground. Along the way I had to fix a bug in the `EntityMap.atPosition` lens, which was always appending to the existing entities at the position on set, without removing the entities that were already there - the rabbit hole of quickchecking the lens laws here also lead to replacing the target of this lens with a newtype called `VectorBag`, which ignores order (since the entitymap makes no guarantees about order of entities at a given position). --- src/Xanthous/Entities/Character.hs | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'src/Xanthous/Entities/Character.hs') diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 955c94fc77c4..43d4f8a52942 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -27,6 +27,7 @@ module Xanthous.Entities.Character , WieldedItem(..) , wieldedItem , wieldableItem + , asWieldedItem -- * , mkCharacter @@ -68,6 +69,12 @@ data WieldedItem = WieldedItem WieldedItem makeFieldsNoPrefix ''WieldedItem +asWieldedItem :: Prism' Item WieldedItem +asWieldedItem = prism' hither yon + where + yon item = WieldedItem item <$> item ^. itemType . wieldable + hither (WieldedItem item _) = item + instance Brain WieldedItem where step ticks (Positioned p wi) = over positioned (\i -> WieldedItem i $ wi ^. wieldableItem) -- cgit 1.4.1