Tweak turrets

src/Dodge/Creature/Update.hs

@@ -7,7 +7,6 @@ import Dodge.Creature.State
 import Dodge.Data.World
 import Dodge.Humanoid
 import Dodge.Lampoid
-import Dodge.Turretoid
 import LensHelp
 import System.Random
 
@@ -15,7 +14,6 @@ updateCreature :: Creature -> World -> World
 updateCreature cr = case _crType cr of
     Lampoid{} -> updateLampoid cr
     Humanoid{} -> updateHumanoid cr
-    Turretoid{} -> updateTurretoid cr
     Barreloid{} -> updateBarreloid cr
     NonDrawnCreature -> id
 

src/Dodge/Data/Creature/Misc.hs

@@ -68,7 +68,6 @@ data CreatureType
         }
     | Barreloid {_barrelType :: BarrelType}
     | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
-    | Turretoid
     | NonDrawnCreature
     deriving (Eq, Ord, Show, Read)
 

src/Dodge/HeldUse.hs

@@ -490,7 +490,7 @@ coneRandItemParams = do
 mcShootLaser :: Item -> Machine -> World -> World
 mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
   where
-    pos = _mcPos mc
+    pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
     dir = mc ^?! mcType . _McTurret . tuDir
     phasev = _phaseV . _itParams $ it
     dam = _lasDamage $ _itParams it

src/Dodge/Item/Draw.hs

@@ -6,9 +6,10 @@ module Dodge.Item.Draw (
 ) where
 
 import Control.Lens
+import Data.Maybe
+import Dodge.Creature.HandPos
 import Dodge.Data.Creature
 import Dodge.Item.Draw.SPic
-import Dodge.Item.Equipment.Shape
 import Dodge.Item.HeldOffset
 import ShapePicture
 
@@ -18,3 +19,21 @@ itemEquipPict cr it = case it ^. itUse of
     ituse -> case ituse ^? equipEffect of
         Just _ -> pictureOnEquip (itemSPic it) cr it
         Nothing -> mempty
+
+pictureOnEquip :: SPic -> Creature -> Item -> SPic
+pictureOnEquip sp cr itm = fromMaybe mempty $ do
+    i <- itm ^? itLocation . ipInvID
+    epos <- cr ^? crInvEquipped . ix i
+    return $ equipPosition epos cr sp
+
+equipPosition :: EquipPosition -> Creature -> SPic -> SPic
+equipPosition epos cr sh = case epos of
+    OnLeftWrist -> translateToLeftWrist cr sh
+    OnRightWrist -> translateToRightWrist cr sh
+    OnLegs ->
+        translateToLeftLeg cr sh
+            <> translateToRightLeg cr (mirrorSPxz sh)
+    OnHead -> translateToHead cr sh
+    OnChest -> translateToChest cr sh
+    OnBack -> translateToBack cr sh
+    OnSpecial -> sh

src/Dodge/Item/Equipment/Shape.hs

@@ -1,25 +0,0 @@
-module Dodge.Item.Equipment.Shape where
-
-import Data.Maybe
-import Dodge.Creature.HandPos
-import Dodge.Data.Creature
-import LensHelp
-import ShapePicture
-
-pictureOnEquip :: SPic -> Creature -> Item -> SPic
-pictureOnEquip sp cr itm = fromMaybe mempty $ do
-    i <- itm ^? itLocation . ipInvID
-    epos <- cr ^? crInvEquipped . ix i
-    return $ equipPosition epos cr sp
-
-equipPosition :: EquipPosition -> Creature -> SPic -> SPic
-equipPosition epos cr sh = case epos of
-    OnLeftWrist -> translateToLeftWrist cr sh
-    OnRightWrist -> translateToRightWrist cr sh
-    OnLegs ->
-        translateToLeftLeg cr sh
-            <> translateToRightLeg cr (mirrorSPxz sh)
-    OnHead -> translateToHead cr sh
-    OnChest -> translateToChest cr sh
-    OnBack -> translateToBack cr sh
-    OnSpecial -> sh

