Start moving creature properties out of records

src/Dodge/Corpse/Make.hs

@@ -1,33 +1,39 @@
-module Dodge.Corpse.Make where
+module Dodge.Corpse.Make (makeCorpse) where
-import Dodge.Creature.Picture
-import Dodge.Data.Creature
-import Dodge.Data.Corpse
-import Control.Lens
-import ShapePicture
-import Shape
-import Geometry
 
-makeCorpse :: CreatureCorpse -> Creature -> Corpse
+import Dodge.Creature.Shape
-makeCorpse cc = case cc of
+import Control.Lens
-    MakeDefaultCorpse -> makeDefaultCorpse
+import Dodge.Creature.Picture
+import Dodge.Data.Corpse
+import Dodge.Data.Creature
+import Geometry
+import Shape
+import ShapePicture
+
+makeCorpse :: Creature -> Corpse
+makeCorpse = makeDefaultCorpse
 
 makeDefaultCorpse :: Creature -> Corpse
-makeDefaultCorpse cr = defaultCorpse
+makeDefaultCorpse cr =
+    defaultCorpse
         & cpPos .~ _crPos cr
         & cpDir .~ _crDir cr
-    & cpSPic .~ noPic (scaleSH (V3 crsize crsize crsize) $ mconcat
+        & cpSPic
+            .~ noPic
+                ( scaleSH (V3 crsize crsize crsize) $
+                    mconcat
                         [ colorSH (_skinHead cskin) $ deadScalp cr
                         , colorSH (_skinUpper cskin) $ deadUpperBody cr
                         , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
                         ]
                 )
   where
-    cskin = _crType cr -- this should be fixed
+    cskin = crShape $ _crType cr -- this should be fixed
     crsize = 0.1 * _crRad cr
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
 defaultCorpse :: Corpse
-defaultCorpse = Corpse
+defaultCorpse =
+    Corpse
         { _cpID = 0
         , _cpPos = 0
         , _cpDir = 0

src/Dodge/Creature.hs

@@ -58,28 +58,28 @@ spawnerCrit =
     defaultCreature
         & crHP .~ 300
         & crInv .~ IM.empty
-        & crType . skinUpper .~ lightx4 blue
+--        & crType . skinUpper .~ lightx4 blue
 
 miniGunCrit :: Creature
 miniGunCrit =
     defaultCreature
         & crInv .~ IM.fromList [(0, miniGunX 3)]
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red
-        & crType . humanoidAI .~ MiniGunAI
+--        & crType . humanoidAI .~ MiniGunAI
 
 longCrit :: Creature
 longCrit =
     defaultCreature
         & crInv .~ IM.fromList [(0, sniperRifle)]
-        & crType . humanoidAI .~ LongAI
+--        & crType . humanoidAI .~ LongAI
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red
 
 multGunCrit :: Creature
 multGunCrit =
     defaultCreature
         & crInv .~ IM.fromList [(0, volleyGun 4)]
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red
-        & crType . humanoidAI .~ MultGunAI
+--        & crType . humanoidAI .~ MultGunAI
 
 addArmour :: Creature -> Creature
 addArmour = over crInv insarmour
@@ -100,12 +100,9 @@ startCr =
         & crHP .~ 10000
         & crMaxHP .~ 15000
         & crInv .~ startInventory
-        & crCorpse .~ MakeDefaultCorpse
         & crFaction .~ PlayerFaction
         & crMvType .~ MvWalking yourDefaultSpeed
-        & crType . skinUpper .~ lightx4 black
+        & crType .~ Avatar (PulseStatus 55 0)
-        & crType .~ Avatar 
-            (greyN 0.9) (lightx4 green) (greyN 0.3) (PulseStatus 55 0)
 
 -- | Items you start with.
 startInvList :: [Item]

src/Dodge/Creature/ArmourChase.hs

@@ -32,7 +32,7 @@ flockArmourChaseCrit =
         , _crGroup = ShieldGroup
         , _crMvType = defaultChaseMvType
         }
-        & crType . humanoidAI .~ FlockArmourChaseAI
+--        & crType . humanoidAI .~ FlockArmourChaseAI
 
 armourChaseCrit :: Creature
 armourChaseCrit =

src/Dodge/Creature/AutoCrit.hs

@@ -3,11 +3,11 @@ module Dodge.Creature.AutoCrit (
 ) where
 
 import Dodge.Item.Held.Cane
-import Control.Lens
+--import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
 import qualified IntMapHelp as IM
-import Picture
+--import Picture
 
 autoCrit :: Creature
 autoCrit =
@@ -17,5 +17,5 @@ autoCrit =
         , _crHP = 300
         , _crMvType = defaultAimMvType
         }
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red
-        & crType . humanoidAI .~ AutoAI
+--        & crType . humanoidAI .~ AutoAI

