Add Read/Show instance for Creature

src/Dodge/Creature/Action.hs

@@ -20,6 +20,7 @@ module Dodge.Creature.Action
     , pickUpItemID
     )
     where
+import Dodge.FloatFunction
 import Dodge.Inventory.Add
 import Dodge.CreatureEffect
 --import Dodge.ShortShow
@@ -63,7 +64,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
     cpos = _crPos cr
     canSee' = canSee (_crID cr) tcid w
     aimSp = case cr ^? crMvType . mvAimSpeed of
-        Just f -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
+        Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
         Nothing -> error "creature without aiming type"
     tpos | canSee'   = _crPos (_creatures w IM.! tcid)
          | otherwise = p

src/Dodge/Creature/ArmourChase.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.ArmourChase
     , flockArmourChaseCrit
     ) where
 import Dodge.Data
+import Dodge.Data.FloatFunction
 import Dodge.Default
 import Dodge.Creature.ChaseCrit
 import Dodge.Item.Equipment
@@ -38,9 +39,8 @@ armourChaseCrit = chaseCrit
         [(0,frontArmour)
         ,(1,medkit 200)
         ]
-    , _crMvType = defaultChaseMvType {_mvTurnRad = f}
+    , _crMvType = defaultChaseMvType {_mvTurnRad = FloatConst 0.05}
     } 
     & crEquipment . at OnChest ?~ 0
     & crInvEquipped . at 0 ?~ OnChest
   where
-    f _ = 0.05

src/Dodge/Creature/ChaseCrit.hs

@@ -5,7 +5,6 @@ module Dodge.Creature.ChaseCrit
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 import Dodge.Item.Consumable
 import Dodge.Item.Equipment
 import Dodge.SoundLogic
@@ -20,7 +19,7 @@ smallChaseCrit = chaseCrit
     { _crHP = 1
     , _crRad = 4
     , _crInv = IM.fromList [(0,medkit 200)]
-    , _crCorpse = basicCrCorpse
+    , _crCorpse = MakeDefaultCorpse
     }
 invisibleChaseCrit :: Creature
 invisibleChaseCrit = chaseCrit

src/Dodge/Creature/Impulse.hs

@@ -4,6 +4,8 @@ module Dodge.Creature.Impulse
     , followThenClearImpulses
     ) where
 import Dodge.Data
+import Dodge.FloatFunction
+import Dodge.RandImpulse
 import Dodge.CreatureEffect
 import Dodge.Creature.Vocalization
 import Dodge.Creature.Impulse.Movement
@@ -53,7 +55,7 @@ followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
 followImpulse cr w imp = case imp of
     ImpulseNothing -> (id,cr)
     RandomImpulse rimp -> 
-        let (newimp,newgen) = runState rimp (_randGen w)
+        let (newimp,newgen) = runState (doRandImpulse rimp) (_randGen w)
         in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
     Bark sid        -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
     Move p          -> crup $ crMvBy p cr
@@ -88,7 +90,7 @@ followImpulse cr w imp = case imp of
     crup = (id,)
     mvType = _crMvType cr
     speed = _mvSpeed mvType
-    turnRad = _mvTurnRad mvType
+    turnRad = doFloatFloat $ _mvTurnRad mvType
     cpos = _crPos cr
     cdir = _crDir cr
     cid  = _crID cr

src/Dodge/Creature/Memory/Data.hs

@@ -10,5 +10,6 @@ data Memory = Memory
     { _soundsToInvestigate :: [Point2]
     , _nodesSearched       :: [Int]
     }
+  deriving (Eq,Ord,Show,Read)
 
 makeLenses ''Memory

src/Dodge/Creature/Perception.hs

@@ -5,6 +5,7 @@ module Dodge.Creature.Perception
 --    , newSounds
     ) where
 import Dodge.Data
+import Dodge.FloatFunction
 import Dodge.Creature.Vocalization
 import Dodge.Base.Collide
 import RandomHelp
@@ -45,9 +46,10 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
         oldAwareness = _cpAwareness $ _crPerception cr
         newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
         becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
-        thejitter = do
-            p <- randInCirc 1
-            return $ Move p
+        thejitter = RandImpulseCircMove 1 
+            --do
+            --p <- randInCirc 1
+            --return $ Move p
         maybeBark
             | becomesCognizant = case vocalizationTest cr of
                 Just sid -> crActionPlan . apAction .~ 
