Cleanup, split CWorld into separate file

src/Dodge/Creature/Action.hs

@@ -1,61 +1,51 @@
 --{-# LANGUAGE TupleSections #-}
-{- | Actions performed by creatures within the world
- -}
-module Dodge.Creature.Action 
-    ( performActions
-    , stripNoItems
-    , setMinInvSize
-    , dropUnselected
-    , dropExcept
-    , dropItem
---    , startReloadingWeapon
-    , blinkAction
-    , blinkActionFail
-    , unsafeBlinkAction
-    , sizeSelf
---    , crAutoReload
-    , copyInvItemToFloor
-    , youDropItem
-    , pickUpItem
-    , pickUpItemID
-    )
-    where
-import Dodge.FloatFunction
-import Dodge.Inventory.Add
-import Dodge.CreatureEffect
---import Dodge.ShortShow
-import Dodge.Path
-import Dodge.Default
-import Dodge.WallCreatureCollisions
-import Dodge.Creature.Stance.Data
-import Dodge.WorldEvent.Shockwave
-import Dodge.Data
-import Dodge.Base
---import Dodge.Zone
-import Dodge.SoundLogic
---import Dodge.WorldEvent
-import Dodge.Inventory
-import Dodge.FloorItem
---import Dodge.LightSources
-import Geometry
-import Picture
-import qualified IntMapHelp as IM
-import LensHelp
 
---import Control.Monad
---import Control.Applicative
-import Data.Maybe
+-- | Actions performed by creatures within the world
+module Dodge.Creature.Action (
+    performActions,
+    stripNoItems,
+    setMinInvSize,
+    dropUnselected,
+    dropExcept,
+    dropItem,
+    blinkAction,
+    blinkActionFail,
+    unsafeBlinkAction,
+    sizeSelf,
+    copyInvItemToFloor,
+    youDropItem,
+    pickUpItem,
+    pickUpItemID,
+) where
 import Data.Bifunctor
 import Data.List (findIndex)
---import qualified Data.Map as M
+import Data.Maybe
+import Dodge.Base
+import Dodge.CreatureEffect
+import Dodge.Data
+import Dodge.Default
+import Dodge.FloatFunction
+import Dodge.FloorItem
+import Dodge.Inventory
+import Dodge.Inventory.Add
+import Dodge.Path
+import Dodge.SoundLogic
+import Dodge.WallCreatureCollisions
+import Dodge.WorldEvent.Shockwave
+import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
+import Picture
+
 performActions :: World -> Creature -> Creature
-performActions w cr = cr
-    & crActionPlan . apImpulse .~ concat iss
-    & crActionPlan . apAction .~ catMaybes mayas
+performActions w cr =
+    cr
+        & crActionPlan . apImpulse .~ concat iss
+        & crActionPlan . apAction .~ catMaybes mayas
   where
     (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . apAction
 
-type OutAction = ( [Impulse] , Maybe Action )
+type OutAction = ([Impulse], Maybe Action)
 
 performAimAt :: Creature -> World -> Int -> Point2 -> OutAction
 performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
@@ -66,22 +56,24 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
     aimSp = case cr ^? crMvType . mvAimSpeed of
         Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
         Nothing -> error "creature without aiming type"
-    tpos | canSee'   = _crPos (_creatures (_cWorld w) IM.! tcid)
-         | otherwise = p
+    tpos
+        | canSee' = _crPos (_creatures (_cWorld w) IM.! tcid)
+        | otherwise = p
 
 performPathTo :: Creature -> World -> Point2 -> OutAction
 performPathTo cr w p
     | dist cpos p <= _crRad cr = ([], Nothing)
-    | isWalkable cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
+    | isWalkable cpos p w = ([MvTurnToward p, MvForward, RandomTurn jit], Just (PathTo p))
     | otherwise = case pointTowardsImpulse p cpos w of
-        Just q -> ([MvTurnToward q
-                ,MvForward
-                ,RandomTurn jit
---                ,ArbitraryImpulseEffect . const 
---                    $ debugPicture .~ drawPathList cpos p w
-                ] 
-            , Just (PathTo p))
-        _ -> ([],Nothing)
+        Just q ->
+            (
+                [ MvTurnToward q
+                , MvForward
+                , RandomTurn jit
+                ]
+            , Just (PathTo p)
+            )
+        _ -> ([], Nothing)
   where
     cpos = _crPos cr
     jit = _mvTurnJit $ _crMvType cr
@@ -89,7 +81,7 @@ performPathTo cr w p
 performTurnToA :: Creature -> Point2 -> OutAction
 performTurnToA cr p
     | angleVV cdirv dirv < 0.1 = ([], Nothing)
-    | otherwise = ([MvTurnToward p,RandomTurn jit] , Just (TurnToPoint p))
+    | otherwise = ([MvTurnToward p, RandomTurn jit], Just (TurnToPoint p))
   where
     cpos = _crPos cr
     cdirv = unitVectorAtAngle (_crDir cr)
@@ -98,29 +90,29 @@ performTurnToA cr p
 
 {- | Performing an action means that a creature has some impulses for a frame, and
  updates or deletes the action itself.
--- doAction -}
+-}
 performAction :: Creature -> World -> Action -> OutAction
 performAction cr w ac = case ac of
-    ActionNothing -> ([],Nothing)
+    ActionNothing -> ([], Nothing)
     LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc
     AimAt tcid p -> performAimAt cr w tcid p
-    WaitThen 0 newAc -> ([] , Just newAc)
-    WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))
-    ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
-    ImpulsesList _  -> ([], Nothing)
+    WaitThen 0 newAc -> ([], Just newAc)
+    WaitThen t newAc -> ([], Just (WaitThen (t -1) newAc))
+    ImpulsesList (xs : xss) -> (xs, Just $ ImpulsesList xss)
+    ImpulsesList _ -> ([], Nothing)
     DoImpulses imps -> (imps, Nothing)
     DoActionThen fsta afta -> case performAction cr w fsta of
