Add Read/Show instance for Creature

src/Dodge/Corpse/Draw.hs

@@ -0,0 +1,7 @@
+module Dodge.Corpse.Draw where
+import Dodge.Data.Corpse
+import ShapePicture
+
+-- not currently used, too simple
+drawCorpse :: Corpse -> SPic
+drawCorpse cp = _cpSPic cp

src/Dodge/Corpse/Make.hs

@@ -0,0 +1,36 @@
+module Dodge.Corpse.Make 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
+makeCorpse cc = case cc of
+    MakeDefaultCorpse -> makeDefaultCorpse
+
+makeDefaultCorpse :: Creature -> Corpse
+makeDefaultCorpse cr = defaultCorpse
+    & cpPos .~ _crPos cr
+    & cpDir .~ _crDir cr
+    & 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
+    crsize = 0.1 * _crRad cr
+    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+
+defaultCorpse :: Corpse
+defaultCorpse = Corpse
+    { _cpID = 0
+    , _cpPos = 0
+    , _cpDir = 0
+    , _cpSPic = mempty
+    , _cpRes = NoResurrection
+    }

src/Dodge/Creature.hs

@@ -27,9 +27,6 @@ import Dodge.Item.Weapon
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
 import Dodge.Creature.Inanimate
-import Dodge.Creature.Picture
---import Dodge.Creature.ChooseTarget
---import Dodge.Item
 import Picture
 import Geometry.Data
 import qualified IntMapHelp as IM
@@ -102,7 +99,7 @@ startCr = defaultCreature
     , _crHP = 1000
     , _crMaxHP = 1500
     , _crInv = startInventory 
-    , _crCorpse = basicCrCorpse
+    , _crCorpse = MakeDefaultCorpse
     , _crFaction = PlayerFaction
     , _crMvType = MvWalking yourDefaultSpeed
     }

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
+        thejitter = RandImpulseCircMove 1 
-            p <- randInCirc 1
+            --do
-            return $ Move p
+            --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
+        thejitter = RandImpulseCircMove 2 
-            p <- randInCirc 2
+        --  do
-            return $ Move p
+        --    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
+    { _viFOV  :: FloatFloat
-    , _viDist :: Float -> Float
+    , _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
+  deriving (Eq,Ord,Show,Read)
-    (Eq,Ord,Show)
+
 data Posture = Aiming 
     | AtEase
-  deriving 
+  deriving (Eq,Ord,Show,Read)
-    (Eq,Ord,Show)
 
 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
+    thecorpse = makeDefaultCorpse cr
-        { _cpID = 0
-        , _cpPos = _crPos cr
-        , _cpDir = _crDir cr
-        , _cpPict = _crCorpse cr cr
-        , _cpRes = Nothing
-        }
 
 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

src/Dodge/Data.hs

@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.Corpse
     , module Dodge.Data.ActionPlan
     , module Dodge.Data.CreatureEffect
     , module Dodge.Data.WorldEffect
@@ -72,6 +73,7 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.Corpse
 import Dodge.Data.ActionPlan
 import Dodge.Data.CreatureEffect
 import Dodge.Data.WorldEffect

src/Dodge/Data/ActionPlan.hs

@@ -19,13 +19,17 @@ data ActionPlan
         ,_apStrategy    :: Strategy
         ,_apGoal        :: [Goal]
         }
-newtype RandImpulse = RandImpulseList [Impulse]
+ deriving (Eq,Ord,Show,Read)
+data RandImpulse 
+    = RandImpulseList [Impulse]
+    | RandImpulseCircMove Float
+ deriving (Eq,Ord,Show,Read)
 data Impulse
     = Move Point2
     | MoveForward Float
     | Turn Float
     | RandomTurn Float
-    | RandomImpulse (State StdGen Impulse)
+    | RandomImpulse RandImpulse -- (State StdGen Impulse)
     | TurnToward Point2 Float
     | MvTurnToward Point2
     | MvForward
@@ -52,34 +56,34 @@ data Impulse
         {_impulseUseAheadPos :: P2Imp
         }
     | ImpulseNothing