src/Dodge/Creature/ChaseCrit.hs

@@ -18,7 +18,7 @@ smallChaseCrit =
         { _crHP = 1
         , _crRad = 4
         , _crInv = mempty
-        , _crCorpse = MakeDefaultCorpse
+--        , _crCorpse = MakeDefaultCorpse
         }
 
 invisibleChaseCrit :: Creature
@@ -39,7 +39,7 @@ chaseCrit =
         , _crVocalization = chaseCritVocalization
         , _crMvType = defaultChaseMvType
         }
-        & crType . humanoidAI .~ ChaseAI
+--        & crType . humanoidAI .~ ChaseAI
 
 chaseCritVocalization :: Vocalization
 chaseCritVocalization =

src/Dodge/Creature/Impulse/UseItem.hs

@@ -63,9 +63,7 @@ useItemLoc cr loc pt w
     ldt = loc ^. locLDT
     itm = ldt ^. ldtValue . _1
 
-useLocation ::
+useLocation :: LocationLDT ItemLink ComposedItem -> LocationLDT ItemLink ComposedItem
-    LocationLDT ItemLink ComposedItem ->
-    LocationLDT ItemLink ComposedItem
 useLocation loc
     | isJust $ loc ^? locLDT . ldtValue . _1 . itType . ibtEquip = loc
     | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =

src/Dodge/Creature/Inanimate.hs

@@ -18,7 +18,7 @@ barrel :: Creature
 barrel =
     defaultInanimate
         { _crHP = 500
-        , _crType = Barreloid PlainBarrel
+        , _crType = BarrelCrit PlainBarrel
         , _crState =
             defaultState
                 { _csSpState = Barrel []
@@ -30,7 +30,7 @@ explosiveBarrel :: Creature
 explosiveBarrel =
     defaultInanimate
         { _crHP = 400
-        , _crType = Barreloid ExplosiveBarrel
+        , _crType = BarrelCrit ExplosiveBarrel
         , _crState =
             defaultState
                 { _csSpState = Barrel []

src/Dodge/Creature/Lamp.hs

@@ -14,7 +14,7 @@ colorLamp ::
 colorLamp col h =
     defaultInanimate
         { _crHP = 100
-        , _crType = Lampoid h col Nothing
+        , _crType = LampCrit h col Nothing
         , _crRad = 3
         , _crMass = 3
         }

src/Dodge/Creature/LauncherCrit.hs

@@ -3,11 +3,11 @@ module Dodge.Creature.LauncherCrit (
 ) where
 
 import Dodge.Item.Held.Launcher
-import Control.Lens
+--import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
 import qualified IntMapHelp as IM
-import Picture
+--import Picture
 
 launcherCrit :: Creature
 launcherCrit =
@@ -17,5 +17,5 @@ launcherCrit =
         , _crState = defaultState
         , _crHP = 300
         }
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red
-        & crType . humanoidAI .~ LauncherAI
+--        & crType . humanoidAI .~ LauncherAI

src/Dodge/Creature/LtAutoCrit.hs

@@ -2,12 +2,12 @@ module Dodge.Creature.LtAutoCrit (
     ltAutoCrit,
 ) where
 
-import Control.Lens
+--import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
 import Dodge.Item.Held.Stick
 import qualified IntMapHelp as IM
-import Picture
+--import Picture
 
 ltAutoCrit :: Creature
 ltAutoCrit =
@@ -16,5 +16,6 @@ ltAutoCrit =
         , _crRad = 10
         , _crHP = 500
         }
-        & crType . humanoidAI .~ LtAutoAI
+--        & crType .~ LtAutoCrit
-        & crType . skinUpper .~ lightx4 red
+--        & crType . humanoidAI .~ LtAutoAI
+--        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/Picture.hs

@@ -9,6 +9,7 @@ module Dodge.Creature.Picture (
     deadFeet,
 ) where
 
+import Dodge.Creature.Shape
 import Control.Lens
 import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
 import Dodge.Creature.Test
@@ -44,7 +45,7 @@ basicCrShape cr
                 , rotmdir $ colorSH (_skinLower cskin) $ feet cr
                 ]
   where
-    cskin = _crType cr
+    cskin = crShape $ _crType cr
     crsize = 0.1 * _crRad cr
     tr = uncurryV translateSHxy (_crPos cr)
     rotdir = rotateSH (_crDir cr)

src/Dodge/Creature/PistolCrit.hs

@@ -2,12 +2,12 @@ module Dodge.Creature.PistolCrit (
     pistolCrit,
 ) where
 
-import Control.Lens
+--import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
 import Dodge.Item.Held.Stick
 import qualified IntMapHelp as IM
-import Picture
+--import Picture
 
 pistolCrit :: Creature
 pistolCrit =
@@ -16,5 +16,5 @@ pistolCrit =
         , _crRad = 10
         , _crHP = 500
         }