-        (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta))
-        (imps , Nothing  ) -> (imps, Just afta)
+        (imps, Just nxta) -> (imps, Just (DoActionThen nxta afta))
+        (imps, Nothing) -> (imps, Just afta)
     DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
     DoActionWhilePartial partAc f resetAc
         | doWdCrBl f w cr -> case performAction cr w partAc of
             (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc)
-            (imps, Nothing)   -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
+            (imps, Nothing) -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
         | otherwise -> performAction cr w partAc
     DoActionIf f ifa
         | doWdCrBl f w cr -> performAction cr w ifa
-        | otherwise -> ([],Nothing)
+        | otherwise -> ([], Nothing)
     DoActionIfElse ifa f elsea
         | doWdCrBl f w cr -> performAction cr w ifa
         | otherwise -> performAction cr w elsea
@@ -128,190 +120,206 @@ performAction cr w ac = case ac of
         | doWdCrBl f w cr -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta)
         | otherwise -> performAction cr w afta
     DoActions [] -> ([], Nothing)
-    DoActions acs -> 
+    DoActions acs ->
         let (imps, newAcs) = unzip $ map (performAction cr w) acs
-        in (concat imps, Just . DoActions $ catMaybes newAcs)
+         in (concat imps, Just . DoActions $ catMaybes newAcs)
     StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
     PathTo p -> performPathTo cr w p
     TurnToPoint p -> performTurnToA cr p
     LeadTarget p -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
-        _        -> ([], Nothing)
+        _ -> ([], Nothing)
     UseTarget f -> performAction cr w $ doMCrAc f $ cr ^? crIntention . targetCr . _Just