src/Dodge/Item/HeldOffset.hs

@@ -3,35 +3,42 @@ module Dodge.Item.HeldOffset where
 import Data.Maybe
 import Dodge.Creature.HandPos
 import Dodge.Data.Creature
+import Dodge.Data.Machine
 import Geometry
 import LensHelp
 
+turretItemOffset :: Item -> Turret -> Machine -> Point3 -> Point3
+turretItemOffset it tu mc =
+    rotate3 (_tuDir tu - _mcDir mc) . (+.+.+ V3 0 0 shoulderHeight)
+        . transToHandle it
+
+transToHandle :: Item -> Point3 -> Point3
+transToHandle itm = fromMaybe id $ do
+    x <- itm ^? itUse . heldAim . aimHandlePos
+    return (-.-.- V3 x 0 0)
+
 heldItemOffset :: Item -> Creature -> Point3 -> Point3
 heldItemOffset itm cr
     | isSelected && _posture (_crStance cr) == Aiming =
-        (+.+.+ V3 (aimingWeaponZeroPos cr itm) 0 shoulderD)
+        (+.+.+ V3 (aimingWeaponZeroPos cr itm) 0 shoulderHeight)
     | isSelected && isTwoHandFlat =
         (+.+.+ V3 (_crRad cr) 0 handD)
             . rotate3 (twoFlatHRot cr)
-            . transToHandle
+            . transToHandle itm
     | isSelected && isOneHand =
         (+.+.+ V3 0 0 handD)
             . (+.+.+ V3 (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) 0)
             . (+.+.+ V3 (-2) 0 0)
-            . transToHandle
+            . transToHandle itm
     | isSelected =
         (+.+.+ V3 0 0 handD)
             . (+.+.+ V3 (_crRad cr) 0 0)
             . rotate3 (strideRot cr + 1.2)
             . (+.+.+ V3 (-5) 0 0)
             --        . (+.+.+ V3 (-5) 0 0)
-            . transToHandle
+            . transToHandle itm
     | otherwise = id
   where
-    transToHandle = fromMaybe id $ do
-        x <- itm ^? itUse . heldAim . aimHandlePos
-        return (-.-.- V3 x 0 0)
-    shoulderD = 18
     handD = 15
     isSelected = _itIsHeld itm
     handPos = case cr ^? crStance . carriage of
@@ -46,6 +53,9 @@ heldItemOffset itm cr
     f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
     sLen = _strideLength $ _crStance cr
 
+shoulderHeight :: Float
+shoulderHeight = 18
+
 strideRot :: Creature -> Float
 strideRot cr = case cr ^? crStance . carriage of
     Just (Walking x LeftForward) -> f x

src/Dodge/Machine/Draw.hs

@@ -1,7 +1,8 @@
 module Dodge.Machine.Draw
     where
+import Dodge.Item.HeldOffset
+import Dodge.Item.Draw.SPic
 import Dodge.Placement.TopDecoration
---import Dodge.Placement.Instance.Turret
 import Shape
 import Picture
 import Geometry