@@ -77,9 +79,10 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
         newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
         becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
         --randBool = takeOne [False,True] & evalState $ _randGen w
-        thejitter = do
-            p <- randInCirc 2
-            return $ Move p
+        thejitter = RandImpulseCircMove 2 
+        --  do
+        --    p <- randInCirc 2
+        --    return $ Move p
         maybeBark
             | becomesCognizant -- && randBool 
                 && cr ^? crVocalization . vcCoolDown == Just 0 
@@ -133,7 +136,7 @@ newExtraAwareness
     -> Maybe Awareness
 newExtraAwareness cr w cid
     | not $ canSeeIndirect (_crID cr) cid w = Nothing
-    | otherwise = Just . Suspicious $ _viFOV vi ang * _viDist vi d * awakeLevelPerception cr
+    | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
   where
     vi = _cpVision $ _crPerception cr
     tpos = _crPos $ _creatures w IM.! cid
@@ -168,7 +171,7 @@ rememberSounds w cr = cr
 -- TODO work out correct form for sounds passing through walls
 soundIsClose :: World -> Creature -> (Point2,Float) -> Bool
 soundIsClose w cr (pos,vol) = dist cpos pos < 2000 
-    && vol > (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
+    && vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
     && hasLOS cpos pos w
   where
     cpos = _crPos cr

src/Dodge/Creature/Perception/Data.hs

@@ -21,6 +21,7 @@ module Dodge.Creature.Perception.Data
     )
     where
 import Control.Lens
+import Dodge.Data.FloatFunction
 import qualified IntMapHelp as IM
 
 data Perception = Perception
@@ -30,14 +31,18 @@ data Perception = Perception
     , _cpVision         :: Vision
     , _cpAudition       :: Audition
     }
+  deriving (Eq,Ord,Show,Read)
 
 data Vision = Eyes
-    { _viFOV  :: Float -> Float
-    , _viDist :: Float -> Float
+    { _viFOV  :: FloatFloat
+    , _viDist :: FloatFloat
     }
+  deriving (Eq,Ord,Show,Read)
+
 newtype Audition = Ears
-    { _auDist :: Float -> Float
+    { _auDist :: FloatFloat
     }
+  deriving (Eq,Ord,Show,Read)
 
 data Vigilance
     = Comatose
@@ -45,16 +50,17 @@ data Vigilance
     | Lethargic
     | Vigilant
     | Overstrung
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
 
 data Attention
     = AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness }
     | Fixated {_getFixated :: Int }
+  deriving (Eq,Ord,Show,Read)
 
 data Awareness
     = Suspicious Float
     | Cognizant Float
-  deriving (Eq,Ord)
+  deriving (Eq,Ord,Show,Read)
 
 makeLenses ''Attention
 makeLenses ''Perception

src/Dodge/Creature/Picture.hs

@@ -9,7 +9,10 @@ module Dodge.Creature.Picture
     , picAtCrPos
     , shapeAtCrPos
     , picAtCrPosNoRot
-    , basicCrCorpse
+--    , basicCrCorpse
+    , deadScalp
+    , deadUpperBody
+    , deadFeet
     ) where
 import Dodge.Data
 import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
@@ -230,15 +233,3 @@ picAtCrPosNoRot :: Picture -> Creature -> SPic
 --{-# INLINE picAtCrPos #-}
 picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic
 
-basicCrCorpse :: Creature -> Corpse -> SPic
-basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat
-        [ rotdir . colorSH (_skinHead cskin) $ deadScalp cr
-        , rotdir $ colorSH (_skinUpper cskin) $ deadUpperBody cr
-        , rotdir . rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
-        ]
-  where 
-    cskin = _crType cr -- this should be fixed
-    crsize = 0.1 * _crRad cr
-    tr = uncurryV translateSHf (_cpPos cp)
-    rotdir = rotateSH (_cpDir cp)
-    rotmdir = rotateSH (_crMvDir cr - _crDir cr)

src/Dodge/Creature/Stance/Data.hs

@@ -10,7 +10,8 @@ data Stance = Stance
     ,_posture      :: Posture
     ,_strideLength :: Int
     }