-    UseSelf f   -> performAction cr w $ doCrAc f cr
+    UseSelf f -> performAction cr w $ doCrAc f cr
     UseAheadPos f -> performAction cr w (doP2Ac f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
     UseMvTargetPos f -> performAction cr w $ doMP2Ac f $ _mvToPoint $ _crIntention cr
     ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
     DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
         (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
-        (imp, _)          -> (sideImp ++ imp, Nothing)
+        (imp, _) -> (sideImp ++ imp, Nothing)
     DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
-    DoReplicatePartial _   0 pac -> performAction cr w pac
+    DoReplicatePartial _ 0 pac -> performAction cr w pac
     DoReplicatePartial startac t partac -> case performAction cr w partac of
-        (imps , Just nextac) -> (imps, Just $ DoReplicatePartial startac t nextac)
-        (imps , _)        -> (imps, Just $ DoReplicatePartial startac (t-1) startac)
-    NoAction -> ([],Nothing)
+        (imps, Just nextac) -> (imps, Just $ DoReplicatePartial startac t nextac)
+        (imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac)
+    NoAction -> ([], Nothing)
 
-{- | Like a blink action, but no ingoing distortion -}
-blinkActionFail
-    :: Creature
-    -> World 
-    -> World
-blinkActionFail cr w = w
-    & soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
-    & cWorld . distortions .:~ distortionBulge
-    & cWorld . creatures . ix cid . crPos .~ p3
-    & inverseShockwaveAt cpos 40 2 2
+-- | Like a blink action, but no ingoing distortion
+blinkActionFail ::
+    Creature ->
+    World ->
+    World
+blinkActionFail cr w =
+    w
+        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
+        & cWorld . distortions .:~ distortionBulge
+        & cWorld . creatures . ix cid . crPos .~ p3
+        & inverseShockwaveAt cpos 40 2 2
   where
     distR = 120
     distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
-    cid  = _crID cr
+    cid = _crID cr
     p1 = mouseWorldPos w
     cpos = _crPos cr
     p2 = bouncePoint (const True) 1 cpos p1 w
-    r  = 1.5 * _crRad cr
+    r = 1.5 * _crRad cr
     p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
 
-{- | Teleport a creature to the mouse position -}
+-- | Teleport a creature to the mouse position
 blinkAction :: Creature -> World -> World
-blinkAction cr w = w
-    & soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
-    & cWorld . distortions .++~ distortionBulge 
-    & cWorld . creatures . ix cid . crPos .~ p3
-    & blinkShockwave cid p3
-    & inverseShockwaveAt cpos 40 2 2
+blinkAction cr w =
+    w
+        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
+        & cWorld . distortions .++~ distortionBulge
+        & cWorld . creatures . ix cid . crPos .~ p3
+        & blinkShockwave cid p3
+        & inverseShockwaveAt cpos 40 2 2
   where
     distR = 120
-    distortionBulge = 
-        [RadialDistortion p3   (p3 +.+ V2 distR 0)   (p3 +.+ V2 0 distR)   0.1
-        ,RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+    distortionBulge =
+        [ 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
+    cid = _crID cr
     p1 = mouseWorldPos w
     cpos = _crPos cr
     p2 = bouncePoint (const True) 1 cpos p1 w
-    r  = 1.5 * _crRad cr
+    r = 1.5 * _crRad cr
     p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
 
 {- | Teleport a creature to the mouse position.
-Can go through walls, if ending up in wall does big damage. -}
-unsafeBlinkAction 
-    :: Creature
-    -> World 
-    -> World
-unsafeBlinkAction cr w 
-    | success = soundMultiFrom [TeleSound 0,TeleSound 1] mwp teleS Nothing
-        . (cWorld . distortions .++~ distortionBulge)
-        . set (cWorld . creatures . ix cid . crPos) mwp
-        . blinkShockwave cid mwp
-        $ inverseShockwaveAt cpos 40 2 2 w
-    | otherwise = w 
-        & blinkActionFail cr
-        & cWorld . creatures . ix cid . crState . csDamage .:~
-            Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
+Can go through walls, if ending up in wall does big damage.
+-}
+unsafeBlinkAction ::
+    Creature ->
+    World ->
+    World
+unsafeBlinkAction cr w
+    | success =
+        soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
+            . (cWorld . distortions .++~ distortionBulge)
+            . set (cWorld . creatures . ix cid . crPos) mwp
+            . blinkShockwave cid mwp
+            $ inverseShockwaveAt cpos 40 2 2 w
+    | otherwise =
+        w
+            & blinkActionFail cr
+            & cWorld . creatures . ix cid . crState . csDamage
+                .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
   where
     success = fromMaybe True $ do
         wl <- snd $ collidePointWallsFilterStream (const True) mwp cpos w
         return (isLHS mwp `uncurry` _wlLine wl)
     distR = 120
-    distortionBulge = 
-        [RadialDistortion mwp   (mwp +.+ V2 distR 0) (mwp +.+ V2 0 distR)  0.1
-        ,RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+    distortionBulge =
+        [ RadialDistortion mwp (mwp +.+ V2 distR 0) (mwp +.+ V2 0 distR) 0.1
+        , RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
         ]
-    cid  = _crID cr
+    cid = _crID cr
     mwp = mouseWorldPos w
     cpos = _crPos cr
 
-blinkShockwave 
-    :: Int      -- ^ Blinking creature ID.
-    -> Point2 
-    -> World 
-    -> World
-blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan 
+blinkShockwave ::
+    -- | Blinking creature ID.
+    Int ->
+    Point2 ->
+    World ->
+    World
+blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
 
 setMinInvSize :: Int -> Creature -> World -> World
 setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
 
 -- maybe this should be removed...
 stripNoItems :: Creature -> World -> World
-stripNoItems cr = organiseInvKeys (_crID cr) .
-    ( cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just )
+stripNoItems cr =
+    organiseInvKeys (_crID cr)
+        . (cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
 
 organiseInvKeys :: Int -> World -> World
-organiseInvKeys cid w = w & cWorld . creatures . ix cid %~
-    ( ( crInvSel . iselPos .~ newSelKey ) 
-    . ( crInv .~ newInv ) 
-    . ( crInvSel . iselAction .~ NoInvSelAction) )
+organiseInvKeys cid w =
+    w & cWorld . creatures . ix cid
+        %~ ( (crInvSel . iselPos .~ newSelKey)
+                . (crInv .~ newInv)
+                . (crInvSel . iselAction .~ NoInvSelAction)
+           )
   where
-    cr  = _creatures (_cWorld w) IM.! cid
+    cr = _creatures (_cWorld w) IM.! cid
     pairs = IM.toList (_crInv cr)
-    newSelKey = fromMaybe 0 $ findIndex ( (== crSel cr) . fst) pairs
-    newInv = IM.fromAscList $ zip [0..] $ map snd pairs
+    newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
+    newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
 
 dropUnselected :: Creature -> World -> World
-dropUnselected cr w = foldr (dropItem cr) w . IM.keys 
-    $ crSel cr `IM.delete` _crInv cr 
+dropUnselected cr w =
+    foldr (dropItem cr) w . IM.keys $
+        crSel cr `IM.delete` _crInv cr
 
 dropExcept :: Creature -> Int -> World -> World
-dropExcept cr invid w = foldr (dropItem cr) w . IM.keys 
-    $ invid `IM.delete` _crInv cr 
+dropExcept cr invid w =
+    foldr (dropItem cr) w . IM.keys $
+        invid `IM.delete` _crInv cr
 
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . mayberemoveequip
   where
     cid = _crID cr
+
 -- the following should be done in rmInvItem
 --    mayberemoveequip = case _crLeftInvSel cr of
 --        Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
 --        _ -> id
 
 youDropItem :: World -> World
-youDropItem w 
+youDropItem w
     | _crInvLock (you w) = w
     | otherwise = youDropItem' w
 
-{- | Get your creature to drop the item under the cursor.  -}
+-- | Get your creature to drop the item under the cursor.
 youDropItem' :: World -> World
 youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
-    Just Uncursed -> w
-        & dropItem cr (crSel cr) 
-        & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
+    Just Uncursed ->
+        w
+            & dropItem cr (crSel cr)
+            & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
     _ -> w
   where
     cr = you w
 
-{- | Copy an inventory item to the floor.  -}
+-- | Copy an inventory item to the floor.
 copyInvItemToFloor :: Creature -> Int -> World -> World
-copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) 
-    $ _crInv cr IM.! i 
-        & itIsHeld .~ False
+copyInvItemToFloor cr i =
+    copyItemToFloor (_crPos cr) $
+        _crInv cr IM.! i
+            & itIsHeld .~ False
 
 sizeSelf :: Float -> Creature -> World -> Maybe World
-sizeSelf x cr w 
-    -- | _crPos cr1 == _crPos cr2 = Just $ w
-    | not (crOnWall cr1 w) = Just $ w
-        & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
-        & cWorld . distortions .:~ distortionBulge
-        & cWorld . creatures . ix cid %~ 
-            ( (crRad .~ 10 * x) 
-            . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
-            . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
-            )
+sizeSelf x cr w
+    | not (crOnWall cr1 w) =
+        Just $
+            w
+                & soundMultiFrom [TeleSound 0, TeleSound 1] cpos teleS Nothing
+                & cWorld . distortions .:~ distortionBulge
+                & cWorld . creatures . ix cid
+                    %~ ( (crRad .~ 10 * x)
+                            . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
+                            . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
+                       )
     | otherwise = Nothing
   where
-    cr1 = colCrWall w (cr {_crRad = 10* x})
+    cr1 = colCrWall w (cr{_crRad = 10 * x})
     distR = 120
-    distortionBulge 
-        | _crRad cr < 10*x  = raddist 1.9
-        | otherwise         = raddist 0.1
+    distortionBulge
+        | _crRad cr < 10 * x = raddist 1.9
+        | otherwise = raddist 0.1
     raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR)
-    cid  = _crID cr
+    cid = _crID cr
     cpos = _crPos cr
 
 pickUpItemID :: Int -> Int -> World -> World
 pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w
 
-{- | Pick up a specific item. -}
+-- | Pick up a specific item.
 pickUpItem :: Int -> FloorItem -> World -> World
-pickUpItem cid flit w = maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd)
-    $ tryPutItemInInv cid flit w
+pickUpItem cid flit w =
+    maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
+        tryPutItemInInv cid flit w

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,6 +1,7 @@
 module Dodge.Creature.Impulse.UseItem
     ( useItem
     , useLeftItem
+    , itemEffect
     ) where
 import Dodge.Data
 import Dodge.Luse
@@ -41,8 +42,8 @@ itemEffect cr it w = case it ^? itUse of
         HammerUp -> f w
         _ -> w & setuhamdown
     setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
-    doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions (_cWorld w)) (crSel cr) cr
-        . activateEquipmentAt (_rbOptions (_cWorld w)) cr)
+    doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
+        . activateEquipmentAt (_rbOptions w) cr)
 
 tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
 tryReload cr it w f

