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

src/Dodge/Creature/ArmourChase.hs

@@ -5,7 +5,6 @@ module Dodge.Creature.ArmourChase
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.State
-import Dodge.Creature.State.Data
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.Picture

src/Dodge/Creature/Boid.hs

@@ -2,7 +2,6 @@ module Dodge.Creature.Boid
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Creature.State.Data
 import Geometry
 import Geometry.ConvexPoly
 

src/Dodge/Creature/ChaseCrit.hs

@@ -10,7 +10,6 @@ import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Creature.Perception
 import Dodge.Creature.State
-import Dodge.Creature.State.Data
 import Dodge.Item.Consumable
 import Dodge.Picture.Layer
 import Dodge.SoundLogic

src/Dodge/Creature/ChooseTarget.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.ChooseTarget
 import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Collide
-import Dodge.Creature.Perception.Data
 
 import Control.Lens
 --import qualified Data.IntMap.Strict as IM

src/Dodge/Creature/Impulse.hs

@@ -4,12 +4,8 @@ module Dodge.Creature.Impulse
     where
 import Dodge.Data
 import Dodge.Creature.Vocalization
-import Dodge.Data.SoundOrigin
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Impulse.UseItem
---import Dodge.Creature.Action.UseItem
-import Dodge.Creature.State.Data
-import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
 import Geometry
 

src/Dodge/Creature/Impulse/Movement.hs

@@ -1,8 +1,5 @@
-module Dodge.Creature.Impulse.Movement
-    where
+module Dodge.Creature.Impulse.Movement where
 import Dodge.Data
-import Dodge.Creature.Stance.Data
-import Dodge.Item.Data
 import Geometry
 
 import Data.Maybe

src/Dodge/Creature/Inanimate.hs

@@ -12,7 +12,6 @@ import Dodge.Data
 import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
-import Dodge.Creature.State.Data
 import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.Creature.State
@@ -29,7 +28,6 @@ import Polyhedra
 import Shape
 import Dodge.WorldEvent
 import Dodge.SoundLogic
-import Dodge.Data.SoundOrigin
 
 import System.Random
 import Data.List

src/Dodge/Creature/Perception.hs

@@ -5,9 +5,7 @@ module Dodge.Creature.Perception
     )
     where
 import Dodge.Data
-import Dodge.Creature.Perception.Data
 import Dodge.Creature.Vocalization
-import Dodge.Creature.Memory.Data
 import Dodge.Base.Collide
 --import Dodge.SoundLogic
 import Geometry.Vector

src/Dodge/Creature/Picture.hs

@@ -10,18 +10,10 @@ module Dodge.Creature.Picture
     , picAtCrPosNoRot
     ) where
 import Dodge.Data
-import Dodge.Config.Data
---import Dodge.Data.DamageType
 --import Dodge.Base
---import Dodge.Creature.Stance.Data
-import Dodge.Creature.Perception.Data
---import Dodge.Creature.State.Data
-import Dodge.Creature.Stance.Data
---import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
 --import Dodge.Creature.AlertLevel.Data
 --import Dodge.Picture.Layer
-import Dodge.Item.Data
 import Dodge.Clock
 import Picture
 import Geometry
@@ -58,13 +50,14 @@ basicCrShape
     :: Color    -- ^ Creature color
     -> Creature 
     -> Shape
-basicCrShape col cr = tr $ mconcat
+basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
     [ rotdir . _spShape $ drawEquipment cr
     , rotdir . dm . translateSHz 20 $ scalp cr
     , rotdir . dm $ upperBody col cr
     , dm . rotmdir $ feet cr
     ]
   where 
+    crsize = 0.1 * _crRad cr
     dm = damageModSH cr
     tr = uncurryV translateSHf (_crPos cr)
     rotdir = rotateSH (_crDir cr)