-instance Show Impulse where
+ deriving (Eq,Ord,Show,Read)
-    show imp = case imp of
+--instance Show Impulse where
-        Move p -> "Move "++shortPoint2 p
+--    show imp = case imp of
-        MoveForward f -> "MoveForward "++ show f
+--        Move p -> "Move "++shortPoint2 p
-        Turn f -> "Turn "++show f
+--        MoveForward f -> "MoveForward "++ show f
-        RandomTurn f -> "RandomTurn "++show f
+--        Turn f -> "Turn "++show f
-        TurnToward p f -> "TurnToward "++shortPoint2 p++show f
+--        RandomTurn f -> "RandomTurn "++show f
-        MvTurnToward p -> "MvTurnToward "++shortPoint2 p
+--        TurnToward p f -> "TurnToward "++shortPoint2 p++show f
-        MvForward -> "MvForward"
+--        MvTurnToward p -> "MvTurnToward "++shortPoint2 p
-        TurnTo p -> "TurnTo "++shortPoint2 p
+--        MvForward -> "MvForward"
-        UseItem -> "UseItem"
+--        TurnTo p -> "TurnTo "++shortPoint2 p
-        SwitchToItem i -> "SwitchToItem "++show i
+--        UseItem -> "UseItem"
-        DropItem -> "DropItem"
+--        SwitchToItem i -> "SwitchToItem "++show i
-        Bark sid -> "Bark "++show sid
+--        DropItem -> "DropItem"
-        Melee i -> "Melee "++show i
+--        Bark sid -> "Bark "++show sid
-        ChangePosture post -> "ChangePosture " ++ show post
+--        Melee i -> "Melee "++show i
-        MakeSound sid -> "MakeSound " ++ show sid
+--        ChangePosture post -> "ChangePosture " ++ show post
-        ChangeStrategy s -> "ChangeStrategy " ++ show s
+--        MakeSound sid -> "MakeSound " ++ show sid
-        AddGoal g -> "AddGoal " ++ show g
+--        ChangeStrategy s -> "ChangeStrategy " ++ show s
-        ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
+--        AddGoal g -> "AddGoal " ++ show g
-        ArbitraryImpulse {}  -> "ArbitraryImpulse"
+--        ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
-        ArbitraryImpulseEffect {}  -> "ArbitraryImpulseEffect"
+--        ArbitraryImpulse {}  -> "ArbitraryImpulse"
-        ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
+--        ArbitraryImpulseEffect {}  -> "ArbitraryImpulseEffect"
-        ImpulseUseTarget {} -> "ImpulseUseTarget"
+--        ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
-        ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
+--        ImpulseUseTarget {} -> "ImpulseUseTarget"
-        RandomImpulse {} -> "RandomImpulse"
+--        ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
-        ImpulseNothing -> "ImpulseNothing"
+--        RandomImpulse {} -> "RandomImpulse"
---  deriving (Eq,Ord,Show)
+--        ImpulseNothing -> "ImpulseNothing"
 infixr 9 `WaitThen`
 infixr 9 `DoActionThen`
 infixr 9 `DoActionWhile`
@@ -180,101 +184,101 @@ data Action
         {_sideImpulses  :: [Impulse]
         ,_mainAction    :: Action
         }
