Add shrinkability and cursed items

src/Dodge/Creature/Action.hs

@@ -1,9 +1,14 @@
+{-# LANGUAGE TupleSections #-}
 {- | Actions performed by creatures within the world
  -}
 module Dodge.Creature.Action 
     ( performActionsR
+    , stripNoItems
+    , setMinInvSize
+    , dropUnselected
     , startReloadingWeapon
     , blinkAction
+    , sizeSelf
     , crAutoReload
     , copyItemToFloor
     , youDropItem
@@ -11,10 +16,10 @@ module Dodge.Creature.Action
     )
     where
 import Dodge.Path
+import Dodge.Default
 import Dodge.Creature.Stance.Data
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Base
 import Dodge.Zone
 import Dodge.Base.Collide
@@ -167,15 +172,15 @@ blinkAction
     -> World
 blinkAction cr w 
     = soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
-    . over radDistortion (distortionBulge ++)
+    . over distortions (distortionBulge ++)
     . set (creatures . ix cid . crPos) p3
     . blinkShockwave cid p3
     $ inverseShockwaveAt cpos 40 2 2 w
   where
     distR = 120
     distortionBulge = 
-        [(p3,p3 +.+ V2 distR 0, p3 +.+ V2 0 distR,0.1)
-        ,(cpos,cpos +.+ V2 distR 0, cpos +.+ V2 0 distR,1.9)
+        [RadialDistortion p3   (p3 +.+ V2 distR 0)   (p3 +.+ V2 0 distR)   0.1
+        ,RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
         ]
     cid  = _crID cr
     p1 = mouseWorldPos w
@@ -191,14 +196,35 @@ blinkShockwave
     -> World
 blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan 
 
+setMinInvSize :: Int -> Creature -> World -> World
+setMinInvSize n cr = creatures . ix (_crID cr) . crInv %~ f 
+  where
+    f inv = IM.unionWith (\x _ -> x) inv $ IM.fromList $ [0..n-1] <&> (, NoItem)
+
+stripNoItems :: Creature -> World -> World
+stripNoItems cr = creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f
+  where
+    f NoItem = Nothing
+    f x = Just x
+
+dropUnselected :: Creature -> World -> World
+dropUnselected cr w = foldr (dropItem cr) w . IM.keys $ unselectedItems
+  where
+    unselectedItems = _crInvSel cr `IM.delete` _crInv cr 
+
+dropItem :: Creature -> Int -> World -> World
+dropItem cr invid = rmInvItem cid invid . copyItemToFloor cr invid
+  where
+    cid = _crID cr
+
 {- | Get your creature to drop the item under the cursor.  -}
 youDropItem :: World -> World
-youDropItem w = case yourItem w of
-    NoItem -> w
-    _ -> rmSelectedInvItem (_yourID w) 
+youDropItem w = case yourItem w ^? itCurseStatus of
+    Just Uncursed -> rmSelectedInvItem (_yourID w) 
         . copyItemToFloor (you w) (_crInvSel cr)
         $ soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
         w
+    _ -> w
   where
     cr = you w
 {- | Copy an inventory item to the floor. -}
@@ -243,3 +269,21 @@ pickUpItem cid flit w = case maybeInvSlot of
         Nothing -> w'
         Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
 
+sizeSelf :: Float -> Creature -> World -> World
+sizeSelf x cr w = w
+    & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
+    & over distortions (distortionBulge :)
+--    & inverseShockwaveAt cpos 40 0 2
+    & creatures . ix cid %~ 
+        ( (crRad .~ 10 * x) 
+        . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
+        . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
+        )
+  where
+    distR = 120
+    distortionBulge 
+        | _crRad cr < 10 * x 
+            = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+        | otherwise = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 0.1
+    cid  = _crID cr
+    cpos = _crPos cr