@@ -38,11 +39,13 @@ terminalShape mc = colorSH col (prismPoly
     col = _mcColor mc
 
 drawTurret :: Turret -> Machine -> SPic
-drawTurret _ mc =
-    ( rotateSH (- _mcDir mc) . colorSH (_mcColor mc) $ upperPrismPoly 20 (square w)
-    , mempty -- setLayer 5 $ scale 0.5 0.5 $ text $ show $ _mcDir mc )
+drawTurret tu mc =
+    ( colorSH (_mcColor mc) $ upperPrismPoly 20 (square w)
+    , mempty
     )
+    <> overPosSP (turretItemOffset it tu mc) (itemSPic it)
   where
+    it = _tuWeapon tu
     w = _mcWidth mc
 
 sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic

src/Dodge/Machine/Update.hs

@@ -16,6 +16,7 @@ import Dodge.WorldEvent.Explosion
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import Control.Monad
 
 updateMachine :: Machine -> World -> World
 updateMachine mc
@@ -32,7 +33,6 @@ mcTurretUpdate mc = case mc ^? mcType . _McTurret of
     Just tu -> updateTurret (_tuTurnSpeed tu) mc
     _ -> id
 
--- this needs a major cleanup
 updateTurret :: Float -> Machine -> World -> World
 updateTurret rotSpeed mc w
     | _mcHP mc < 1 =
@@ -57,13 +57,12 @@ updateTurret rotSpeed mc w
     mcid = _mcID mc
     ypos = _crPos $ you w
     mcpos = _mcPos mc
-    --mcdir = _mcDir mc
     seesYou = hasLOSIndirect mcpos ypos w
     (elecDams, dams) = partition isElectrical $ _mcDamage mc
     dam = sum $ map _dmAmount dams
     elecDam = sum $ map _dmAmount elecDams
     doTurn
-        | seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
+        | seesYou = cWorld . machines . ix mcid . mcType . _McTurret . tuDir %~ turnTo rotSpeed mcpos ypos
         | otherwise = id
     closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
     updateFiringStatus
@@ -75,14 +74,9 @@ mcUseItem mc = fromMaybe id $ do
     tu <- mc ^? mcType . _McTurret
     let it = tu ^. tuWeapon
     hit <- it ^? itType . iyBase . ibtHeld
+    guard (_tuFireTime tu > 0)
     return $ mcUseHeld hit it mc
 
---    maybeFire
---        | _tuFireTime (_mcType mc) > 0 =
---            fromMaybe id $ do
---                return $ tuUseItem
---        | otherwise = id
-
 mcSensorTriggerUpdate :: Machine -> World -> World
 mcSensorTriggerUpdate mc = fromMaybe id $ do
     trid <- mc ^? mcMounts . ix ObTrigger

src/Dodge/Render/ShapePicture.hs

@@ -1,71 +1,70 @@
-module Dodge.Render.ShapePicture
-    ( worldSPic
-    ) where
-import Dodge.Block.Draw
-import Dodge.Machine.Draw
-import Dodge.LinearShockwave.Draw
-import Dodge.Prop.Draw
-import Dodge.TractorBeam.Draw
-import Dodge.Shockwave.Draw
-import Dodge.Tesla.Arc.Draw
-import Dodge.Laser.Draw
-import Dodge.Cloud.Draw
-import Dodge.Zoning
-import Dodge.Button.Draw
-import Dodge.LightSource.Draw
-import Dodge.Targeting.Draw
-import Dodge.Beam.Draw
-import Dodge.RadarSweep.Draw
-import Dodge.Projectile.Draw
-import Dodge.Item.Draw.SPic
-import Dodge.EnergyBall.Draw
-import Dodge.Creature.Picture.Awareness
-import Dodge.Creature.Picture
-import Dodge.Flame.Draw
-import Dodge.Bullet.Draw
-import Dodge.Spark.Draw
-import Dodge.RadarBlip
-import Dodge.Flare
-import Dodge.ShortShow
-import Dodge.Data.Config
-import Dodge.Render.InfoBox
-import Dodge.Debug.Picture
-import Dodge.Picture.SizeInvariant
-import Dodge.Zone
-import Dodge.Data.World
-import Dodge.Base
-import Dodge.SoundLogic.LoadSound
-import Dodge.Graph
-import Dodge.GameRoom
-import Dodge.Update.Camera
-import Dodge.Render.List
-import Dodge.Path
-import Geometry
-import Geometry.Zone
-import ShapePicture
-import Picture
-import Sound.Data
-import Geometry.ConvexPoly
-import ShortShow
-import Polyhedra
+module Dodge.Render.ShapePicture (
+    worldSPic,
+) where
 
-import StreamingHelp
-import qualified IntMapHelp as IM -- Lazy?
-import qualified Data.Map.Strict as M
 import Control.Lens
-import Data.Maybe
-import qualified Streaming.Prelude as S
-import qualified Data.Graph.Inductive as FGL
-import qualified Data.Set as Set
-import Padding
 import Data.Foldable
+import qualified Data.Graph.Inductive as FGL
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import qualified Data.Set as Set
+import Dodge.Base
+import Dodge.Beam.Draw
+import Dodge.Block.Draw
+import Dodge.Bullet.Draw
+import Dodge.Button.Draw
+import Dodge.Cloud.Draw
+import Dodge.Creature.Picture
+import Dodge.Creature.Picture.Awareness
+import Dodge.Data.Config
+import Dodge.Data.World
+import Dodge.Debug.Picture
+import Dodge.EnergyBall.Draw
+import Dodge.Flame.Draw
+import Dodge.Flare
+import Dodge.GameRoom
+import Dodge.Graph
+import Dodge.Item.Draw.SPic
+import Dodge.Laser.Draw
+import Dodge.LightSource.Draw
+import Dodge.LinearShockwave.Draw
+import Dodge.Machine.Draw
+import Dodge.Path
+import Dodge.Picture.SizeInvariant
+import Dodge.Projectile.Draw
+import Dodge.Prop.Draw
+import Dodge.RadarBlip
+import Dodge.RadarSweep.Draw
+import Dodge.Render.InfoBox
+import Dodge.Render.List
+import Dodge.Shockwave.Draw
+import Dodge.ShortShow
+import Dodge.SoundLogic.LoadSound
+import Dodge.Spark.Draw
+import Dodge.Targeting.Draw
+import Dodge.Tesla.Arc.Draw
+import Dodge.TractorBeam.Draw
+import Dodge.Update.Camera
+import Dodge.Zone
+import Dodge.Zoning
+import Geometry
+import Geometry.ConvexPoly
+import Geometry.Zone
+import qualified IntMapHelp as IM
+import Padding
+import Picture
+import Polyhedra
+import ShapePicture
+import ShortShow
+import Sound.Data
+import qualified Streaming.Prelude as S
 
 singleSPic :: SPic -> SPic
 singleSPic = id
 
 worldSPic :: Configuration -> World -> SPic
-worldSPic cfig w 
-    =  singleSPic (mempty, extraPics cfig w)
+worldSPic cfig w =
+    singleSPic (mempty, extraPics cfig w)
         <> foldup drawProp' (filtOn _prPos _props)
         <> foldup drawProjectile (filtOn _prjPos _projectiles)
         <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
@@ -82,32 +81,38 @@ worldSPic cfig w
     pointIsClose = cullPoint cfig w
 
 anyTargeting :: Configuration -> World -> SPic
-anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
+anyTargeting cfig w = (mempty, pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
   where
     cr = you w
     f it = fmap (\g -> drawTargeting g it cr cfig w) (it ^? itTargeting . tgDraw)
 
 drawCreature :: Creature -> SPic
 drawCreature cr = case _crType cr of
-    Humanoid {} -> basicCrPict cr
-    Barreloid {} -> picAtCrPos1 (setDepth 20 $ pictures 
+    Humanoid{} -> basicCrPict cr
+    Barreloid{} ->
+        picAtCrPos1
+            ( setDepth 20 $
+                pictures
                     [ color orange $ circleSolid 10
                     , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
                     , color (greyN 0.5) $ circleSolid 8
-        ]) cr
-    Lampoid{_lampHeight=h} -> picAtCrPosNoRot1 (lampCrPic h) cr
-    Turretoid -> mempty
+                    ]
+            )
+            cr
+    Lampoid{_lampHeight = h} -> picAtCrPosNoRot1 (lampCrPic h) cr
     NonDrawnCreature -> mempty
 
 lampCrPic :: Float -> Picture
-lampCrPic h = pictures 
+lampCrPic h =
+    pictures
         [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
-    , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
+        , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h -1)
         ]
   where
     f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
