Comment out DeriveAnyClass extensions

src/Dodge/Creature/Action.hs

@@ -3,7 +3,6 @@
 -- | Actions performed by creatures within the world
 module Dodge.Creature.Action (
     performActions,
-    dropExcept,
     dropItem,
     blinkActionMousePos,
     blinkActionFail,
@@ -13,7 +12,6 @@ module Dodge.Creature.Action (
 
 import Control.Applicative
 import Control.Monad
-import Data.Bifunctor
 import Data.Foldable
 import Data.Maybe
 import Dodge.Base
@@ -35,6 +33,8 @@ import LensHelp
 import Linear
 import NewInt
 
+-- it is desirable to be able to determine when an action is finished,
+-- so that DoActionThen and the like are easy to define
 performActions :: Int -> World -> World
 performActions cid w =
     foldl'
@@ -45,59 +45,13 @@ performActions cid w =
     cr = w ^?! cWorld . lWorld . creatures . ix cid
     (iss, mayas) = foldMap (performAction cr w) $ cr ^. crActionPlan . apAction
 
-type OutAction = ([Impulse], [Action])
+type ActionUpdate = ([Impulse], [Action])
 
-performAimAt :: Creature -> World -> Int -> Point2 -> OutAction
-performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
-  where
-    cdir = _crDir cr
-    cpos = cr ^. crPos . _xy
-    canSee' = canSee (_crID cr) tcid w
-    aimSp = case crMvType cr ^? mvAimSpeed of
-        Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
-        Nothing -> error "creature without aiming type"
-    tpos
-        | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
-        | otherwise = p
-
-performPathTo :: Creature -> World -> Point2 -> OutAction
-performPathTo cr w p
-    | dist cpos p <= crRad (cr ^. crType) = ([], [])
-    | isWalkable cpos p w =
-        ( [MvTurnToward 0 cpos p p, MvForward, RandomTurn jit]
-        , [PathTo p]
-        )
-    | otherwise = case pointTowardsImpulse cpos p w of
-        Just q ->
-            (
-                [ MvTurnToward 1 cpos p q
-                , MvForward
-                , RandomTurn jit
-                ]
-            , [PathTo p]
-            )
-        _ -> ([ChangeStrategy Flee], [])
-  where
-    cpos = cr ^. crPos . _xy
-    jit = _mvTurnJit $ crMvType cr
-
-performTurnToA :: Creature -> Point2 -> OutAction
-performTurnToA cr p
-    | angleVV cdirv dirv < 0.1 = ([], [])
-    | otherwise = ([MvTurnToward 2 p p p, RandomTurn jit], [TurnToPoint p])
-  where
-    cpos = cr ^. crPos . _xy
-    cdirv = unitVectorAtAngle (_crDir cr)
-    dirv = p -.- cpos
-    jit = _mvTurnJit $ crMvType cr
-
-{- | Performing an action on a frame creates an OutAction:
-  adds impulses and updates or deletes the action itself.
+{- | Performing an action on a frame creates an ActionUpdate:
+  gives impulses and updates/deletes the action itself.
 -}
-performAction :: Creature -> World -> Action -> OutAction
+performAction :: Creature -> World -> Action -> ActionUpdate
 performAction cr w ac = case ac of
-    ActionNothing -> ([], mempty)
-    LabelAction str subAc -> second (fmap (LabelAction str)) $ performAction cr w subAc
     AimAt tcid p -> performAimAt cr w tcid p
     WaitThen 0 newAc -> ([], [newAc])
     WaitThen t newAc -> ([], [WaitThen (t -1) newAc])
@@ -145,15 +99,44 @@ performAction cr w ac = case ac of
         (imps, _) -> (imps, [DoReplicatePartial startac (t -1) startac])
     NoAction -> ([], mempty)
 
+performAimAt :: Creature -> World -> Int -> Point2 -> ActionUpdate
+performAimAt cr w tcid p = ([TurnToward tpos aimSp], [AimAt tcid tpos])
+  where
+    cdir = _crDir cr
+    cpos = cr ^. crPos . _xy
+    canSee' = canSee (_crID cr) tcid w
+    aimSp = case crMvType cr ^? mvAimSpeed of
+        Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
+        Nothing -> error "creature without aiming type"
+    tpos
+        | canSee' = w ^?! cWorld . lWorld . creatures . ix tcid . crPos . _xy
+        | otherwise = p
+
+performPathTo :: Creature -> World -> Point2 -> ActionUpdate
+performPathTo cr w p
+    | dist cpos p <= crRad (cr ^. crType) = mempty
+    | isWalkable cpos p w = gotowards p
+    | otherwise = case pointTowardsImpulse cpos p w of
+        Just q -> gotowards q
+        _ -> ([ChangeStrategy Flee], [])
+  where
+    gotowards q = ( [MvTurnToward q, MvForward, RandomTurn jit] , [PathTo p])
+    cpos = cr ^. crPos . _xy
+    jit = _mvTurnJit $ crMvType cr
+
+performTurnToA :: Creature -> Point2 -> ActionUpdate
+performTurnToA cr p
+    | angleVV cdirv dirv < 0.1 = mempty
+    | otherwise = ([MvTurnToward p, RandomTurn jit], [TurnToPoint p])
+  where
+    cpos = cr ^. crPos . _xy
+    cdirv = unitVectorAtAngle (_crDir cr)
+    dirv = p -.- cpos
+    jit = _mvTurnJit $ crMvType cr
+
 --setMinInvSize :: Int -> Creature -> World -> World
 --setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
 
----- maybe this should be removed...
---stripNoItems :: Creature -> World -> World
---stripNoItems cr =
---    organiseInvKeys (_crID cr)
---        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
---
 --organiseInvKeys :: Int -> World -> World
 --organiseInvKeys cid w =
 --    w & cWorld . lWorld . creatures . ix cid
@@ -167,12 +150,6 @@ performAction cr w ac = case ac of
 --    newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
 --    newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
 
-dropExcept :: Creature -> Int -> World -> World
-dropExcept cr invid w =
-    foldr (dropItem cr) w . IM.keys $
-        --        invid `IM.delete` _crInv cr
-        invid `IM.delete` _unNIntMap (_crInv cr)
-
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid w' =

src/Dodge/Creature/Impulse.hs

@@ -56,7 +56,7 @@ followImpulse cid w = \case
         tcr <- w ^? cWorld . lWorld . creatures . ix i
         return $ followImpulse cid w (doCrImp f tcr)
     MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld)
-    MvTurnToward _ _ _ p ->
+    MvTurnToward p ->
         crup $
             creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
   where