-  deriving (Eq,Show)
+  deriving (Eq,Ord,Show,Read)
+
 data Carriage 
     = Walking 
         { _strideAmount :: Int 
@@ -20,18 +21,18 @@ data Carriage
     | Floating
     | Flying
     | Boosting Point2
-  deriving (Eq,Show)
+  deriving (Eq,Ord,Show,Read)
+
 data FootForward
     = LeftForward
     | RightForward
     | WasLeftForward
     | WasRightForward
-  deriving
-    (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
+
 data Posture = Aiming 
     | AtEase
-  deriving 
-    (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
 
 makeLenses ''Stance
 makeLenses ''Carriage

src/Dodge/Creature/State.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.State
     ( stateUpdate
     , doDamage
     ) where
+import Dodge.Corpse.Make
 import Dodge.Data
 import Dodge.Targeting
 import Dodge.ItEffect
@@ -71,9 +72,9 @@ checkDeath cr w
         | otherwise  = creatures . at (_crID cr) .~ Nothing
 corpseOrGib :: Creature -> World -> World
 corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
-    Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpPict %~ fmap scorchSPic)
+    Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ scorchSPic)
     Just (ELECTRICAL,_) -> w & plNew corpses cpID thecorpse
-    Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpPict %~ fmap poisonSPic)
+    Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ poisonSPic)
     _ | _crPastDamage cr > 200 -> w & addCrGibs cr
         & bloodPuddleAt cpos
         & bloodPuddleAt cpos
@@ -84,13 +85,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
         & plNew corpses cpID thecorpse
   where
     cpos = _crPos cr
-    thecorpse = Corpse
-        { _cpID = 0
-        , _cpPos = _crPos cr
-        , _cpDir = _crDir cr
-        , _cpPict = _crCorpse cr cr
-        , _cpRes = Nothing
-        }
+    thecorpse = makeDefaultCorpse cr
 
 scorchSPic :: SPic -> SPic
 scorchSPic = over _1 $

src/Dodge/Creature/State/Data.hs

@@ -12,10 +12,11 @@ data CreatureDropType
     = DropAll
     | DropAmount Int
     | DropSpecific [Int]
+ deriving (Eq,Ord,Show,Read)
 data CrSpState 
     = Barrel { _piercedPoints :: [Point2]}
     | GenCr
-  deriving (Eq,Show,Ord)
+ deriving (Eq,Ord,Show,Read)
 data Faction 
     = GenericFaction Int
     | ZombieFaction
@@ -25,7 +26,7 @@ data Faction
     | NoFaction
     | ColorFaction Color
     | PlayerFaction
-  deriving (Eq,Show)
+ deriving (Eq,Ord,Show,Read)
 data CrGroup
     = LoneWolf
     | Swarm 
@@ -34,5 +35,5 @@ data CrGroup
         }
     | CrGroupID { _crGroupID :: Int }
     | ShieldGroup
-  deriving (Eq, Show)
+ deriving (Eq,Ord,Show,Read)
 makeLenses ''CrSpState

src/Dodge/Creature/SwarmCrit.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.SwarmCrit
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 import Picture
 
 import Control.Lens
@@ -13,7 +12,7 @@ swarmCrit = defaultCreature
     { _crHP = 1
     , _crRad = 2
     , _crMass = 2
-    , _crCorpse = basicCrCorpse
+    , _crCorpse = MakeDefaultCorpse
     , _crFaction = ColorFaction yellow
     , _crMeleeCooldown = 0
     }

src/Dodge/Creature/Test.hs

@@ -27,7 +27,7 @@ module Dodge.Creature.Test
 import Dodge.Data
 import Dodge.Base.Collide
 import Geometry
-import SameConstr
+--import SameConstr
 
 import Data.List (find)
 import Data.Maybe
@@ -64,7 +64,8 @@ crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
     Nothing -> True
 
 crStratConMatches :: Strategy -> Creature -> Bool
-crStratConMatches strat cr = eqConstr strat (_apStrategy $ _crActionPlan cr)
+crStratConMatches strat cr = strat == (_apStrategy $ _crActionPlan cr)
+    -- this equality check might be slow...
 
 crAwayFromPost :: Creature -> Bool
 crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of