-    --DrawnCreature f -> f cr
-    --
+
+--DrawnCreature f -> f cr
+--
 picAtCrPosNoRot1 :: Picture -> Creature -> SPic
 --{-# INLINE picAtCrPos #-}
 picAtCrPosNoRot1 thePic cr = (,) mempty $ uncurryV translate (_crPos cr) thePic
@@ -117,12 +122,14 @@ picAtCrPos1 :: Picture -> Creature -> SPic
 picAtCrPos1 thePic cr = (,) mempty $ tranRot (_crPos cr) (_crDir cr) thePic
 
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
-shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)
+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)
+shiftDraw' fpos fdir fdraw x =
+    uncurryV translateSPf (fpos x)
         . rotateSP (fdir x)
         $ fdraw x
 
@@ -132,13 +139,14 @@ cullPoint cfig w p
     | otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w)
 
 extraPics :: Configuration -> World -> Picture
-extraPics cfig w = pictures (_decorations (_cWorld w))
+extraPics cfig w =
+    pictures (_decorations (_cWorld w))
         <> concatMapPic drawTractorBeam (_tractorBeams (_cWorld w))
         <> concatMapPic drawLinearShockwave (_linearShockwaves (_cWorld w))
         <> concatMapPic drawShockwave (_shockwaves (_cWorld w))
         <> concatMapPic drawLaser (_lasersToDraw (_cWorld w))
         <> concatMapPic drawTeslaArc (_teslaArcs (_cWorld w))