-  deriving (Generic)
+ deriving (Eq,Ord,Show,Read)
-instance Show Action where
+--instance Show Action where
-    show act = case act of
+--    show act = case act of
-        ActionNothing -> "ActionNothing"
+--        ActionNothing -> "ActionNothing"
-        LabelAction
+--        LabelAction
-          {_actLabel = str
+--          {_actLabel = str
-          ,_actAction = subAct
+--          ,_actAction = subAct
-          } -> str++":"++show subAct
+--          } -> str++":"++show subAct
-        AimAt
+--        AimAt
-          {_targetID     = tid
+--          {_targetID     = tid
-          ,_targetSeenAt = p
+--          ,_targetSeenAt = p
-          } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
+--          } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
-        PathTo 
+--        PathTo 
-          {_pathToPoint = p
+--          {_pathToPoint = p
-          } -> "PathTo:"++shortPoint2 p
+--          } -> "PathTo:"++shortPoint2 p
-        TurnToPoint
+--        TurnToPoint
-          {_turnToPoint = p
+--          {_turnToPoint = p
-          } -> "TurnToPoint:"++shortPoint2 p
+--          } -> "TurnToPoint:"++shortPoint2 p
-----      | PickupItem 
+------      | PickupItem 
-----          {_pickupItemID :: Int
+------          {_pickupItemID :: Int
-----          }
+------          }
-        ImpulsesList 
+--        ImpulsesList 
-          {_impulsesListList  = iss
+--          {_impulsesListList  = iss
-          } -> "ImpulsesList:"++show iss
+--          } -> "ImpulsesList:"++show iss
-        DoImpulses 
+--        DoImpulses 
-          {_doImpulsesList  = is
+--          {_doImpulsesList  = is
-          } -> "DoImpulses:"++show is
+--          } -> "DoImpulses:"++show is
-        WaitThen
+--        WaitThen
-          {_waitThenTimer  = i
+--          {_waitThenTimer  = i
-          ,_waitThenAction = a
+--          ,_waitThenAction = a
-          } -> "WaitThen timer:"++show i++" act:"++show a
+--          } -> "WaitThen timer:"++show i++" act:"++show a
-        DoActionWhile 
+--        DoActionWhile 
-          {_doActionWhileCondition = _
+--          {_doActionWhileCondition = _
-          ,_doActionWhileAction    = a
+--          ,_doActionWhileAction    = a
-          } -> "DoActionWhile (function) act:"++show a
+--          } -> "DoActionWhile (function) act:"++show a
-        DoActionWhilePartial
+--        DoActionWhilePartial
-          {_doActionWhilePartial    = partact
+--          {_doActionWhilePartial    = partact
-          ,_doActionWhileCondition  = _
+--          ,_doActionWhileCondition  = _
-          ,_doActionWhileAction     = a 
+--          ,_doActionWhileAction     = a 
-          } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a
+--          } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a
-        DoActionIf
+--        DoActionIf
-          {_doActionIfCondition = _
+--          {_doActionIfCondition = _
-          ,_doActionIfAction    = a
+--          ,_doActionIfAction    = a
-          } -> "DoActionIf act:"++show a
+--          } -> "DoActionIf act:"++show a
-        DoActionIfElse 
+--        DoActionIfElse 
-          {_doActionIfElseIfAction    = ifa
+--          {_doActionIfElseIfAction    = ifa
-          ,_doActionIfElseCondition   = _
+--          ,_doActionIfElseCondition   = _
-          ,_doActionIfElseElseAction  = elsea
+--          ,_doActionIfElseElseAction  = elsea
-          } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea
+--          } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea
-        DoActionWhileInterrupt 
+--        DoActionWhileInterrupt 
-          {_doActionWhileThenDo           = whilea
+--          {_doActionWhileThenDo           = whilea
-          ,_doActionWhileThenCondition    = _
+--          ,_doActionWhileThenCondition    = _
-          ,_doActionWhileThenThen         = thena
+--          ,_doActionWhileThenThen         = thena
-          } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena
+--          } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena
-        DoActions 
+--        DoActions 
-          {_doActionsList = as
+--          {_doActionsList = as
-          } -> "DoActions " ++ foldMap show as
+--          } -> "DoActions " ++ foldMap show as
-        DoActionThen 
+--        DoActionThen 
-          {_doActionThenFirst    = a1 
+--          {_doActionThenFirst    = a1 
-          ,_doActionThenSecond   = a2
+--          ,_doActionThenSecond   = a2
-          } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2
+--          } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2
-----      | DoGuardActions 
+------      | DoGuardActions 
-----          {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
+------          {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
-----          }
+------          }
-        DoReplicate 
+--        DoReplicate 
-          {_doReplicateTimes  = i 
+--          {_doReplicateTimes  = i 
-          ,_doReplicateAction = a 
+--          ,_doReplicateAction = a 
-          } -> "DoReplicate times:" ++ show i ++ " act:"++ show a
+--          } -> "DoReplicate times:" ++ show i ++ " act:"++ show a
-        DoReplicatePartial
+--        DoReplicatePartial
-          {_partialAction     = pa
+--          {_partialAction     = pa
-          ,_doReplicateTimes  = i
+--          ,_doReplicateTimes  = i
-          ,_doReplicateAction = ra
+--          ,_doReplicateAction = ra
-          } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra
+--          } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra
-        LeadTarget
+--        LeadTarget
-          {_leadTargetBy = p
+--          {_leadTargetBy = p
-          } -> "LeadTarget by:"++ show p
+--          } -> "LeadTarget by:"++ show p
-        NoAction -> "NoAction"
+--        NoAction -> "NoAction"
-        StartSentinelPost -> "StartSentinelPost"
+--        StartSentinelPost -> "StartSentinelPost"
-        UseTarget
+--        UseTarget
-          {_useTarget = _
+--          {_useTarget = _
-          } -> "UseTarget func"
+--          } -> "UseTarget func"
-        UseSelf
+--        UseSelf
-          {_useSelf = _
+--          {_useSelf = _
-          } -> "UseSelf func"
+--          } -> "UseSelf func"
-        UseAheadPos
+--        UseAheadPos
-          {_useAheadPos = _
+--          {_useAheadPos = _
-          } -> "UseAheadPos func"
+--          } -> "UseAheadPos func"
-        UseMvTargetPos
+--        UseMvTargetPos
-          {_useMvTargetPos = _
+--          {_useMvTargetPos = _
-          } -> "UseMvTargetPos func"
+--          } -> "UseMvTargetPos func"
-        ArbitraryAction {} -> "ArbitraryAction func"
+--        ArbitraryAction {} -> "ArbitraryAction func"
-        DoImpulsesAlongside 
+--        DoImpulsesAlongside 
-          {_sideImpulses  = is
+--          {_sideImpulses  = is
-          ,_mainAction    = a
+--          ,_mainAction    = a
-          } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a
+--          } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a
         
 --  deriving (Eq,Ord,Show)
 data Strategy