src/Dodge/Creature/Memory/Data.hs

@@ -1,18 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.Memory.Data
-    where
-import GHC.Generics
-import Data.Aeson
-import Geometry.Data
-import Control.Lens
-data Memory = Memory
-    { _soundsToInvestigate :: [Point2]
-    , _nodesSearched       :: [Int]
-    }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Memory  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Memory 
-makeLenses ''Memory

src/Dodge/Creature/Perception/Data.hs

@@ -1,82 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.Perception.Data
-    ( Perception (..)
-    , Vigilance (..)
-    , Attention (..)
-    , Awareness (..)
-    , Vision (..)
-    , Audition (..)
-    -- lenses
-    , getAttentiveTo
-    , getFixated
-    , cpAttention
-    , cpVigilance
-    , cpAwareness
-    , cpVision
-    , cpAudition
-    , viFOV
-    , viDist
-    , auDist
-    )
-    where
-import GHC.Generics
-import Data.Aeson
-import Control.Lens
-import Dodge.Data.FloatFunction
-import qualified IntMapHelp as IM
-data Perception = Perception
-    { _cpVigilance     :: Vigilance
-    , _cpAttention     :: Attention
-    , _cpAwareness     :: IM.IntMap Awareness
-    , _cpVision         :: Vision
-    , _cpAudition       :: Audition
-    }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Perception  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Perception 
-data Vision = Eyes
-    { _viFOV  :: FloatFloat
-    , _viDist :: FloatFloat
-    }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Vision  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Vision 
-newtype Audition = Ears
-    { _auDist :: FloatFloat
-    }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Audition  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Audition 
-data Vigilance
-    = Comatose
-    | Asleep
-    | Lethargic
-    | Vigilant
-    | Overstrung
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Vigilance where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Vigilance
-data Attention
-    = AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness }
-    | Fixated {_getFixated :: Int }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Attention where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Attention
-data Awareness
-    = Suspicious Float
-    | Cognizant Float
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Awareness where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Awareness
-makeLenses ''Perception
-makeLenses ''Vision
-makeLenses ''Audition
-makeLenses ''Attention

src/Dodge/Creature/Stance/Data.hs

@@ -1,50 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.Stance.Data
-  where
-import GHC.Generics
-import Data.Aeson
-import Geometry.Data
-
-import Control.Lens
-data Stance = Stance 
-    {_carriage     :: Carriage
-    ,_posture      :: Posture
-    ,_strideLength :: Int
-    }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Stance  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Stance 
-data Carriage 
-    = Walking 
-        { _strideAmount :: Int 
-        , _currentFoot :: FootForward
-        }
-    | Standing
-    | Floating
-    | Flying
-    | Boosting Point2
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Carriage  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Carriage 
-data FootForward
-    = LeftForward
-    | RightForward
-    | WasLeftForward
-    | WasRightForward
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON FootForward where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON FootForward
-data Posture = Aiming 
-    | AtEase
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Posture  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Posture 
-makeLenses ''Stance
-makeLenses ''Carriage
-makeLenses ''Posture