---    <> concatMapPic drawParticle (_particles    w)
+        --    <> concatMapPic drawParticle (_particles    w)
         <> concatMapPic drawRadarSweep (_radarSweeps (_cWorld w))
         <> concatMapPic drawFlame (_flames (_cWorld w))
         <> concatMapPic drawEnergyBall (_energyBalls (_cWorld w))
@@ -150,8 +158,8 @@ extraPics cfig w = pictures (_decorations (_cWorld w))
         <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams (_cWorld w))
         <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources (_cWorld w))
         <> testPic cfig w
-    <> concatMapPic clDraw (_clouds (_cWorld w)      )
-    <> concatMapPic ppDraw (_pressPlates (_cWorld w) )
+        <> concatMapPic clDraw (_clouds (_cWorld w))
+        <> concatMapPic ppDraw (_pressPlates (_cWorld w))
         <> viewClipBounds cfig w
         <> debugDraw cfig w
 
@@ -160,13 +168,12 @@ debugDraw :: Configuration -> World -> Picture
 debugDraw cfig w
     | Show_debug `Set.member` _debug_booleans cfig =
         pic
-        <> 
-        setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
+            <> setLayer FixedCoordLayer (listPicturesAt (0.5 * halfWidth cfig) 0 cfig $ map text ts)
     | otherwise = mempty
   where
     (ts, pic) = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
 
-debugDraw' :: Configuration -> World -> DebugBool -> ([String],Picture)
+debugDraw' :: Configuration -> World -> DebugBool -> ([String], Picture)
 {-# INLINE debugDraw' #-}
 debugDraw' cfig w bl = case bl of
     Show_debug -> lstring "Show debug"
@@ -192,15 +199,16 @@ debugDraw' cfig w bl = case bl of
     Show_nodes_near_select -> rdraw $ drawNodesNearSelect w
     Show_path_between -> rdraw $ drawPathBetween w
   where
-    lstring str = ([str],mempty)
-    rdraw   pic = (mempty,pic)
+    lstring str = ([str], mempty)
+    rdraw pic = (mempty, pic)
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
 
 drawPathBetween :: World -> Picture
-drawPathBetween w = setLayer DebugLayer
-    $  color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist)
+drawPathBetween w =
+    setLayer DebugLayer $
+        color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist)
             <> foldMap (color green . arrow sp) (nodepos =<< walkableNodeNear w sp)
             <> foldMap (color cyan . flip arrow ep) (nodepos =<< walkableNodeNear w ep)
             <> foldMap (color orange . arrow sp) (pointTowardsImpulse sp ep w)
