Tweak turrets

2022-07-28 13:46:22 +01:00
parent 8aeabf3f6c
commit ec4ff84c46
10 changed files with 337 additions and 308 deletions
@@ -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

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

@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -1,113 +1,118 @@
-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)
-    <> foldup drawProp' (filtOn _prPos _props)                             
-    <> foldup drawProjectile (filtOn _prjPos _projectiles)                             
-    <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)           
-    <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)   
-    <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)                            
-    <> foldup drawCreature (filtOn _crPos _creatures)                          
-    <> foldup floorItemSPic (filtOn _flItPos _floorItems)                         
-    <> foldup btSPic (filtOn _btPos _buttons)                                     
-    <> foldup mcSPic (filtOn _mcPos _machines)                                    
-    <> singleSPic (anyTargeting 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)
+        <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
+        <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
+        <> foldup drawCreature (filtOn _crPos _creatures)
+        <> foldup floorItemSPic (filtOn _flItPos _floorItems)
+        <> foldup btSPic (filtOn _btPos _buttons)
+        <> foldup mcSPic (filtOn _mcPos _machines)
+        <> singleSPic (anyTargeting cfig w)
  where
    foldup = foldMap'
    filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld 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 
-        [ 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
+    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
    NonDrawnCreature -> mempty

 lampCrPic :: Float -> Picture
-lampCrPic h = pictures 
-    [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
-    , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
-    ]
+lampCrPic h =
+    pictures
+        [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
+        , 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,93 +122,96 @@ 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)
-    . rotateSP (fdir x)
-    $ fdraw x 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)
-    . rotateSP (fdir x)
-    $ fdraw x
+shiftDraw' fpos fdir fdraw x =
+    uncurryV translateSPf (fpos x)
+        . rotateSP (fdir x)
+        $ fdraw x

 cullPoint :: Configuration -> World -> Point2 -> Bool
-cullPoint cfig w p 
+cullPoint cfig w p
    | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox (_cWorld w))
    | otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w)

 extraPics :: Configuration -> World -> Picture
-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 drawRadarSweep (_radarSweeps    (_cWorld w))
-    <> concatMapPic drawFlame (_flames    (_cWorld w))
-    <> concatMapPic drawEnergyBall (_energyBalls    (_cWorld w))
-    <> concatMapPic drawSpark (_sparks    (_cWorld w))
-    <> concatMapPic drawBul (_bullets (_cWorld w))
-    <> concatMapPic drawBlip (_radarBlips    (_cWorld w))
-    <> concatMapPic drawFlare (_flares    (_cWorld w))
-    <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_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) )
-    <> viewClipBounds cfig w
-    <> debugDraw cfig 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 drawRadarSweep (_radarSweeps (_cWorld w))
+        <> concatMapPic drawFlame (_flames (_cWorld w))
+        <> concatMapPic drawEnergyBall (_energyBalls (_cWorld w))
+        <> concatMapPic drawSpark (_sparks (_cWorld w))
+        <> concatMapPic drawBul (_bullets (_cWorld w))
+        <> concatMapPic drawBlip (_radarBlips (_cWorld w))
+        <> concatMapPic drawFlare (_flares (_cWorld w))
+        <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_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))
+        <> viewClipBounds cfig w
+        <> debugDraw cfig w

 debugDraw :: Configuration -> World -> Picture
 {-# INLINE debugDraw #-}
-debugDraw cfig w 
+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"
-    Noclip      -> lstring "Noclip"
-    Remove_LOS  -> lstring "No line of sight"
-    Cull_more_lights    -> lstring "Cull more lights"
+    Show_debug -> lstring "Show debug"
+    Noclip -> lstring "Noclip"
+    Remove_LOS -> lstring "No line of sight"
+    Cull_more_lights -> lstring "Cull more lights"
    Close_shape_culling -> lstring "Close shape culling"
-    Bound_box_screen    -> lstring "bound box screen, this should be moved"
-    Show_ms_frame           -> rdraw mempty
-    View_boundaries         -> rdraw $ viewBoundaries w
-    Show_bound_box          -> rdraw $ drawBoundingBox w
-    Show_wall_search_rays   -> rdraw $ drawWallSearchRays w
-    Show_dda_test           -> rdraw $ drawDDATest w
-    Show_far_wall_detect    -> rdraw $ drawFarWallDetect w
-    Show_select             -> rdraw $ drawWorldSelect w
-    Inspect_wall            -> rdraw $ drawInspectWalls w
-    Cr_awareness            -> rdraw $ drawCreatureDisplayTexts w
-    Show_sound              -> rdraw $ pictures $ M.map (soundPic cfig w) $ _playingSounds w
-    Cr_status               -> rdraw $ drawCrInfo cfig w
-    Mouse_position          -> rdraw $ drawMousePosition cfig w
-    Walls_info              -> rdraw $ drawWlIDs cfig w
-    Pathing                 -> rdraw $ drawPathing cfig w
-    Show_nodes_near_select  -> rdraw $ drawNodesNearSelect w
-    Show_path_between       -> rdraw $ drawPathBetween w
+    Bound_box_screen -> lstring "bound box screen, this should be moved"
+    Show_ms_frame -> rdraw mempty
+    View_boundaries -> rdraw $ viewBoundaries w
+    Show_bound_box -> rdraw $ drawBoundingBox w
+    Show_wall_search_rays -> rdraw $ drawWallSearchRays w
+    Show_dda_test -> rdraw $ drawDDATest w
+    Show_far_wall_detect -> rdraw $ drawFarWallDetect w
+    Show_select -> rdraw $ drawWorldSelect w
+    Inspect_wall -> rdraw $ drawInspectWalls w
+    Cr_awareness -> rdraw $ drawCreatureDisplayTexts w
+    Show_sound -> rdraw $ pictures $ M.map (soundPic cfig w) $ _playingSounds w
+    Cr_status -> rdraw $ drawCrInfo cfig w
+    Mouse_position -> rdraw $ drawMousePosition cfig w
+    Walls_info -> rdraw $ drawWlIDs cfig w
+    Pathing -> rdraw $ drawPathing cfig w
+    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)
-    <> 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)
+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)
  where
    nodepos = (`getNodePos` w)
    nodelist = makePathBetween 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))