@@ -293,13 +297,13 @@ data Strategy
     | Reload
     | Flee
     | MeleeStrike
-  deriving (Generic,Show)
+ deriving (Eq,Ord,Show,Read)
 --  deriving (Eq,Ord,Show)
 data Goal
     = LiveLongAndProsper
     | Kill Int
     | SentinelAt Point2 Float
-  deriving (Show)
+ deriving (Eq,Ord,Show,Read)
 makeLenses ''ActionPlan
 makeLenses ''Impulse
 makeLenses ''Action

src/Dodge/Data/Ammo.hs

@@ -41,6 +41,6 @@ data AmmoType
         { _amForceFieldType :: Wall
         }
     | GenericAmmo
-  deriving (Show,Read)
+ deriving (Eq,Ord,Show,Read)
 makeLenses ''ProjectileUpdate
 makeLenses ''AmmoType

src/Dodge/Data/Corpse.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Corpse where
+import ShapePicture.Data
+import Geometry.Data
+
+import Control.Lens
+
+data CorpseResurrection = NoResurrection
+
+data Corpse = Corpse
+    { _cpID  :: Int
+    , _cpPos :: Point2
+    , _cpDir :: Float
+    , _cpSPic :: SPic
+    , _cpRes :: CorpseResurrection
+    }
+makeLenses ''Corpse

src/Dodge/Data/Creature.hs

@@ -45,7 +45,7 @@ data Creature = Creature
     , _crEquipment      :: M.Map EquipPosition Int
     , _crLeftInvSel     :: Maybe Int
     , _crState          :: CreatureState
-    , _crCorpse         :: Creature -> Corpse -> SPic
+    , _crCorpse         :: CreatureCorpse --Creature -> Corpse -> SPic
     , _crMaterial       :: Material
     , _crPastDamage     :: Int
     , _crStance         :: Stance
@@ -63,18 +63,14 @@ data Creature = Creature
     , _crStatistics     :: CreatureStatistics
     , _crCamouflage     :: CamouflageStatus
     }