@@ -211,25 +219,28 @@ drawPathBetween w = setLayer DebugLayer
     ep = _rSelect w
 
 drawNodesNearSelect :: World -> Picture
-drawNodesNearSelect w = setLayer DebugLayer 
-    $  runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
+drawNodesNearSelect w =
+    setLayer DebugLayer $
+        runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
             <> color green (drawCross sp)
   where
     sp = _lSelect w
 
 drawInspectWalls :: World -> Picture
-drawInspectWalls w = foldMap (drawInspectWall w) 
-    $ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine)
-    $ IM.elems $ _walls (_cWorld w)
+drawInspectWalls w =
+    foldMap (drawInspectWall w) $
+        filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
+            IM.elems $ _walls (_cWorld w)
   where
-    (a,b) = _lLine w
+    (a, b) = _lLine w
 
 drawInspectWall :: World -> Wall -> Picture
-drawInspectWall w wl = setLayer DebugLayer
-    $  color rose (thickLine 3 [a,b])
+drawInspectWall w wl =
+    setLayer DebugLayer $
+        color rose (thickLine 3 [a, b])
             <> foldMap (drawDoorPaths w) (wl ^? wlStructure . wsDoor)
   where
-    (a,b) = _wlLine wl 
+    (a, b) = _wlLine wl
 
 drawDoorPaths :: World -> Int -> Picture
 drawDoorPaths w drid = fromMaybe mempty $ do
@@ -237,8 +248,9 @@ drawDoorPaths w drid = fromMaybe mempty $ do
     return $ foldMap (drawPathEdge . (^. _3)) paths
 
 drawPathEdge :: PathEdge -> Picture
-drawPathEdge pe = setLayer DebugLayer 
-    $ multiArrow (_peStart pe) (_peEnd pe) green (Set.map obstacleColor (_peObstacles pe)) 
+drawPathEdge pe =
+    setLayer DebugLayer $
+        multiArrow (_peStart pe) (_peEnd pe) green (Set.map obstacleColor (_peObstacles pe))
 
 obstacleColor :: EdgeObstacle -> Color
 obstacleColor eo = case eo of
@@ -248,30 +260,36 @@ obstacleColor eo = case eo of
     BlockObstacle -> blue
 
 drawWorldSelect :: World -> Picture
-drawWorldSelect w = setLayer DebugLayer
-    $  color cyan (line [a,b])
-    <> color magenta (line [c,d])
+drawWorldSelect w =
+    setLayer DebugLayer $
+        color cyan (line [a, b])
+            <> color magenta (line [c, d])
   where
-    (a,b) = _lLine w
-    (c,d) = _rLine w
+    (a, b) = _lLine w
+    (c, d) = _rLine w
 
 drawFarWallDetect :: World -> Picture
-drawFarWallDetect w = setLayer DebugLayer 
+drawFarWallDetect w =
+    setLayer DebugLayer
         . color yellow
-    . foldMap (\q -> line 
+        . foldMap
+            ( \q ->
+                line
                     [ p
                     , fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w
-        ]   )
+                    ]
+            )
         $ runIdentity $ S.toList_ $ streamViewpoints p w
   where
     p = _cameraViewFrom (_cWorld w)
 
 drawDDATest :: World -> Picture
-drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
+drawDDATest w =
+    runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
         <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
         <> runIdentity (S.foldMap_ drawCross qs)
         <> color blue (runIdentity (S.foldMap_ drawCross qs'))
-    <> setLayer DebugLayer (color yellow (line [cvf,mwp]))
+        <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
   where
     cvf = _cameraViewFrom (_cWorld w)
     mwp = mouseWorldPos w
@@ -284,13 +302,14 @@ drawCross :: Point2 -> Picture
 drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5
 
 crossPic :: Float -> Picture
-crossPic x = line [V2 x x,V2 (-x) (-x)] <> line [V2 (-x) x,V2 x (-x)]
+crossPic x = line [V2 x x, V2 (- x) (- x)] <> line [V2 (- x) x, V2 x (- x)]
 
 drawZoneCol :: Color -> Float -> V2 Int -> Picture
-drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p:ps ++ [p])
+drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])
   where
-    (p:ps) = zipWith (+.+) innerSquare 
-        $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)]
+    (p : ps) =
+        zipWith (+.+) innerSquare $
+            map ((s *.*) . (each %~ fromIntegral)) [V2 x y, V2 (x + 1) y, V2 (x + 1) (y + 1), V2 x (y + 1)]
 
 innerSquare :: [Point2]
 innerSquare = [V2 1 1, V2 (-1) 1, V2 (-1) (-1), V2 1 (-1)]
@@ -298,38 +317,47 @@ innerSquare = [V2 1 1, V2 (-1) 1, V2 (-1) (-1), V2 1 (-1)]
 drawWallSearchRays :: World -> Picture
 drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
   where
-    f p = setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5)
+    f p =
+        setLayer DebugLayer $
+            color yellow $
+                uncurryV translate p (circle 5)
                     <> line [_cameraViewFrom (_cWorld w), p]
 
 testPic :: Configuration -> World -> Picture
 testPic _ _ = mempty
 
 drawBoundingBox :: World -> Picture
-drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
+drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
   where
-    (x:xs) = _boundBox (_cWorld w)
+    (x : xs) = _boundBox (_cWorld w)
 
 clDraw :: Cloud -> Picture
 clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
+
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
+
 floorItemSPic :: FloorItem -> SPic
-floorItemSPic flit = uncurryV translateSPf (_flItPos flit)
-    $ rotateSP (_flItRot flit) (itemSPic (_flIt flit))
+floorItemSPic flit =
+    uncurryV translateSPf (_flItPos flit) $
+        rotateSP (_flItRot flit) (itemSPic (_flIt flit))
 
 btSPic :: Button -> SPic
-btSPic bt = uncurryV translateSPf (_btPos bt)
-    $ rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
+btSPic bt =
+    uncurryV translateSPf (_btPos bt) $
+        rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
+
 mcSPic :: Machine -> SPic
-mcSPic mc = uncurryV translateSPf (_mcPos mc)
-    $ rotateSP (_mcDir mc) (drawMachine mc)
+mcSPic mc =
+    uncurryV translateSPf (_mcPos mc) $
+        rotateSP (_mcDir mc) (drawMachine mc)
 
 soundPic :: Configuration -> World -> Sound -> Picture
 soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
   where
     p = _soundPos s
-    thePic 
-        = rotate (_cameraRot (_cWorld w)) 
+    thePic =
+        rotate (_cameraRot (_cWorld w))
             . scale theScale theScale
             . centerText
             . soundToOnomato
@@ -338,7 +366,8 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
     f x = 1 - 0.5 * (1 - x)
 
 drawMousePosition :: Configuration -> World -> Picture
-drawMousePosition cfig w = setLayer FixedCoordLayer . winScale cfig
+drawMousePosition cfig w =
+    setLayer FixedCoordLayer . winScale cfig
         . uncurryV translate p
         . scale 0.1 0.1
         . text
@@ -352,7 +381,8 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w))
   where
     f wl
         | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
-        | otherwise = winScale cfig
+        | otherwise =
+            winScale cfig
                 . uncurryV translate p
                 . scale 0.1 0.1
                 . text
@@ -369,24 +399,28 @@ edgeToPic poly pe
     ep = _peEnd pe
 
 drawPathing :: Configuration -> World -> Picture