-        & crType . humanoidAI .~ PistolAI
+--        & crType . humanoidAI .~ PistolAI
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/SpreadGunCrit.hs

@@ -2,12 +2,12 @@ module Dodge.Creature.SpreadGunCrit (
     spreadGunCrit,
 ) where
 
-import Control.Lens
+--import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
 import Dodge.Item.Held.Stick
 import qualified IntMapHelp as IM
-import Picture
+--import Picture
 
 spreadGunCrit :: Creature
 spreadGunCrit =
@@ -16,5 +16,5 @@ spreadGunCrit =
         , _crRad = 10
         , _crHP = 500
         }
-        & crType . humanoidAI .~ SpreadGunAI
+--        & crType . humanoidAI .~ SpreadGunAI
-        & crType . skinUpper .~ lightx4 red
+--        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/State.hs

@@ -100,8 +100,8 @@ checkDeath cr w
   where
     removecr
         | _crID cr == 0 =
-            (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
+--            (cWorld . lWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
-                . (cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0)
+                 (cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0)
         -- hack to get around player creature being killed but left with more than 0 hp
         | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
 
@@ -114,7 +114,7 @@ corpseOrGib cr = case cr ^? crState . csDamage . to maxDamageType . _Just . _1 o
     _ | _crPastDamage cr > 200 -> addCrGibs cr
     _ -> plNew (cWorld . lWorld . corpses) cpID thecorpse
   where
-    thecorpse = makeDefaultCorpse cr
+    thecorpse = makeCorpse cr
 
 scorchSPic :: SPic -> SPic
 scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
@@ -190,7 +190,7 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
 
 doAnyEquipmentEffect :: LocationLDT ItemLink ComposedItem -> Creature -> World -> World
 doAnyEquipmentEffect loc cr = case itm ^? itLocation . ilEquipSite . _Just of
-    Just _ -> useE loc cr
+    Just _ -> equipBackgroundEffect loc cr
     _ -> id
   where
     itm = loc ^. locLDT . ldtValue . _1

src/Dodge/Creature/SwarmCrit.hs

@@ -13,12 +13,13 @@ swarmCrit =
         { _crHP = 1
         , _crRad = 2
         , _crMass = 2
-        , _crCorpse = MakeDefaultCorpse
+--        , _crCorpse = MakeDefaultCorpse
         , _crFaction = ColorFaction yellow
         , _crMeleeCooldown = 0
         }
-        & crType . skinUpper .~ lightx4 yellow
+        & crType .~ SwarmCrit
-        & crType . humanoidAI .~ SwarmAI
+--        & crType . skinUpper .~ lightx4 yellow
+--        & crType . humanoidAI .~ SwarmAI
 
 --swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
 --swarmCritMoveFunc tcr cenp cr

src/Dodge/Creature/Update.hs

@@ -14,10 +14,10 @@ updateCreature :: Creature -> World -> World
 updateCreature cr = case _crType cr of
     Avatar{} -> (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse) 
         . crUpdate yourControl cr
-    Lampoid{} -> updateLampoid cr
+    LampCrit{} -> updateLampoid cr
-    Humanoid{} -> updateHumanoid cr
+    BarrelCrit{} -> updateBarreloid cr
-    Barreloid{} -> updateBarreloid cr
+    AvatarDead -> id
-    NonDrawnCreature -> id
+    _ -> updateHumanoid cr
 
 updatePulse :: Pulse -> Pulse
 updatePulse PulseStatus {_pulseRate = pr, _pulseProgress = pp}

src/Dodge/Data/Bullet.hs

@@ -1,11 +1,11 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Bullet 
+module Dodge.Data.Bullet (
-    ( module Dodge.Data.Bullet 
+    module Dodge.Data.Bullet,
-    , module Dodge.Data.Damage
+    module Dodge.Data.Damage,
 ) where
 
 import Control.Lens
@@ -17,18 +17,20 @@ import Geometry.Data
 data Bullet = Bullet
     { _buEffect :: BulletEffect
     , _buPayload :: BulletPayload
---    , _buTrajectory :: BulletTrajectory
+    , --    , _buTrajectory :: BulletTrajectory
-    , _buVel :: Point2
+      _buVel :: Point2
     , _buDrag :: Float
     , _buPos :: Point2
     , _buOldPos :: Point2
     , _buWidth :: Float
---    , _buTimer :: Int
     , _buDamages :: [Damage]
     }
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
-data EnergyBallType = IncBall | TeslaBall | ConcBall
+data EnergyBallType
+    = IncBall
+    | TeslaBall
+    | ConcBall
     | FlashBall
     deriving (Show, Eq, Ord, Enum, Bounded, Read) --Generic, Flat)
 

src/Dodge/Data/Creature.hs

@@ -36,10 +36,8 @@ data Creature = Creature
     { _crPos :: Point2
     , _crOldPos :: Point2
     , _crDir :: Float
-    , _crOldDir :: Float
     , _crMvDir :: Float
     , _crMvAim :: Float
---    , _crTwist :: Float
     , _crType :: CreatureType
     , _crID :: Int
     , _crRad :: Float
@@ -52,7 +50,6 @@ data Creature = Creature
     , _crInvLock :: Bool
     , _crEquipment :: M.Map EquipSite Int
     , _crState :: CreatureState
-    , _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
     , _crMaterial :: Material
     , _crPastDamage :: Int
     , _crStance :: Stance
@@ -70,8 +67,6 @@ data Creature = Creature
     , _crDeathTimer :: Int
     }
 
-data CreatureCorpse = MakeDefaultCorpse
-
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Intention = Intention
@@ -88,7 +83,6 @@ makeLenses ''Intention
 concat
     <$> mapM
         (deriveJSON defaultOptions)
-        [ ''CreatureCorpse
+        [ ''Creature
-        , ''Creature
         , ''Intention
         ]

src/Dodge/Data/Creature/Misc.hs

@@ -68,19 +68,26 @@ data Pulse = PulseStatus
 
 data CreatureType
     = Avatar
-        { _skinHead :: Color
+--        { _skinHead :: Color
-        , _skinUpper :: Color
+--        , _skinUpper :: Color
-        , _skinLower :: Color
+--        , _skinLower :: Color
-        , _avatarPulse :: Pulse
+        { _avatarPulse :: Pulse
         }
-    | Humanoid
+    | AvatarDead
+    | ChaseCrit
+    | SwarmCrit
+    | AutoCrit
+    | BarrelCrit{_barrelType :: BarrelType}
+    | LampCrit {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
+
+data CreatureShape
+    = Humanoid
         { _skinHead :: Color
         , _skinUpper :: Color
         , _skinLower :: Color
         , _humanoidAI :: HumanoidAI
         }
-    | Barreloid {_barrelType :: BarrelType}
+    | Barreloid
-    | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
     | NonDrawnCreature
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Item.hs

@@ -42,7 +42,6 @@ data Item = Item
     , _itType :: ItemType
     , _itID :: NewInt ItmInt
     , _itLocation :: ItemLocation
---    , _itEffect :: ItEffect
     , _itTargeting :: ItemTargeting
     , _itParams :: ItemParams
     , _itScroll :: ItemScroll

src/Dodge/Data/Item/Use.hs

@@ -10,8 +10,10 @@ module Dodge.Data.Item.Use (
     module Dodge.Data.GenFloat,
     module Dodge.Data.Item.Scope,
     module Dodge.Data.Item.BulletMod,
+    module Dodge.Data.Payload
 ) where
 
+import Dodge.Data.Payload
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH

src/Dodge/Data/Item/Use/Consumption/Ammo.hs

@@ -1,26 +1,12 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.Item.Use.Consumption.Ammo (
     module Dodge.Data.Item.Use.Consumption.Ammo,
     module Dodge.Data.Bullet,
-    module Dodge.Data.Payload,
+--    module Dodge.Data.Payload,
 ) where
 
-import Control.Lens
-import Data.Aeson
-import Data.Aeson.TH
 import Dodge.Data.Bullet
-import Dodge.Data.Payload
-
-data ProjectileUpdate
-    = ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
-    | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
-    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
-    deriving (Show, Eq, Ord, Read) --Generic, Flat)
-
 
 data ForceFieldType = DefaultForceField
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -30,11 +16,3 @@ data GasFuel = ChemFuel
 
 data GasCreate = CreatePoisonGas | CreateFlame
     deriving (Eq, Ord, Show, Enum, Bounded, Read) --Generic, Flat)
-
-makeLenses ''ProjectileUpdate
---makeLenses ''AmmoType
-deriveJSON defaultOptions ''GasFuel
-deriveJSON defaultOptions ''ProjectileUpdate
-deriveJSON defaultOptions ''GasCreate
-deriveJSON defaultOptions ''ForceFieldType
---deriveJSON defaultOptions ''AmmoType

src/Dodge/Data/Projectile.hs

@@ -1,21 +1,20 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.Projectile where
 
-import Dodge.Data.Wall.Structure
-import Dodge.Data.Item.Location
-import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.Item.Use.Consumption.Ammo
+import Dodge.Data.Item.Location
+import Dodge.Data.Wall.Structure
 import Geometry.Data
+import NewInt
+import Dodge.Data.Payload
 
-data Projectile
+data Projectile = Shell
-    = Shell
     { _pjPos :: Point2
     , _pjVel :: Point2
     , _pjDir :: Float
@@ -33,10 +32,14 @@ data Projectile
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data ProjectileUpdate
+    = ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
+    | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
+    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
+    deriving (Show, Eq, Ord, Read) --Generic, Flat)
+
 data ProjectileType
-    = Grenade
+    = Grenade { _gnHitEffect :: GrenadeHitEffect }
-        { _gnHitEffect :: GrenadeHitEffect
-        }
     | Rocket
         { _rkHoming :: RocketHoming
         , _rkSmoke :: Maybe RocketSmoke
@@ -61,11 +64,12 @@ data RocketSmoke
     = ReducedRocketSmoke
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
-
+makeLenses ''ProjectileUpdate
 makeLenses ''Projectile
 makeLenses ''ProjectileType
 makeLenses ''RocketHoming
 makeLenses ''GrenadeHitEffect
+deriveJSON defaultOptions ''ProjectileUpdate
 deriveJSON defaultOptions ''GrenadeHitEffect
 deriveJSON defaultOptions ''RocketHoming
 deriveJSON defaultOptions ''RocketSmoke

src/Dodge/Default/Creature.hs

@@ -6,7 +6,7 @@ import Dodge.Data.Creature
 import Dodge.Data.FloatFunction
 import Geometry.Data
 import qualified IntMapHelp as IM
-import Picture
+--import Picture
 --import MaybeHelp
 
 defaultCreature :: Creature
@@ -15,12 +15,11 @@ defaultCreature =
         { _crPos = V2 0 0
         , _crOldPos = V2 0 0
         , _crDir = 0
-        , _crOldDir = 0
         , _crMvDir = 0
         , _crMvAim = 0
 --        , _crTwist = 0
         , _crID = 1
-        , _crType = defaultCreatureSkin
+        , _crType = ChaseCrit
         , _crRad = 10
         , _crMass = 10
         , _crHP = 100
@@ -30,7 +29,7 @@ defaultCreature =
         , _crInvCapacity = 25
         , _crInvLock = False
         , _crState = defaultState
-        , _crCorpse = MakeDefaultCorpse
+--        , _crCorpse = MakeDefaultCorpse
         , _crMaterial = Flesh
         , _crPastDamage = 0
 --        , _crInvEquipped = mempty
@@ -58,8 +57,8 @@ defaultCreature =
         , _crDeathTimer = 0
         }
 
-defaultCreatureSkin :: CreatureType
+--defaultCreatureSkin :: CreatureType
-defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI
+--defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI
 
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate

src/Dodge/Euse.hs

@@ -1,27 +1,19 @@
 module Dodge.Euse (
-    createShieldWall,
+    equipBackgroundEffect,
-    removeShieldWall,
-    useE,
 ) where
 
-import Color
 import Dodge.Creature.HandPos
 import Dodge.Creature.Test
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
-import Dodge.Default.Wall
-import Dodge.Item.HeldOffset
-import Dodge.Item.Location
-import Dodge.Wall.Create
-import Dodge.Wall.Delete
 import Dodge.Wall.Move
 import Geometry
 import LensHelp
 
-useE :: LocationLDT ItemLink ComposedItem -> Creature -> World -> World
+equipBackgroundEffect :: LocationLDT ItemLink ComposedItem -> Creature -> World -> World
-useE loc cr = case eo of
+equipBackgroundEffect loc cr = case eo of
     EQUIP (MAGSHIELD mt) -> useMagShield mt itm cr
     EQUIP WRISTARMOUR -> setWristShieldPos itm cr
     EQUIP HEADLAMP -> createHeadLamp itm cr
@@ -36,8 +28,7 @@ useMagShield mt _ cr w =
     w & cWorld . lWorld . magnets
         .:~ Magnet
             { _mgPos = _crPos cr
-            , --, _mgField = MagnetBuBuCurveAroundField 50 200
+            , _mgField = mt
-              _mgField = mt
             }
 
 setWristShieldPos :: Item -> Creature -> World -> World
@@ -54,19 +45,6 @@ setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
         | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
-shieldWall :: Int -> Wall
-shieldWall crid =
-    defaultWall
-        { _wlColor = yellow
-        , _wlOpacity = SeeAbove
-        , _wlPathable = True
-        , _wlWalkable = True
-        , _wlFireThrough = True
-        , _wlReflect = True
-        , _wlRotateTo = False
-        , _wlStructure = CreaturePart crid -- shieldWallDamage
-        }
-
 -- TODO the reflection should be controled by the particle
 --shieldWallDamage :: Damage -> Wall -> Int -> World -> World
 --shieldWallDamage dm _ crid w = case _dmType dm of
@@ -74,31 +52,6 @@ shieldWall crid =
 --    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
 --    _ -> w
 
-createShieldWall :: Item -> Creature -> World -> World
-createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
-    Nothing ->
-        let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
-         in w' & pointerToItem it . itParams .~ FlatShieldParams (Just wlid)
-    Just wid -> moveWallID wid wlline w
-  where
-    crid = _crID cr
-    wlline = (a, b)
-    crdirv = unitVectorAtAngle $ _crDir cr
-    crpos = _crPos cr
-    rad = _crRad cr + 2
-    a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
-    b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
-    therot
-        | crIsAiming cr = vNormal
-        | otherwise = rotateV (twoFlatHRot cr) . vNormal
-
-removeShieldWall :: Item -> Creature -> World -> World
-removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
-    Nothing -> w
-    Just wid ->
-        w & deleteWallID wid
-            & pointerToItem it . itParams . flatShieldWlMIX .~ Nothing
-
 createHeadLamp :: Item -> Creature -> World -> World
 createHeadLamp _ cr =
     cWorld . lWorld . lights

src/Dodge/Humanoid.hs

@@ -11,8 +11,8 @@ import RandomHelp
 
 
 updateHumanoid :: Creature -> World -> World
-updateHumanoid cr = case cr ^?! crType . humanoidAI of
+updateHumanoid cr = case cr ^?! crType of
-    ChaseAI ->
+    ChaseCrit ->
         humanoidAIList
             [ const doStrategyActions
             , performActions
@@ -27,151 +27,152 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of
             , const (crVocalization . vcCoolDown %~ max 0 . subtract 1)
             ]
             cr
-    SpreadGunAI ->
+    _ -> id
-        defaultImpulsive
+--    SpreadGunAI ->
-            [ performActions
+--        defaultImpulsive
-            , watchUpdateStrat
+--            [ performActions
-                [
+--            , watchUpdateStrat
-                    ( crHasTargetLOS
+--                [
-                    , \_ _ ->
+--                    ( crHasTargetLOS
-                        StrategyActions
+--                    , \_ _ ->
-                            (ShootAt 0)
+--                        StrategyActions
-                            [ DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon
+--                            (ShootAt 0)
-                            , DoActionThen
+--                            [ DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon
-                                (DoActionWhile WdCrLOSTarget $ ArbitraryAction ChooseMovementSpreadGun)
+--                            , DoActionThen
-                                (DoImpulses [ChangeStrategy WatchAndWait])
+--                                (DoActionWhile WdCrLOSTarget $ ArbitraryAction ChooseMovementSpreadGun)
-                            ]
+--                                (DoImpulses [ChangeStrategy WatchAndWait])
-                    )
+--                            ]
-                , (const crAwayFromPost, const goToPostStrat)
+--                    )
-                ]
+--                , (const crAwayFromPost, const goToPostStrat)
-            , perceptionUpdate [0]
+--                ]
-            , const doStrategyActions
+--            , perceptionUpdate [0]
-            , targetYouWhenCognizant
+--            , const doStrategyActions
-            , const $
+--            , targetYouWhenCognizant
-                overrideInternal
+--            , const $
-                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
+--                overrideInternal
-                    (\cr' -> cr' & crActionPlan . apStrategy .~ WatchAndWait)
+--                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
-            ]
+--                    (\cr' -> cr' & crActionPlan . apStrategy .~ WatchAndWait)
-            cr
+--            ]
-    PistolAI ->
+--            cr
-        defaultImpulsive
+--    PistolAI ->
-            [ performActions
+--        defaultImpulsive
-            , watchUpdateStrat
+--            [ performActions
-                [
+--            , watchUpdateStrat
-                    ( crHasTargetLOS
+--                [
-                    , \w cr' ->
+--                    ( crHasTargetLOS
-                        StrategyActions
+--                    , \w cr' ->
-                            (ShootAt 0)
+--                        StrategyActions
-                            [DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon, chooseMovementPistol cr' w]
+--                            (ShootAt 0)
-                    )
+--                            [DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon, chooseMovementPistol cr' w]
-                , (const crAwayFromPost, const goToPostStrat)
+--                    )
-                ]
+--                , (const crAwayFromPost, const goToPostStrat)
-            , perceptionUpdate [0]
+--                ]
-            , const doStrategyActions
+--            , perceptionUpdate [0]
-            , targetYouWhenCognizant
+--            , const doStrategyActions
-            , const $
+--            , targetYouWhenCognizant
-                overrideInternal
+--            , const $
-                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
+--                overrideInternal
-                    (crActionPlan . apStrategy .~ WatchAndWait)
+--                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
-            ]
+--                    (crActionPlan . apStrategy .~ WatchAndWait)
-            cr
+--            ]
-    LtAutoAI ->
+--            cr
-        defaultImpulsive
+--    LtAutoAI ->
-            [ performActions
+--        defaultImpulsive
-            , watchUpdateStrat
+--            [ performActions
-                [
+--            , watchUpdateStrat
-                    ( crHasTargetLOS
+--                [
-                    , \_ _ ->
+--                    ( crHasTargetLOS
-                        StrategyActions
+--                    , \_ _ ->
-                            (ShootAt 0)
+--                        StrategyActions
-                            [ DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon
+--                            (ShootAt 0)
-                            , DoActionThen
+--                            [ DoActionIf (WdCrNegate $ WdCrBlfromCrBl CrIsAiming) drawWeapon
-                                (DoActionWhile WdCrLOSTarget $ ArbitraryAction ChooseMovementLtAuto)
+--                            , DoActionThen
-                                (DoImpulses [ChangeStrategy WatchAndWait])
+--                                (DoActionWhile WdCrLOSTarget $ ArbitraryAction ChooseMovementLtAuto)
-                            ]
+--                                (DoImpulses [ChangeStrategy WatchAndWait])
-                    )
+--                            ]
-                , (const crAwayFromPost, const goToPostStrat)
+--                    )
-                ]
+--                , (const crAwayFromPost, const goToPostStrat)
-            , perceptionUpdate [0]
+--                ]
-            , const doStrategyActions
+--            , perceptionUpdate [0]
-            , targetYouWhenCognizant
+--            , const doStrategyActions
-            , const $
+--            , targetYouWhenCognizant
-                overrideInternal
+--            , const $
-                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
+--                overrideInternal
-                    (crActionPlan . apStrategy .~ WatchAndWait)
+--                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
-            ]
+--                    (crActionPlan . apStrategy .~ WatchAndWait)
-            cr
+--            ]
-    LauncherAI ->
+--            cr
-        defaultImpulsive
+--    LauncherAI ->
-            [ performActions
+--        defaultImpulsive
-            , watchUpdateStrat
+--            [ performActions
-                [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFireLauncher])
+--            , watchUpdateStrat
-                , (const crAwayFromPost, const goToPostStrat)
+--                [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFireLauncher])
-                ]
+--                , (const crAwayFromPost, const goToPostStrat)
-            , perceptionUpdate [0]
+--                ]
-            , const doStrategyActions
+--            , perceptionUpdate [0]
-            , targetYouWhenCognizant
+--            , const doStrategyActions
-            , const $
+--            , targetYouWhenCognizant
-                overrideInternal
+--            , const $
-                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
+--                overrideInternal
-                    (crActionPlan . apStrategy .~ WatchAndWait)
+--                    (\cr' -> crHasTarget cr' && crStratConMatches (GetTo (V2 0 0)) cr')
-            ]
+--                    (crActionPlan . apStrategy .~ WatchAndWait)
-            cr
+--            ]
-    SwarmAI ->
+--            cr
-        defaultImpulsive
+--    SwarmAI ->
-            [ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi / 4) 3.9)
+--        defaultImpulsive
-            , const (crMeleeCooldown %~ max 0 . subtract 1)
+--            [ flockToPointUsing' (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi / 4) 3.9)
-            , perceptionUpdate [0]
+--            , const (crMeleeCooldown %~ max 0 . subtract 1)
-            , const doStrategyActions
+--            , perceptionUpdate [0]
-            , targetYouWhenCognizant
+--            , const doStrategyActions
-            ]
+--            , targetYouWhenCognizant
-            cr
+--            ]
-    AutoAI -> defaultImpulsive [sentinelAI] cr
+--            cr
-    FlockArmourChaseAI ->
+--    AutoAI -> defaultImpulsive [sentinelAI] cr
-        defaultImpulsive
+--    FlockArmourChaseAI ->
-            [ watchUpdateStrat []
+--        defaultImpulsive
-            , const doStrategyActions
+--            [ watchUpdateStrat []
-            , performActions
+--            , const doStrategyActions
-            , targetYouWhenCognizant
+--            , performActions
-            , setTargetMv (\_ -> _targetCr . _crIntention)
+--            , targetYouWhenCognizant
-            , flockACC
+--            , setTargetMv (\_ -> _targetCr . _crIntention)
-            , perceptionUpdate [0]
+--            , flockACC
-            , goToTarget
+--            , perceptionUpdate [0]
-            , const overrideMeleeCloseTarget
+--            , goToTarget
-            , const (crMeleeCooldown %~ max 0 . subtract 1)
+--            , const overrideMeleeCloseTarget
-            ]
+--            , const (crMeleeCooldown %~ max 0 . subtract 1)
-            cr
+--            ]
-    MiniGunAI -> defaultImpulsive [sentinelFireType (const shootTillEmpty)] cr
+--            cr
-    LongAI -> defaultImpulsive [sentinelFireType $ const shootTillEmpty] cr
+--    MiniGunAI -> defaultImpulsive [sentinelFireType (const shootTillEmpty)] cr
-    MultGunAI ->
+--    LongAI -> defaultImpulsive [sentinelFireType $ const shootTillEmpty] cr
-        defaultImpulsive
+--    MultGunAI ->
-            [ sentinelExtraWatchUpdate
+--        defaultImpulsive
-                [
+--            [ sentinelExtraWatchUpdate
---                    ( const $ not . crWeaponReady
+--                [
---                    , \_ _ -> StrategyActions Reload reloadActions
+----                    ( const $ not . crWeaponReady
+----                    , \_ _ -> StrategyActions Reload reloadActions
+----                    )
+----                ,
+--                    ( const $ not . crSafeDistFromTarg 150
+--                    , \_ _ ->
+--                        StrategyActions
+--                            Flee
+--                            [ WdCrNegate (WdCrSafeDistFromTarget 150) `DoActionWhile` UseSelf CrFleeFromTarget -- (fleeFrom cr')
+--                                `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
+--                            ]
 --                    )
 --                ,
-                    ( const $ not . crSafeDistFromTarg 150
+--                    ( crHasTargetLOS
-                    , \_ _ ->
+--                    , \_ _ ->
-                        StrategyActions
+--                        StrategyActions
-                            Flee
+--                            (ShootAt 0)
-                            [ WdCrNegate (WdCrSafeDistFromTarget 150) `DoActionWhile` UseSelf CrFleeFromTarget -- (fleeFrom cr')
+--                            [drawwp `DoActionThen` shootFirstMiss `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
-                                `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
+--                    )
-                            ]
+--                ]
-                    )
+--            ]
-                ,
+--            cr
-                    ( crHasTargetLOS
+--    InanimateAI -> id
-                    , \_ _ ->
-                        StrategyActions
-                            (ShootAt 0)
-                            [drawwp `DoActionThen` shootFirstMiss `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
-                    )
-                ]
-            ]
-            cr
-    InanimateAI -> id
   where
-    drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
+--    drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
 --    reloadActions =
 --        [ holsterWeapon
 --        --, WaitThen 1 $ DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading) (DoImpulses [ChangeStrategy WatchAndWait])

src/Dodge/Item/Scope.hs

@@ -91,7 +91,6 @@ copier x =
         & itType .~ COPIER x
         & itUse .~ UseValue (Left 0)
         & itScroll .~ ItemScrollInt 0
-        -- & itEffect . ieInv .~ ItemCopierUpdate
 
 nulgate :: Item
 nulgate =

src/Dodge/Prop/Gib.hs

@@ -2,6 +2,7 @@ module Dodge.Prop.Gib (
     addCrGibs,
 ) where
 
+import Dodge.Creature.Shape
 import Color
 import Control.Monad
 import Data.Foldable
@@ -42,7 +43,7 @@ addCrGibs cr = case damageDirection $ _csDamage $ _crState cr of
             . addGibsAtDir d 13 20 (_skinUpper skin) cpos
             . addGibAtDir d 25 (_skinHead skin) cpos
   where
-    skin = _crType cr -- this should be cleaned up
+    skin = crShape $ _crType cr -- this should be cleaned up
     cpos = _crPos cr
 
 addGibsAt :: Float -> Float -> Color -> Point2 -> World -> World

src/Dodge/Render/ShapePicture.hs

@@ -38,9 +38,7 @@ worldSPic cfig u =
 
 drawCreature :: Creature -> SPic
 drawCreature cr = case _crType cr of
-    Avatar {} -> basicCrPict cr
+    BarrelCrit{} ->
-    Humanoid{} -> basicCrPict cr
-    Barreloid{} ->
         picAtCrPos1
             ( setDepth 20 $
                 fold
@@ -50,8 +48,9 @@ drawCreature cr = case _crType cr of
                     ]
             )
             cr
-    Lampoid{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ lampCrSPic h
+    LampCrit{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ lampCrSPic h
-    NonDrawnCreature -> mempty
+    _ -> basicCrPict cr
+--    NonDrawnCreature -> mempty
 
 lampCrSPic :: Float -> SPic
 lampCrSPic h =

src/Dodge/Update.hs

@@ -466,7 +466,6 @@ setOldPos :: Creature -> Creature
 setOldPos cr =
     cr
         & crOldPos .~ _crPos cr
-        & crOldDir .~ _crDir cr
 
 -- hack
 --updateRandGen :: World -> World