-data Corpse = Corpse
+  deriving (Eq,Ord,Show,Read)
-    { _cpID  :: Int
+data CreatureCorpse = MakeDefaultCorpse
-    , _cpPos :: Point2
+  deriving (Eq,Ord,Show,Read)
-    , _cpDir :: Float
-    , _cpPict :: Corpse -> SPic
-    , _cpRes :: Maybe Creature
-    }
 data Intention = Intention
     { _targetCr     :: Maybe Creature
     , _mvToPoint    :: Maybe Point2
     , _viewPoint    :: Maybe Point2
     }
+  deriving (Eq,Ord,Show,Read)
 makeLenses ''Creature
 makeLenses ''Intention
-makeLenses ''Corpse

src/Dodge/Data/Creature/Misc.hs

@@ -4,17 +4,20 @@ module Dodge.Data.Creature.Misc
     ( module Dodge.Data.Creature.Misc
     , module Dodge.Data.CamouflageStatus
     ) where
+import Dodge.Data.FloatFunction
 import Dodge.Data.CamouflageStatus
 import Sound.Data
 import Geometry.Data
 import Color
 import Control.Lens
+
 data CreatureStatistics = CreatureStatistics
     { _strength       :: Int
     , _dexterity      :: Int
     , _intelligence   :: Int
     }
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
+
 data Vocalization 
     = Mute
     | Vocalization
@@ -23,19 +26,24 @@ data Vocalization
         ,_vcMaxCoolDown :: Int
         ,_vcCoolDown    :: Int
         }
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
+
 data CrMvType 
     = NoMvType
     | MvWalking { _mvSpeed :: Float }
     | CrMvType
         { _mvSpeed      :: Float
-        , _mvTurnRad    :: Float -> Float
+        , _mvTurnRad    :: FloatFloat
         , _mvTurnJit    :: Float
-        , _mvAimSpeed   :: Float -> Float
+        , _mvAimSpeed   :: FloatFloat
         }
+  deriving (Eq,Ord,Show,Read)
+
 data HumanoidAI = YourAI | ChaseAI | InanimateAI | SpreadGunAI | PistolAI
     | LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI
     | LongAI | MultGunAI
+  deriving (Eq,Ord,Show,Read)
+
 data CreatureType
     = Humanoid
         { _skinHead     :: Color
@@ -47,7 +55,11 @@ data CreatureType
     | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
     | Turretoid
     | NonDrawnCreature
+  deriving (Eq,Ord,Show,Read)
+
 data BarrelType = PlainBarrel | ExplosiveBarrel
+  deriving (Eq,Ord,Show,Read)
+
 makeLenses ''CreatureStatistics
 makeLenses ''Vocalization
 makeLenses ''CrMvType 

src/Dodge/Data/Creature/State.hs

@@ -10,4 +10,5 @@ data CreatureState = CrSt
     , _csSpState :: CrSpState
     , _csDropsOnDeath :: CreatureDropType
     }
+ deriving (Eq,Ord,Show,Read)
 makeLenses ''CreatureState

src/Dodge/Data/CreatureEffect.hs

@@ -1,37 +1,50 @@
 module Dodge.Data.CreatureEffect where
 
 data WdCrCr = NoCreatureEffect
+  deriving (Eq,Ord,Show,Read)
 
 data CrWdImp = NoCrWdImp
+  deriving (Eq,Ord,Show,Read)
 
 data CrWdWd = CrWdWdId
+  deriving (Eq,Ord,Show,Read)
 
 data IntImp = NoIntImp
+  deriving (Eq,Ord,Show,Read)
 
 data CrImp = NoCrImp
     | TurnTowardCr Float -- turn amount
+  deriving (Eq,Ord,Show,Read)
 
 data P2Imp = P2ImpNo
+  deriving (Eq,Ord,Show,Read)
 
 data WdCrBl = WdCrTrue
     | WdCrBlfromCrBl CrBl
     | WdCrNegate WdCrBl
     | WdCrLOSTarget
     | WdCrSafeDistFromTarget Float