-    <> color green (drawCross 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])
-    <> foldMap (drawDoorPaths w) (wl ^? wlStructure . wsDoor)
+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,60 +248,68 @@ 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
-    WallObstacle    -> cyan
-    DoorObstacle    -> red
+    WallObstacle -> cyan
+    DoorObstacle -> red
    AutoDoorObstacle -> yellow
    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 
-    . color yellow 
-    . foldMap (\q -> line 
-        [ p
-        , fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w
-        ]   )
-    $ runIdentity $ S.toList_ $ streamViewpoints p w
+drawFarWallDetect w =
+    setLayer DebugLayer
+        . color yellow
+        . 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)
-    <> 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]))
+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]))
  where
    cvf = _cameraViewFrom (_cWorld w)
    mwp = mouseWorldPos w
    ps = ddaStreamX 50 cvf mwp
    ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
-    qs  = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
+    qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
    qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)

 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,51 +317,61 @@ 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)
-        <> line [_cameraViewFrom (_cWorld w), p]
+    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)) 
-        . scale theScale theScale 
-        . centerText 
-        . soundToOnomato 
-        $ _soundChunkID s
+    thePic =
+        rotate (_cameraRot (_cWorld w))
+            . scale theScale theScale
+            . centerText
+            . soundToOnomato
+            $ _soundChunkID s
    theScale = 0.15 * f (_soundVolume s * 0.0001)
    f x = 1 - 0.5 * (1 - x)

 drawMousePosition :: Configuration -> World -> Picture
-drawMousePosition cfig w = setLayer FixedCoordLayer . winScale cfig
-    . uncurryV translate p
-    . scale 0.1 0.1
-    . text 
-    $ shortPoint2 mwp 
+drawMousePosition cfig w =
+    setLayer FixedCoordLayer . winScale cfig
+        . uncurryV translate p
+        . scale 0.1 0.1
+        . text
+        $ shortPoint2 mwp
  where
    p = worldPosToScreen w mwp
    mwp = mouseWorldPos w
@@ -350,13 +379,14 @@ drawMousePosition cfig w = setLayer FixedCoordLayer . winScale cfig
 drawWlIDs :: Configuration -> World -> Picture
 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
-            . uncurryV translate p
-            . scale 0.1 0.1
-            . text 
-            $ show $ _wlID wl 
+    f wl
+        | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
+        | otherwise =
+            winScale cfig
+                . uncurryV translate p
+                . scale 0.1 0.1
+                . text
+                $ show $ _wlID wl
      where
        p = worldPosToScreen w $ 0.5 *.* uncurry (+.+) (_wlLine wl)

@@ -369,78 +399,87 @@ edgeToPic poly pe
    ep = _peEnd pe

 drawPathing :: Configuration -> World -> Picture
-drawPathing cfig w = setLayer DebugLayer
-    $  foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
-    <> foldMap dispInc (graphToIncidence 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 cfig w cr 
+crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String])
+crDisplayInfo cfig w cr
    | _crID cr == 0 = Nothing
-    | 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
-        , fpreShow "crImpulse" $ ap ^? apImpulse
-        ]
-        )
+    | 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
+                , fpreShow "crImpulse" $ ap ^? apImpulse
+                ]
+            )
    | otherwise = Nothing
  where
    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) 
-                    <> color yellow (polygonWire $ _cpPoints y)
-                    <> g x ys
+    g x (y : ys)
+        | convexPolysOverlap x y =
+            color green (polygonWire $ _cpPoints x)
+                <> color yellow (polygonWire $ _cpPoints y)
+                <> g x ys
        | otherwise = g x ys
    g _ [] = mempty

 --wallFloorsToDraw :: World -> [Wall]
 --wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
--  where 
+--  where
 --    onScreen wall = uncurry (lineOnScreen w) $ _wlLine wall
--    isVisible wl 
+--    isVisible wl
 --        | wl ^? wlUnshadowed == Just False = False
 --        | otherwise = onScreen wl
 --
 --lineOnScreen :: World -> Point2 -> Point2 -> Bool
--lineOnScreen w p1 p2 = pointInPolygon p1 sp 
--    || pointInPolygon p2 sp 
+--lineOnScreen w p1 p2 = pointInPolygon p1 sp
+--    || pointInPolygon p2 sp
 --    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
--  where 
+--  where
 --    sp = screenPolygon w
 --    sps = zip sp (tail sp ++ [head sp])
 --
@@ -448,7 +487,7 @@ viewClipBounds cfig w
 --drawWallFloor wl = if _wlOpacity wl == SeeThrough
 --    then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
 --    else blank
--  where 
+--  where
 --    (x,y) = _wlLine wl
 --    c = _wlColor wl
 --    n2 = 15 *.* (vNormal . errorNormalizeVDR $ y -.- x)
@@ -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