@@ -161,7 +154,7 @@ arms :: Creature -> Shape
 {-# INLINE arms #-}
 arms cr 
     | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-    | twists cr = shoulderSH . translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat 
+    | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat 
         [ translateSHf 12 4    aHand
         , translateSHf 4 (-10) aHand
         ]
@@ -175,7 +168,6 @@ arms cr
     --crIt = _crInv cr IM.! _crInvSel cr
     aHand :: Shape
     aHand = translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
-    crad = _crRad cr
     off = 8
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -183,12 +175,11 @@ arms cr
 scalp :: Creature -> Shape
 {-# INLINE scalp #-}
 scalp cr
-    | twists cr = translateSHf 0 (0.5*crad) . rotateSH (-1) $ translateSHf (negate 0.25 * crad) 0.25 fhead
-    | oneH   cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead
-    | otherwise = translateSHf (0.25 * crad) 0 fhead
+    | twists cr = translateSHf 0 5 . rotateSH (-1) $ translateSHf (negate 2.5) 0.25 fhead
+    | oneH   cr = rotateSH 0.5 $ translateSHf 2.5 0 fhead
+    | otherwise = translateSHf 2.5 0 fhead
   where
-    fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 . polyCirc 4 $ crad * 0.5
-    crad = _crRad cr
+    fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 4 5
 
 oneH :: Creature -> Bool
 oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
@@ -212,7 +203,7 @@ torso cr
         [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
         , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
         ]
-    | twists cr = translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat
+    | twists cr = translateSHf 0 5 . rotateSH (-1) $ mconcat
         [ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
         , rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
         ]
@@ -222,8 +213,7 @@ torso cr
         ]
   where
     --aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad
-    aShoulder = scaleSH (V3 crad crad 1) baseShoulder
-    crad = _crRad cr
+    aShoulder = scaleSH (V3 10 10 1) baseShoulder
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}

src/Dodge/Creature/Property.hs

@@ -4,7 +4,6 @@ module Dodge.Creature.Property
     , crNearPoint
     ) where
 import Dodge.Data
-import Dodge.Item.Data
 import Geometry
 
 import Control.Lens

src/Dodge/Creature/ReaderUpdate.hs

@@ -14,11 +14,8 @@ module Dodge.Creature.ReaderUpdate
     )
     where
 import Dodge.Data
-import Dodge.Creature.Stance.Data
-import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
-import Dodge.Creature.Perception.Data
 import Dodge.Base
 import Dodge.Base.Collide
 import Geometry

src/Dodge/Creature/SetTarget.hs

@@ -1,10 +1,6 @@
-{- |
-Deals with setting a target for creatures
--}
-module Dodge.Creature.SetTarget
-    where
+{- | Deals with setting a target for creatures -}
+module Dodge.Creature.SetTarget where
 import Dodge.Data
-import Dodge.Creature.Perception.Data
 
 import Control.Lens
 import qualified Data.IntMap.Strict as IM

src/Dodge/Creature/State.hs

@@ -3,11 +3,7 @@ module Dodge.Creature.State
     , doDamage
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Item.Data
-import Dodge.Creature.State.Data
 import Dodge.Creature.State.WalkCycle
-import Dodge.Creature.Stance.Data
 --import Dodge.Creature.Test
 --import Dodge.Base
 import Dodge.SoundLogic

src/Dodge/Creature/State/WalkCycle.hs

@@ -4,8 +4,6 @@ module Dodge.Creature.State.WalkCycle
     )
     where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
 import Geometry.Data
 import Sound.Data

src/Dodge/Creature/SwarmCrit.hs

@@ -10,7 +10,6 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.Impulse
 import Dodge.Creature.State
-import Dodge.Creature.State.Data
 import Dodge.Picture.Layer
 import Picture
 

src/Dodge/Creature/Test.hs

@@ -19,7 +19,6 @@ module Dodge.Creature.Test
     where
 import Dodge.Data
 import Dodge.Base.Collide
-import Dodge.Creature.Stance.Data
 import Geometry
 import SameConstr
 

src/Dodge/Creature/Volition.hs

@@ -9,7 +9,6 @@ module Dodge.Creature.Volition
 import Dodge.Data
 --import Dodge.Base.Collide
 import Dodge.Creature.Test
-import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic.LoadSound
 import Geometry
 

src/Dodge/Creature/YourControl.hs

@@ -3,10 +3,8 @@ module Dodge.Creature.YourControl
     ) where
 import Dodge.Data
 import Dodge.Creature.Impulse.Movement
-import Dodge.Creature.Stance.Data
 import Dodge.Update.UsingInput
 import Dodge.Config.KeyConfig
-import Dodge.Item.Attachment.Data
 import Geometry
 
 import Control.Lens
@@ -24,7 +22,7 @@ yourControl cr w =
     , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
     )
   where 
-    speed = 4
+    speed = _mvSpeed $ _crMvType cr
 {- | Turn key presses into creature movement.  -}
 wasdWithAiming 
     :: World