+  deriving (Eq,Ord,Show,Read)
 
 data CrBl = CrCanShoot
     | CrIsReloading
     | CrIsAiming
+  deriving (Eq,Ord,Show,Read)
 
 data MCrAc = MCrNoAction
+  deriving (Eq,Ord,Show,Read)
 
 data CrAc = CrTurnAround
     | CrFleeFromTarget
+  deriving (Eq,Ord,Show,Read)
 
 data P2Ac = P2NoAction
+  deriving (Eq,Ord,Show,Read)
 
 data MP2Ac = MP2NoAction
+  deriving (Eq,Ord,Show,Read)
 
 data CrWdAc = CrWdBFSThenReturn Int
     | ChooseMovementSpreadGun
     | ChooseMovementLtAuto
+  deriving (Eq,Ord,Show,Read)

src/Dodge/Data/FloatFunction.hs

@@ -0,0 +1,8 @@
+module Dodge.Data.FloatFunction where
+
+data FloatFloat = FloatID
+    | FloatFOV Float
+    | FloatLessCheck Float
+    | FloatAbsCheckGreaterLess Float Float Float
+    | FloatConst Float
+  deriving (Eq,Ord,Show,Read)

src/Dodge/Data/Item.hs

@@ -40,7 +40,7 @@ data Item = Item
     , _itValue      :: ItemValue
     , _itParams     :: ItemParams
     }
-   deriving (Show,Read)
+   deriving (Eq,Ord,Show,Read)
 data ItemTweaks
     = NoTweaks
     | Tweakable

src/Dodge/Data/Item/Consumption.hs

@@ -28,5 +28,5 @@ data ItemConsumption
         { _icAmount   :: IcAmount
         }
     | NoConsumption
-  deriving (Show,Read)
+ deriving (Eq,Ord,Show,Read)
 makeLenses ''ItemConsumption

src/Dodge/Data/LoadAction.hs

@@ -11,6 +11,7 @@ data LoadAction
     | LoadPrime  {_actionTime :: Int, _actionSound :: SoundID}
   deriving (Eq,Ord,Show,Read)
 data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
+ deriving (Eq,Ord,Show,Read)
 data InvSelAction
     = NoInvSelAction
     | ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType}

src/Dodge/Default/Creature.hs

@@ -1,6 +1,6 @@
 module Dodge.Default.Creature where
 import Dodge.Data
-import Dodge.Creature.Picture
+import Dodge.Data.FloatFunction
 import Geometry.Data
 import Picture
 
@@ -30,7 +30,7 @@ defaultCreature = Creature
     , _crInvEquipped = mempty
     , _crLeftInvSel = Nothing
     , _crState  = defaultState
-    , _crCorpse = basicCrCorpse
+    , _crCorpse = MakeDefaultCorpse
     , _crMaterial = Flesh
     , _crPastDamage = 0
     , _crEquipment = M.empty
@@ -78,17 +78,12 @@ defaultPerceptionState = Perception
     }
 defaultVision :: Vision
 defaultVision = Eyes