-drawPathing cfig w = setLayer DebugLayer
-    $  foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
+drawPathing cfig w =
+    setLayer DebugLayer $
+        foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
             <> foldMap dispInc (graphToIncidence gr)
   where
-    dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
+    dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
     gr = _pathGraph (_cWorld w)
 
-crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String])
+crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String])
 crDisplayInfo cfig w cr
     | _crID cr == 0 = Nothing
-    | crOnScreen = Just (_crPos cr, catMaybes
---        [fmap show $ ap ^? crGoal
+    | crOnScreen =
+        Just
+            ( _crPos cr
+            , catMaybes
+                --        [fmap show $ ap ^? crGoal
                 [ fpreShow "crHP" $ cr ^? crHP
                 , fpreShow "crStrategy" $ ap ^? apStrategy
                 , fmap (("crPos....." ++) . shortShow) $ cr ^? crPos
                 , fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance
---        , fmap show $ cr ^? crOldPos
-        , fpreShow "crAction" $ ap ^? apAction
+                , --        , fmap show $ cr ^? crOldPos
+                  fpreShow "crAction" $ ap ^? apAction
                 , fpreShow "crImpulse" $ ap ^? apImpulse
                 ]
             )
@@ -395,34 +429,39 @@ crDisplayInfo cfig w cr
     ap = _crActionPlan cr
     crOnScreen = pointOnScreen cfig w $ _crPos cr
 
-fpreShow :: (Show a,Functor f) => String -> f a -> f String
-fpreShow str = fmap (((rightPad 7 '.'str ++ "...") ++) . show)
+fpreShow :: (Show a, Functor f) => String -> f a -> f String
+fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
 
 drawCrInfo :: Configuration -> World -> Picture
-drawCrInfo cfig w = setLayer FixedCoordLayer 
-        $ renderInfoListsAt (2*hw - 400) 0 cfig w
-        $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w)
+drawCrInfo cfig w =
+    setLayer FixedCoordLayer $
+        renderInfoListsAt (2 * hw - 400) 0 cfig w $
+            mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w)
   where
     hw = halfWidth cfig
 
 viewBoundaries :: World -> Picture
-viewBoundaries w = setLayer DebugLayer $ color green (foldMap (polygonWire . _grBound) grs)
-    <> color yellow (foldMap (\q -> line [p,q]) $ farWallPoints p w)
+viewBoundaries w =
+    setLayer DebugLayer $
+        color green (foldMap (polygonWire . _grBound) grs)
+            <> color yellow (foldMap (\q -> line [p, q]) $ farWallPoints p w)
   where
     p = _crPos $ you w
     grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
 
 viewClipBounds :: Configuration -> World -> Picture
 viewClipBounds cfig w
-    | _debug_view_clip_bounds cfig == AllRoomClipBoundaries
-         = setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w))
-    | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries
-        = setLayer DebugLayer $ f (_roomClipping (_cWorld w))
+    | _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
+        setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w))
+    | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries =
+        setLayer DebugLayer $ f (_roomClipping (_cWorld w))
     | otherwise = mempty
   where
-    f (x:xs) = g x xs <> f xs
+    f (x : xs) = g x xs <> f xs
     f [] = mempty
-    g x (y:ys) | convexPolysOverlap x y = color green (polygonWire $ _cpPoints x) 
+    g x (y : ys)
+        | convexPolysOverlap x y =
+            color green (polygonWire $ _cpPoints x)
                 <> color yellow (polygonWire $ _cpPoints y)
                 <> g x ys
         | otherwise = g x ys

src/Dodge/Turretoid.hs

@@ -1,8 +0,0 @@
-module Dodge.Turretoid where
-
-import Dodge.Creature.Impulse
-import Dodge.Creature.State
-import Dodge.Data.World
-
-updateTurretoid :: Creature -> World -> World
-updateTurretoid = stateUpdate followThenClearImpulses