-    { _viFOV = f
+    { _viFOV = FloatFOV 0.5
-    , _viDist = g
+    , _viDist = FloatLessCheck 500
     }
-  where
-    f x | abs x < 0.5 * pi = 1
-        | otherwise        = 0
-    g x | x > 500 = 0
-        | otherwise = 1
 defaultAudition :: Audition
 defaultAudition = Ears
-    { _auDist = id
+    { _auDist = FloatID
     }
 defaultIntention :: Intention
 defaultIntention = Intention
@@ -99,9 +94,9 @@ defaultIntention = Intention
 defaultChaseMvType :: CrMvType
 defaultChaseMvType = CrMvType
     { _mvSpeed = 2
-    , _mvTurnRad = f
+    , _mvTurnRad = FloatAbsCheckGreaterLess (pi/4) 0.2 0.05--f
     , _mvTurnJit = 0.2
-    , _mvAimSpeed   = g
+    , _mvAimSpeed   = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01
     }
   where
     g x | x > pi/8  = 0.2
@@ -111,13 +106,10 @@ defaultChaseMvType = CrMvType
 defaultAimMvType :: CrMvType
 defaultAimMvType = CrMvType
     { _mvSpeed      = 3
-    , _mvTurnRad    = const 0.2
+    , _mvTurnRad    = FloatConst 0.2
     , _mvTurnJit    = 0.05
-    , _mvAimSpeed   = f
+    , _mvAimSpeed   = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01
     }
-  where
-    f x | x > pi/8  = 0.2
-        | otherwise = 0.01
 defaultAimingCrit :: Creature
 defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType }
 

src/Dodge/Equipment/Data.hs

@@ -15,4 +15,4 @@ data EquipPosition
     | OnRightWrist
     | OnLegs
     | OnSpecial
-    deriving (Eq,Ord,Show)
+    deriving (Eq,Ord,Show,Read)

src/Dodge/FloatFunction.hs

@@ -0,0 +1,16 @@
+module Dodge.FloatFunction where
+import Dodge.Data.FloatFunction
+
+doFloatFloat :: FloatFloat -> Float -> Float
+doFloatFloat ff x = case ff of
+    FloatID -> x
+    FloatConst y -> y
+    FloatFOV a 
+        | abs x < 0.5 * a   -> 1
+        | otherwise         -> 0 
+    FloatLessCheck y 
+        | x > y     -> 0
+        | otherwise -> 1
+    FloatAbsCheckGreaterLess a y1 y2 
+        | abs x > a -> y1
+        | otherwise -> y2

src/Dodge/RandImpulse.hs

@@ -0,0 +1,9 @@
+module Dodge.RandImpulse where
+import Dodge.Data.ActionPlan
+import Control.Monad.State
+import RandomHelp
+
+doRandImpulse :: RandImpulse -> State StdGen Impulse
+doRandImpulse ri = case ri of
+    RandImpulseList xs  -> takeOne xs
+    RandImpulseCircMove r -> Move <$> randInCirc r

src/Dodge/Render/ShapePicture.hs

@@ -61,7 +61,7 @@ worldSPic cfig w
     <> foldup drawProjectile (filtOn _prjPos _projectiles)                             
     <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)           
     <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)   
-    <> foldup (dbArg _cpPict) (filtOn _cpPos _corpses)                            
+    <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)                            
     <> foldup drawCreature (filtOn _crPos _creatures)                          
     <> foldup floorItemSPic (filtOn _flItPos _floorItems)                         
     <> foldup btSPic (filtOn _btPos _buttons)                                     
@@ -112,6 +112,11 @@ shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)
     . rotateSP (fdir x)
     $ fdraw x x
 
+shiftDraw' :: (a -> Point2) -> (a -> Float) -> (a -> SPic) -> a -> SPic
+shiftDraw' fpos fdir fdraw x = uncurryV translateSPf (fpos x)
+    . rotateSP (fdir x)
+    $ fdraw x
+
 cullPoint :: Configuration -> World -> Point2 -> Bool
 cullPoint cfig w p 
     | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w)

src/ShapePicture.hs

@@ -1,11 +1,10 @@
 {-# LANGUAGE TupleSections #-}
 module ShapePicture
-    ( --emptyBlank
+    ( module ShapePicture.Data
-     translateSP
+    , translateSP
     , translateSPf
     , translateSPz
     , rotateSP
-    , SPic
     , noPic
     , noShape
 --    , _spShape
@@ -14,6 +13,7 @@ module ShapePicture
     , mirrorSPxz
     , overPosSP
     ) where
+import ShapePicture.Data
 import Shape
 import Picture
 import Geometry
@@ -22,7 +22,6 @@ import Data.Bifunctor
 import Control.Lens
 --import qualified Streaming.Prelude as S
 
-type SPic =  (Shape, Picture)
 
 shMap :: (ShapeObj -> ShapeObj) -> Shape -> Shape
 shMap = map

src/ShapePicture/Data.hs

@@ -0,0 +1,4 @@
+module ShapePicture.Data where
+import Picture.Data
+import Shape.Data
+type SPic =  (Shape, Picture)