Cleanup

Improve wall squashing further
Remove recursive WdWd
2026-03-26 20:32:52 +00:00 · 2026-03-26 20:25:59 +00:00 · 2026-03-26 19:33:02 +00:00 · 2026-03-26 19:21:10 +00:00 · 2026-03-26 18:24:42 +00:00 · 2026-03-26 16:17:34 +00:00
80 changed files with 1685 additions and 1402 deletions
@@ -21,7 +21,6 @@ module Dodge.Base.Collide (
    bouncePoint,
    circOnSomeWall,
    circOnAnyCr,
-    overlapCircWalls,
    overlapCircWallsClosest,
    crsNearPoint,
    allVisibleWalls,
@@ -35,6 +34,8 @@ module Dodge.Base.Collide (
    collide3,
 ) where

+import Data.Foldable
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
 import qualified Data.IntSet as IS
@@ -49,7 +50,7 @@ import FoldableHelp
 import Geometry
 import Linear

-collidePoint :: Point2 -> Point2 -> [Wall] -> (Point2, Maybe Wall)
+collidePoint :: Foldable t => Point2 -> Point2 -> t Wall -> (Point2, Maybe Wall)
 {-# INLINE collidePoint #-}
 collidePoint sp ep = foldl' f (ep, Nothing)
  where
@@ -106,7 +107,8 @@ collide3Chasms sp w m =
    foldl'
        (flip (collide3Chasm sp))
        m
-        (foldMap loopPairs $ w ^. cWorld . chasms)
+        -- (foldMap loopPairs $ w ^. cWorld . chasms)
+        (w ^. cWorld . cliffs)

 collide3Chasm :: Point3 -> (Point2, Point2) -> (Point3, MPO) -> (Point3, MPO)
 collide3Chasm sp ab (ep, m) =
@@ -185,11 +187,11 @@ wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y)

 -- this COULD be written in terms of collidePointWallsFilterStream, TODO test
 -- whether this is actually faster
-collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> [Wall] -> Bool
+collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Bool
 {-# INLINE collidePointTestFilter #-}
 collidePointTestFilter t sp ep =
    any (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
-        . filter t
+        . IM.filter t

 ---- this COULD be written in terms of collidePointWallsFilterStream, TODO test
 ---- whether this is actually faster
@@ -201,23 +203,24 @@ collidePointTestFilter t sp ep =

 collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
 {-# INLINE collidePointWallsFilter #-}
-collidePointWallsFilter t sp ep = collidePoint sp ep . filter t . wlsNearSeg sp ep
+collidePointWallsFilter t sp ep = collidePoint sp ep . IM.filter t . wlsNearSeg sp ep

 -- overlapSegWalls :: Point2 -> Point2 -> StreamOf Wall
 --    -> StreamOf (Point2,Wall)
 -- {-# INLINE overlapSegWalls #-}
 -- overlapSegWalls sp ep = S.mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)

-overlapSegWalls :: Point2 -> Point2 -> [Wall] -> [(Point2, Wall)]
+overlapSegWalls :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall)
 {-# INLINE overlapSegWalls #-}
-overlapSegWalls sp ep = mapMaybe 
-    $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)
+overlapSegWalls sp ep = IM.mapMaybe $
+    \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)

 visibleWalls :: Point2 -> Point2 -> World -> [(Point2, Wall)]
 {-# INLINE visibleWalls #-}
 visibleWalls sp ep =
    takeUntil (wlIsOpaque . snd)
        . sortOn (dist sp . fst)
+        . IM.elems
        . overlapSegWalls sp ep
        . wlsNearSeg sp ep

@@ -227,16 +230,12 @@ allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays
  where
    vPos = w ^. wCam . camViewFrom

-overlapCircWalls ::
-    Point2 ->
-    Float ->
-    [Wall] ->
-    [(Point2, Wall)]
+overlapCircWalls :: Point2 -> Float -> [Wall] -> [(Point2, Wall)]
 {-# INLINE overlapCircWalls #-}
-overlapCircWalls p r = mapMaybe dointersect
+overlapCircWalls p r = mapMaybe g
  where
-    dointersect wl = f (_wlLine wl) <&> (,wl)
-    f (a, b) = intersectSegSeg p (p +.+ r *.* normalizeV ((0.5 *.* (a +.+ b)) -.- p)) a b
+    g wl = f (_wlLine wl) <&> (,wl)
+    f (a, b) = intersectSegSeg p (p + r *^ vNormal (normalizeV (b - a))) a b

 circHitWall :: Point2 -> Point2 -> Float -> World -> Bool
 circHitWall sp ep r w =
@@ -255,7 +254,8 @@ collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
 collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
  where
    findPoint (p, mwl) wl =
-        maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p)
+        maybe (p, mwl) (,Just wl)
+            . uncurry (intersectSegSeg sp p)
            . shiftbyrad
            . _wlLine
            $ wl
@@ -271,14 +271,7 @@ collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)

 overlapCircWallsClosest :: Point2 -> Float -> [Wall] -> Maybe (Point2, Wall)
 {-# INLINE overlapCircWallsClosest #-}
-overlapCircWallsClosest p r =
-    safeMinimumOn (dist p . fst)
-        . overlapCircWalls p r
-
--overlapCircWallsClosest :: Point2 -> Float -> StreamOf Wall -> Maybe (Point2,Wall)
--{-# INLINE overlapCircWallsClosest #-}
--overlapCircWallsClosest p r = minStreamOn (dist p . fst)
--    . overlapCircWalls p r
+overlapCircWallsClosest p r = safeMinimumOn (dist p . fst) . overlapCircWalls p r

 {- | Test if a circle collides with any wall.
 - Note no check on whether the wall is walkable.
@@ -322,9 +315,9 @@ hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 hasLOSIndirect p1 p2 =
    not
        . collidePointTestFilter wlIsOpaque p1 p2
+--        . IM.elems
        . wlsNearSeg p1 p2

-
 canSee :: Int -> Int -> World -> Bool
 {-# INLINE canSee #-}
 canSee i j w = hasLOS p1 p2 w
@@ -2,13 +2,15 @@ module Dodge.Base.Coordinate (
    worldPosToScreen,
    screenToWorldPos,
    mouseWorldPos,
+    mouseWorldPosW,
    worldPosToResOffset,
 ) where

+import Dodge.Data.World
 import Control.Lens
-import Dodge.Data.Camera
+--import Dodge.Data.Camera
 import Dodge.Data.Config
-import Dodge.Data.Input
+--import Dodge.Data.Input
 import Dodge.WindowSize
 import Geometry
 import Linear
@@ -37,6 +39,9 @@ worldPosToResOffset cfig cam p =
 mouseWorldPos :: Input -> Camera -> Point2
 mouseWorldPos inp cam = screenToWorldPos cam (inp ^. mousePos)

+mouseWorldPosW :: World -> Point2
+mouseWorldPosW w = mouseWorldPos (w ^. input) (w ^. wCam)
+
 screenToWorldPos :: Camera -> Point2 -> Point2
 screenToWorldPos cam p =
    (cam ^. camCenter) + (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
@@ -1,16 +1,18 @@
-module Dodge.Button.Draw where
+module Dodge.Button.Draw (drawButton) where

+import Data.Maybe
+import Dodge.Data.LWorld
 import Color
-import Dodge.Data.Button
 import Geometry
 import Shape
 import ShapePicture
 import Control.Lens

-drawButton :: Button -> SPic
-drawButton bt = case bt ^. btEvent of
+drawButton :: LWorld -> Button -> SPic
+drawButton lw bt = case bt ^. btEvent of
    ButtonPress {_bpColor = col} -> defaultDrawButton col bt
    ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
+    ButtonDumbSwitch i -> drawDumbSwitch (fromMaybe True $ lw ^? triggers . ix i)
    ButtonAccessTerminal _ -> mempty

 drawSwitch :: Color -> Color -> Button -> SPic
@@ -26,6 +28,19 @@ drawSwitch col1 col2 bt
            ]
        )

+drawDumbSwitch :: Bool -> SPic
+drawDumbSwitch t
+    |  t = flick $ pi / 4
+    | otherwise = flick (negate (pi / 4))
+  where
+    flick a = noPic
+        ( mconcat
+            [ colorSH red . upperBox Small Typical 20 $ rectNSWE (-2) (-5) (-10) 10
+            , colorSH (dim red) . translateSH (V3 0 (-2) 20) . rotateSH a . upperBox Small Typical 2 $
+                    rectNSWE 10 0 (-2) 2
+            ]
+        )
+
 defaultDrawButton :: Color -> Button -> SPic
 defaultDrawButton col bt = noPic
    ( translateSHz 15 . colorSH col $ upperBox Small Typical 5 buttonGeometry
@@ -12,6 +12,7 @@ doButtonEvent = \case
    ButtonPress False f _ -> buttonFlip f
    ButtonSwitch _ f _ _ True -> buttonFlip f
    ButtonSwitch f _ _ _ False -> buttonFlip f
+    ButtonDumbSwitch i -> \_ -> cWorld . lWorld . triggers . ix i %~ not
    ButtonAccessTerminal tid -> const $ accessTerminal tid

 buttonFlip :: WdWd -> Button -> World -> World
@@ -209,10 +209,12 @@ inventoryX c = case c of
        [ makeTypeCraftNum 2 MICROCHIP
        ]
    "J" ->
-        [ laser
+        [ capacitor
+        , makeTypeCraft TRANSFORMER
+        , laser
        , battery
-        --, dualBeam
-        ] <> makeTypeCraftNum 10 TRANSFORMER
+        ] 
+        <> makeTypeCraftNum 5 BEAMSPLITTER
    "K" ->
        [ autoRifle
        , tinMag
@@ -5,6 +5,7 @@ module Dodge.Creature.Action.Blink (
    unsafeBlinkAction,
 ) where

+import qualified Data.IntMap.Strict as IM
 import Linear
 import Dodge.Creature.Radius
 import Dodge.Zoning.Wall
@@ -34,7 +35,7 @@ blinkActionMousePos cr w =
    p1 = w ^. cWorld . lWorld . lAimPos
    cpos = cr ^. crPos . _xy
    --p2 = bouncePoint (const True) 1 cpos p1 w
-    p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w)
+    p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (IM.elems $ wlsNearSeg cpos p1 w)
    r = crRad $ cr ^. crType
    p3 = maybe p1 ((+.+ squashNormalizeV (cpos -.- p1)) . fst) p2 
    --p3 = maybe p1 (const 0) p2 
@@ -50,7 +50,7 @@ useItemLoc cr loc pt w
    | otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
  where
    aimuse 
-        | LaserWeaponSF <- sf = True
+        | LaserWeaponXSF {} <- sf = True
        | HeldPlatformSF <- sf = True
        | PulseBallSF <- sf = True
        | PlasmaSF <- sf = True
@@ -35,7 +35,6 @@ import Dodge.Zoning.Creature
 import FoldableHelp
 import Geometry
 import LensHelp
-import Picture
 import qualified Quaternion as Q
 import RandomHelp
 import qualified SDL
@@ -218,7 +217,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
                    { _lpPhaseV = 1
                    , _lpDir = _crDir cr + argV (Q.qToV2 q)
                    , _lpPos = pos
-                    , _lpColor = col
+--                    , _lpColor = col
                    , _lpType = TargetingLaser (_itID itm)
                    }
  where
@@ -228,12 +227,11 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
    x = 1
    isammolink AmmoMagSF{} = True
    isammolink _ = False
-    pos = cr ^. crPos . _xy + xyV3 (rotate3 cdir p)
+    pos = cr ^. crPos . _xy + xyV3 (rotate3z cdir p)
    cdir = _crDir cr
    itm = itmtree ^. dtValue . _1
    pointittarg = cWorld . lWorld . items . ix itid . itTargeting
    itid = itm ^. itID . unNInt
-    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red

 shineTorch :: Creature -> LocationDT OItem -> World -> World
 shineTorch cr loc = fromMaybe id $ do
@@ -252,7 +250,7 @@ shineTorch cr loc = fromMaybe id $ do
    x = 10
    isammolink AmmoMagSF{} = True
    isammolink _ = False
-    pos = _crPos cr + rotate3 cdir (p + Q.rotate q (V3 5 0 1.5))
+    pos = _crPos cr + rotate3z cdir (p + Q.rotate q (V3 5 0 1.5))
    cdir = _crDir cr

 -- this probably needs to be set to null when dropped as well?
@@ -22,6 +22,7 @@ module Dodge.Creature.Test (
    crHasTarget,
    crStratConMatches,
    crSafeDistFromTarg,
+    hasAutoDoorBody,
 ) where

 import Linear
@@ -136,3 +137,11 @@ isAnimate :: Creature -> Bool
 isAnimate cr = case _crActionPlan cr of
    Inanimate -> False
    _ -> True
+
+hasAutoDoorBody :: Creature -> Bool
+hasAutoDoorBody cr = case cr ^. crHP of
+    HP {} -> True
+    CrIsCorpse {} -> True
+    CrIsGibs -> False
+    CrIsPitted -> False
+    
@@ -150,7 +150,7 @@ chasmTestLiving cr w
  where
    tocr = cWorld . lWorld . creatures . ix (_crID cr)
    g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
-    f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
+    f = pointInPoly (cr ^. crPos . _xy)

 chasmTestCorpse :: Creature -> World -> World
 chasmTestCorpse cr w
@@ -162,13 +162,12 @@ chasmTestCorpse cr w
        w
            & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
            & tocr . crPos . _xy +~ normalizeV (vNormal (x - y))
-            & chasmRotate cr (x - y)
    | any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5
    | otherwise = w
  where
    tocr = cWorld . lWorld . creatures . ix (_crID cr)
    g = uncurry $ circOnSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType)
-    f = circInPolygon (cr ^. crPos . _xy) (crRad $ cr ^. crType)
+    f = pointInPoly (cr ^. crPos . _xy)

 chasmRotate :: Creature -> Point2 -> World -> World
 chasmRotate cr v w
@@ -34,6 +34,7 @@ doCrBl cb = case cb of
    CrCanShoot -> error "got rid of crCanShoot"
    CrIsAiming -> crIsAiming
    CrIsAnimate -> isAnimate
+    CrOpenAutoDoor -> \cr -> isAnimate cr && hasAutoDoorBody cr

 doCrAc :: CrAc -> Creature -> Action
 doCrAc ca = case ca of
@@ -23,6 +23,7 @@ data ButtonEvent
        , _bsColor2 :: Color
        , _btOn :: Bool
        }
+    | ButtonDumbSwitch { _bdsTrigger :: Int }
    | ButtonAccessTerminal {_btTermID :: Int}

 data Button = Button
@@ -37,7 +37,8 @@ data ItemSF -- Structural Function
    | GrenadeHitEffectSF
    | ToggleSF
    | MapperSF
-    | LaserWeaponSF
+--    | LaserWeaponSF
+    | LaserWeaponXSF {_lasWepXSF :: Int}
    | PulseLaserSF
    | CapacitorSF
    | TransformerSF
@@ -45,6 +46,7 @@ data ItemSF -- Structural Function
    | PlasmaSF
    | TorchSF
    | PumpSF
+    | BeamSplitterSF
    deriving (Eq, Ord, Show, Read)

 type CItem = (Item, ItemSF)
@@ -30,6 +30,7 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
+import qualified Data.IntSet as IS
 --import qualified IntMapHelp as IM

 data Creature = Creature
@@ -57,6 +58,7 @@ data Creature = Creature
    , _crIntention :: Intention
    , _crName :: String
    , _crDeathTimer :: Int
+    , _crWallTouch :: IS.IntSet
    }

 data CrHP
@@ -18,6 +18,7 @@ data WdCrBl
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data CrBl = CrCanShoot | CrIsAiming | CrIsAnimate
+    | CrOpenAutoDoor
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data CrAc = CrTurnAround
@@ -40,7 +40,10 @@ data Door = Door
    , _drMounts :: [MountedObject]
    }

-data DoorUpdate = DoorDoNothing | DoorLerp {_drLerpSpeed :: Float}
+data DoorUpdate 
+    = DoorDoNothing 
+    | DoorLerp {_drLerpSpeed :: Float}
+    | DoorLerpWithTimer {_drLerpTimer :: Int, _drLerpSpeed :: Float}


 makeLenses ''Door
@@ -26,7 +26,7 @@ data MouseContext
    | OverCombEscape
    | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
    | OutsideTerminal
-    | MouseGameRotate
+    | MouseGameRotate {_mcoRotateDist :: Float}  -- TODO warp mouse to this distance
    | OverDebug {_mcoDBBool :: DebugBool, _mcoDBInt :: Int}
    deriving (Show)

@@ -46,8 +46,13 @@ data Input = Input
    , _textInput :: [Either TermSignal Char]
    , _scrollTestFloat :: Float
    , _scrollTestInt :: Int
+    , _inputMemory :: InputMemory
    }

+data InputMemory
+    = WasMouseGameRotating
+    | WasNotMouseGameRotating
+
 data TermSignal
    = TSescape
    | TSreturn
@@ -62,6 +62,7 @@ data CraftType
    | PUMP
    | MOTOR
    | TRANSFORMER
+    | BEAMSPLITTER
    | PRISM
    | LIGHTER
    | MAGNET
@@ -5,7 +5,7 @@ module Dodge.Data.Laser where

 import NewInt
 import Dodge.Data.Item.Location
-import Color
+--import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -20,7 +20,6 @@ data Laser = Laser
    { _lpPhaseV :: Float
    , _lpPos :: Point2
    , _lpDir :: Float
-    , _lpColor :: Color
    , _lpType :: LaserType
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -25,15 +25,14 @@ data SoundFilter
 data WdWd
    = NoWorldEffect
    | SetTrigger Bool Int
-    | WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
    | SetLSCol Point3 Int
+    | SetTriggerAndSetLSCol Bool Int Point3 Int
    | AccessTerminal Int
    | UnlockInv
    | SoundStart SoundOrigin Point2 SoundID (Maybe Int)
    | MakeStartCloudAt Point3
    | TorqueCr Float Int
    | WdWdNegateTrig Int
--    | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
    | MakeTempLight LSParam Int
    | MakeTempLightFade Float LSParam Int
    | UseInvItem Int Int -- invid presstime
@@ -42,6 +42,45 @@ overDebugEvent u = fromMaybe u $ do

 debugEvent :: DebugBool -> Universe -> Universe
 debugEvent db u = u & uvDebug . at db .~ debugItem db u
+    & debugEvent' db
+
+-- possibly don't want this running when the game is paused/not running normally
+-- note this happens before functionalUpdate
+debugEvent' :: DebugBool -> Universe -> Universe
+debugEvent' = \case
+    Collision_test -> id
+    Circ_collision_test -> id
+    Show_walls_near_point_cursor -> id
+    Show_walls_near_segment -> id
+    Display_debug -> id
+    Noclip -> id
+    Remove_LOS -> id
+    Cull_more_lights -> id
+    Close_shape_culling -> id
+    Bound_box_screen -> id
+    Show_ms_frame -> id
+    View_gr_boundaries -> id
+    View_rm_boundaries -> id
+    Show_bound_box -> id
+    Show_wall_search_rays -> id
+    Show_dda_test -> id
+    Show_far_wall_detect -> id
+    Show_walls_near_you -> id
+    Show_zone_near_point_cursor -> id
+    Show_zone_circ -> id
+    Inspect_wall -> id
+    Cr_awareness -> id
+    Show_sound -> id
+    Cr_status -> id
+    Mouse_position -> id
+    Walls_info -> id
+    Pathing -> id
+    Show_path_between -> id
+    Show_writable_values -> id
+    Show_mouse_click_pos -> id
+    Debug_get -> id
+    Debug_put -> id
+    Muzzle_positions -> id

 debugItem :: DebugBool -> Universe -> Maybe [DebugItem]
 debugItem = \case
@@ -109,7 +148,6 @@ doDebugGet u =
  where
    f s = DebugItem s (setClip s)

-
 debugShowPath :: Universe -> DebugItem
 debugShowPath u =
    DebugItem (u ^. uvDebugPathShowType . to show) f
@@ -259,7 +297,7 @@ showMuzzlePositions  u = fold $ do
        ^? ix invid . _2
    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
  where
-    f cr loc = foldMap (g . muzzlePos loc cr)  (itemMuzzles $ loc)
+    f cr loc = foldMap (g . muzzlePos loc cr)  (itemMuzzles loc)
      where
        g :: Point3Q -> Picture
        g pq = translate3 (pq ^. _1) $ crossPic 5
@@ -276,7 +276,7 @@ drawFarWallDetect w =
            ( \q ->
                line
                    [ p
-                    , fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w
+                    , fst $ collidePoint p q $ filter wlIsOpaque $ IM.elems $ wlsNearSeg p q w
                    ]
            )
        $ getViewpoints p (_cWorld w)
@@ -55,6 +55,7 @@ defaultCreature =
 --        , _crStatistics = CreatureStatistics 50 50 50
        , _crDeathTimer = 5  -- how long a creature remains standing 
                             -- after a killing blow has been dealt
+        , _crWallTouch = mempty
        }

 --defaultCreatureSkin :: CreatureType
@@ -7,7 +7,7 @@ defaultDoor =
    Door
        { _drID = 0
        , _drTrigger = WdBlConst False
-        , _drUpdate = DoorLerp 1
+        , _drUpdate = DoorLerp 2
        , _drZeroPos = (0, 0)
        , _drOnePos = (0, 0)
        , _drLerp = 0
@@ -27,6 +27,7 @@ defaultInput =
        , _smoothScrollAmount = 0
        , _scrollTestFloat = 1
        , _scrollTestInt = 0
+        , _inputMemory = WasNotMouseGameRotating
        }

 defaultWorld :: World
@@ -20,9 +20,10 @@ import Picture.Data
 import Shape.Data

 updateDoor :: Door -> World -> (S.Set Int2, World)
-updateDoor dr w
-    | DoorLerp x <- dr ^. drUpdate = doorLerp x dr w
-    | otherwise =
+updateDoor dr w = case dr ^. drUpdate of
+    DoorLerp x -> doorLerp x dr w
+    DoorLerpWithTimer n x -> doorLerpWithTimer n x dr w
+    DoorDoNothing ->
        ( mempty
        , foldl' (doDoorMount (doDoorLerp dr (dr ^. drLerp))) w (dr ^. drMounts)
        )
@@ -68,3 +69,38 @@ doorLerp speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w) $ do
            soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
        | otherwise = id

+doorLerpWithTimer :: Int -> Float -> Door -> World -> (S.Set Int2, World)
+doorLerpWithTimer n speed dr w = fromMaybe (mempty, domounts (dr ^. drLerp) w & uptimer) $ do
+    x <- newlerp
+    let ps = wlposs x
+        ps' = wlposs (dr ^. drLerp)
+        is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (ps <> ps')
+    -- it seems possible that this will miss some paths: we don't add zones for the
+    -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
+    return
+        ( is
+        , domounts x $
+            f x
+                & playSound x
+                & cWorld . lWorld . doors . ix drid . drLerp .~ x
+                & uptimer
+        )
+  where
+    domounts x w' = foldl' (doDoorMount (doDoorLerp dr x)) w' (dr ^. drMounts)
+    f = ifoldl' (flip . moveWallID) w . wlposs
+    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
+    clerp = dr ^. drLerp
+    newlerp
+        | toOpen && clerp < 1 = Just . min 1 $ clerp + speed
+        | clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
+        | otherwise = Nothing
+    uptimer = cWorld . lWorld . doors . ix drid . drUpdate . drLerpTimer %~ updatetimer
+    updatetimer
+        | doWdBl (_drTrigger dr) w = const 20
+        | otherwise = max 0 . subtract 1
+    toOpen = doWdBl (_drTrigger dr) w || n > 0
+    drid = _drID dr
+    playSound x
+        | _drPushedBy dr == PushesItself =
+            soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
+        | otherwise = id
@@ -62,17 +62,12 @@ useMagShield mt _ cr w =
 --    _ -> w

 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr w =
-    w
-        & cWorld
+createHeadLamp _ cr =
+    cWorld
        . lWorld
        . lights
        .:~ LSParam
-            ( _crPos cr
-                +.+.+ rotate3
-                    (_crDir cr)
-                    (translateToES cr OnHead (V3 5 0 3))
-            )
+            (_crPos cr + rotate3z (_crDir cr) (translateToES cr OnHead (V3 5 0 3)))
            200
            0.7

@@ -103,9 +98,9 @@ onEquipWristShield itm cr w =
        . at i
        ?~ forceField{_wlID = i}
        & setWristShieldPos
-            ( itm & itParams .~ ItemParamID{_itParamID = i}
-            )
-            cr esite
+            (itm & itParams .~ ItemParamID{_itParamID = i})
+            cr
+            esite
  where
    i = IM.newKey (w ^. cWorld . lWorld . walls)
    esite = w ^?! cWorld . lWorld . items . ix (itm ^. itID . unNInt) . itLocation . ilEquipSite . _Just
@@ -132,4 +127,4 @@ setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline
    --    g
    --        | twists cr = (+.+.+ V3 (-5) 10 0)
    --        | otherwise = id
-    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans
+    f = (+ cr ^. crPos . _xy) . stripZ . rotate3z (_crDir cr) . handtrans
@@ -49,9 +49,7 @@ handleMouseMotionEvent mmev cfig = set mousePos themousepos . set mouseMoving Tr
  where
    P (V2 x y) = mouseMotionEventPos mmev
    themousepos =
-        V2
-            (fromIntegral x - 0.5 * windowXFloat cfig)
-            (0.5 * windowYFloat cfig - fromIntegral y)
+        V2 (fromIntegral x - 0.5 * windowXFloat cfig) (0.5 * windowYFloat cfig - fromIntegral y)

 handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input
 handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y
@@ -10,6 +10,7 @@ module Dodge.HeldUse (
    itemMuzzles,
 ) where

+import Dodge.Laser.Update
 import Color
 import Control.Applicative
 import Control.Monad
@@ -167,7 +168,7 @@ locMuzzles loc
            & ix 0 . mzInaccuracy .~ 0
            & ix 0 . mzFlareType .~ TeslaGunFlare
 --    | otherwise = itemMuzzles $ loc ^. locDT . dtValue . _1
-    | otherwise = itemMuzzles $ loc
+    | otherwise = itemMuzzles loc

 itemMuzzles :: LocationDT OItem -> [Muzzle]
 itemMuzzles loc = case itm ^. itType of
@@ -175,12 +176,21 @@ itemMuzzles loc = case itm ^. itType of
    DETECTOR{} ->
        dbwMuzzles & ix 0 . mzEffect .~ MuzzleDetector
            & ix 0 . mzAmmoSlot . aps .~ UseExactly 100
-    LASER ->
+    LASER -> case loc ^? locDT . dtValue . _2 . lasWepXSF of
+        Nothing ->
            dbwMuzzles
                & ix 0 . mzPos .~ V2 6 0
                & ix 0 . mzInaccuracy .~ 0
                & ix 0 . mzFlareType .~ LasGunFlare
                & ix 0 . mzEffect .~ MuzzleLaser
+        Just i -> join
+            [dbwMuzzles
+                & ix 0 . mzPos .~ V2 6 x
+                & ix 0 . mzInaccuracy .~ 0
+                & ix 0 . mzFlareType .~ NoLightFlare
+                & ix 0 . mzEffect .~ MuzzleLaser
+            | x <- spreadAroundCenter i 3
+            ] & ix (i `div` 2) . mzFlareType .~ LasGunFlare
    _ -> []
  where
    itm = loc ^. locDT . dtValue . _1
@@ -677,9 +687,9 @@ makeMuzzleFlare (p, q) loc = \case
            . muzFlareAt (V4 10 10 1 3) p dir
    HeavySmokeFlare -> basicMuzFlare (p ^. _xy) dir
    LasGunFlare ->
-        flareCircleAt (getLaserColor loc) 0.8 p
+        flareCircleAt (ltToCol $ getLaserDamage loc) 0.8 p
            . ( cWorld . lWorld . lights
-                    .:~ LSParam p 100 (getLaserColor loc ^. _xyz) -- p had z=10
+                    .:~ LSParam p 100 (ltToCol (getLaserDamage loc) ^. _xyz) -- p had z=10
              )
    TeslaGunFlare -> cWorld . lWorld . lights .:~ LSParam p 100 (V3 0 0 1) -- p had z=10
  where
@@ -718,9 +728,6 @@ getLaserPhaseV = const 1
 getLaserDamage :: LocationDT OItem -> LaserType
 getLaserDamage = const (DamageLaser 11)

-getLaserColor :: LocationDT OItem -> Color
-getLaserColor = const yellow
-
 basicMuzFlare :: Point2 -> Float -> World -> World
 basicMuzFlare pos dir =
    (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5))
@@ -857,7 +864,6 @@ creatureShootLaser (p, q) loc =
        (getLaserPhaseV loc)
        (p ^. _xy)
        (Q.qToAng q)
-        (getLaserColor loc)

 shootLaser ::
    SoundOrigin ->
@@ -865,17 +871,15 @@ shootLaser ::
    Float ->
    Point2 ->
    Float ->
-    Color ->
    World ->
    World
-shootLaser so lt pv p dir col =
+shootLaser so lt pv p dir =
    ( cWorld . lWorld . lasers
        .:~ Laser
            { _lpType = lt
            , _lpPhaseV = pv
            , _lpPos = p
            , _lpDir = dir
-            , _lpColor = col
            }
    )
        . soundContinue so p tone440sawtoothquietS (Just 2)
@@ -933,8 +937,7 @@ removeAmmoFromMag x magid
 getBulletType :: DTree OItem -> Maybe Bullet
 getBulletType magtree =
    (magtree ^? dtValue . _1 . to magAmmoParams . _Just . ampBullet)
-        <&> buPayload .~ bpayload
-        <&> buEffect .~ beffect
+        <&> (buPayload .~ bpayload) . (buEffect .~ beffect)
  where
    bpayload = fromMaybe (BulPlain 100) $ do
        attree <- find ispayload (magtree ^. dtLeft)
@@ -1177,7 +1180,7 @@ doGenFloat (UniRandFloat x y) g = randomR (x, y) g

 mcShootLaser :: Item -> Machine -> World -> World
 mcShootLaser _ mc =
-    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow
+    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir
  where
    pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
    dir = (mc ^?! mcType . mctTurret . tuDir)
@@ -14,15 +14,22 @@ module Dodge.Inventory (
    swapItemWith,
    destroyItem,
    destroyAllInvItems,
+    multiSelScroll,
+    changeSwapSelSet,
+    concurrentIS,
+    collectInvItems,
+    shiftInvItemsUp,
+    shiftInvItemsDown,
 ) where

-import Dodge.Euse
-import Linear
+import Control.Monad
 import Data.Function
+import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
 import Dodge.Data.World
+import Dodge.Euse
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.Inventory.Swap
@@ -30,6 +37,7 @@ import Dodge.SelectionSections
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import Linear
 import ListHelp
 import NewInt

@@ -65,7 +73,8 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
    Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
    Just OnTurret{} -> error "need to write code for destroying items on turrets"
    Just OnFloor ->
-        w & cWorld . lWorld . items . at itid .~ Nothing
+        w
+            & cWorld . lWorld . items . at itid .~ Nothing
            & cWorld . lWorld . floorItems . at itid .~ Nothing
    Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing

@@ -97,8 +106,9 @@ rmInvItem cid invid w =
    itm = w ^?! cWorld . lWorld . items . ix itid
    dounequipfunction = effectOnRemove itm cr
    removeAnySlotEquipment = fromMaybe id $ do
-        epos <- itm ^?
-                     itLocation
+        epos <-
+            itm
+                ^? itLocation
                . ilEquipSite
                . _Just
        return $ pointcid . crEquipment . at epos .~ Nothing
@@ -114,13 +124,17 @@ rmInvItem cid invid w =

 updateCloseObjects :: World -> World
 updateCloseObjects w =
-    w & hud . closeItems %~ h citems
+    w
+        & hud . closeItems %~ h citems
        & hud . closeButtons %~ h cbts
  where
    h a b = intersect b a `union` a
    lw = w ^. cWorld . lWorld
-    citems = map NInt $ IM.keys $ IM.intersection (lw ^. items) 
-        $ IM.filter (isclose . _flItPos) (lw^.floorItems)
+    citems =
+        map NInt $
+            IM.keys $
+                IM.intersection (lw ^. items) $
+                    IM.filter (isclose . _flItPos) (lw ^. floorItems)
    cbts = lw ^.. buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
    canpress bt = case bt ^. btEvent of
        ButtonPress{_btOn = t} -> not t
@@ -128,9 +142,72 @@ updateCloseObjects w =
            x <- lw ^? terminals . ix tid . tmStatus
            return (x /= TerminalDeactivated)
        _ -> True
-    isclose x = dist y x < 40 && hasButtonLOS y x w
+    isclose x = dist y x < 30 && hasButtonLOS y x w
    y = you w ^. crPos . _xy

+changeSwapSelSet :: Int -> World -> World
+changeSwapSelSet yi w
+    | yi >= 0 = foldl' (&) w $ replicate yi (swapSelSet shiftSetUp)
+    | otherwise = foldl' (&) w $ replicate (negate yi) (swapSelSet shiftSetDown)
+
+swapSelSet :: (Int -> IS.IntSet -> World -> World) -> World -> World
+swapSelSet f w = fromMaybe w $ do
+    Sel j i is' <- w ^. hud . diSelection
+    let is = if IS.null is' 
+        then IS.singleton i
+        else is'
+    return $
+        if concurrentIS is
+            then f j is w
+            else collectInvItems j is w
+
+shiftSetUp :: Int -> IS.IntSet -> World -> World
+shiftSetUp j is w = fromMaybe w $ do
+    (mini, _) <- IS.minView is
+    guard (mini > 0)
+    return $ shiftInvItemsUp j is w
+
+shiftSetDown :: Int -> IS.IntSet -> World -> World
+shiftSetDown j is w = fromMaybe w $ do
+    (maxi, _) <- IS.maxView is
+    (maxinv, _) <- IM.lookupMax =<< (w ^? hud . diSections . ix j . ssItems)
+    guard (maxi < maxinv)
+    return $ shiftInvItemsDown j is w
+
+shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
+shiftInvItemsDown j is w = fromMaybe w $ do
+    let i = IS.findMax is
+    guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
+    return $ IS.foldr f w is
+  where
+    f i' = swapItemWith g (j, i')
+    g i' m = fst <$> IM.lookupGT i' m
+
+
+shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
+shiftInvItemsUp j is w = IS.foldl' f w is
+  where
+    f w' i' = swapItemWith g (j, i') w'
+    g i' m = fst <$> IM.lookupLT i' m
+
+concurrentIS :: IS.IntSet -> Bool
+concurrentIS = go . IS.minView
+  where
+    go x = fromMaybe True $ do
+        (i, is) <- x
+        (j, js) <- IS.minView is
+        return $ i + 1 == j && go (Just (j, js))
+
+collectInvItems :: Int -> IS.IntSet -> World -> World
+collectInvItems secid is w = fromMaybe w $ do
+    guard $ secid == 0
+    (j, js) <- IS.minView is
+    return $ h j js w
+  where
+    h j js w' = fromMaybe w' $ do
+        (k, ks) <- IS.minView js
+        return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
+
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
    | yi >= 0 = foldl' (&) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
@@ -138,6 +215,27 @@ changeSwapSel yi w
  where
    f g i m = fst <$> g i m

+multiSelScroll :: Int -> World -> World
+multiSelScroll yi w
+    | yi >= 0 = foldl' (&) w $ replicate yi (multiSelScroll' $ f IM.lookupLT)
+    | otherwise = foldl' (&) w $ replicate (negate yi) (multiSelScroll' $ f IM.lookupGT)
+  where
+    f g i m = fst <$> g i m
+
+multiSelScroll' :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
+multiSelScroll' f w = fromMaybe w $ do
+    Sel j i is <- w ^. hud . diSelection
+    ss <- w ^? hud . diSections . ix j . ssItems
+    k <- f i ss
+    let insertordelete 
+            | not (i `IS.member` is) && k `IS.member` is = IS.delete k
+            | k `IS.member` is = IS.delete i 
+            | otherwise = IS.insert i . IS.insert k
+    return $
+        w
+            & hud . diSelection . _Just . slSet %~ insertordelete
+            & hud . diSelection . _Just . slInt .~ k
+
 changeSwapOther ::
    ((Int -> Identity Int) -> ManipulatedObject -> Identity ManipulatedObject) ->
    Int ->
@@ -155,7 +253,13 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
    return $
        w
            & swapAnyExtraSelection i k
-            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens
+            & cWorld
+                . lWorld
+                . creatures
+                . ix 0
+                . crManipulation
+                . manObject
+                . manlens
                %~ doswap
            & hud . closeItems %~ swapIndices i k
            & hud . diSelection . _Just . slInt %~ doswap
@@ -192,7 +296,8 @@ scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
    | yi == 0 = w
    | otherwise =
-        w & hud %~ doscroll
+        w
+            & hud %~ doscroll
            & worldEventFlags . at InventoryChange ?~ ()
            & setInvPosFromSS
            & cWorld . lWorld %~ crUpdateItemLocations 0
@@ -203,7 +308,8 @@ scrollAugInvSel yi w

 scrollAugNextInSection :: World -> World
 scrollAugNextInSection w =
-    w & hud %~ doscroll
+    w
+        & hud %~ doscroll
        & worldEventFlags . at InventoryChange ?~ ()
        & setInvPosFromSS
        & cWorld . lWorld %~ crUpdateItemLocations 0
@@ -236,7 +236,9 @@ closeButtonToSelectionItem w i = do
 btText :: Button -> String
 btText bt = case _btEvent bt of
    ButtonPress {} -> "BUTTON"
-    ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
+    --ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
+    ButtonSwitch {} -> "SWITCH"
+    ButtonDumbSwitch {} -> "SWITCH"  -- do we want to show switch status?
    ButtonAccessTerminal i -> "TERMINAL " ++ show i

 closeItemToTextPictures :: Item -> ([String], Color)
@@ -13,7 +13,10 @@ itemAimStance dt
    | otherwise = itemBaseStance $ dt ^. dtValue . _1
  where
    islasweapon = dt ^. dtValue . _1 . itType == CRAFT TRANSFORMER
-        && dt ^? dtRight . ix 0 . dtValue . _2 == Just LaserWeaponSF
+        && islas (dt ^? dtRight . ix 0 . dtValue . _2) -- == Just LaserWeaponSF
+    islas = \case
+        Just (LaserWeaponXSF {}) -> True
+        _ -> False

 itemBaseStance :: Item -> AimStance
 itemBaseStance itm = case itm ^. itType of
@@ -42,6 +42,7 @@ craftItemSPic = \case
    PIPE -> colorSH green $ xCylinderST 3 10
    TUBE -> colorSH cyan $ xCylinderST 5 20
    HARDWARE -> colorSH orange $ upperPrismPolyST 3 $ square 4
+    BEAMSPLITTER -> colorSH orange $ upperPrismPolyST 3 $ square 4
    SPRING -> colorSH green $ xCylinderST 1 5
    HOSE -> colorSH green $ xCylinderST 1 10
    TAPE ->
@@ -53,8 +53,9 @@ itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of
 itemBelowAttachables :: CItem -> [ItemSF]
 itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
    (LASER, WeaponTargetingSF) -> getAmmoLinks itm
-    (LASER, LaserWeaponSF) -> [PulseBallSF] <> getAmmoLinks itm
-    (LASER, PulseBallSF) -> [PulseBallSF]
+    (LASER, LaserWeaponXSF 1) -> [PulseBallSF,BeamSplitterSF] <> getAmmoLinks itm
+    (LASER, LaserWeaponXSF {}) -> replicate 5 BeamSplitterSF <> getAmmoLinks itm
+--    (LASER, PulseBallSF) -> [PulseBallSF]
    --(HELD LASER, _) -> [PulseBallSF]
    (HELD LED, _) -> getAmmoLinks itm
    (ATTACH CAPACITOR, _) -> [AmmoMagSF 0 ElectricalAmmo]
@@ -151,10 +152,12 @@ treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
    ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
    HELD GLAUNCHER -> S.singleton UnderBarrelPlatformSF
    HELD BURSTRIFLE -> S.singleton UnderBarrelPlatformSF
-    LASER | sf == WeaponTargetingSF -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
+    LASER | sf == WeaponTargetingSF -> S.fromList (WeaponTargetingSF: [LaserWeaponXSF i| i <- [1..6]])
+    LASER -> S.fromList [LaserWeaponXSF i| i <- [1..6]]
    -- following limits items to ten ammo slots
    _ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
    ATTACH CAPACITOR -> S.fromList [CapacitorSF,PulseBallSF]
+    CRAFT BEAMSPLITTER -> S.singleton BeamSplitterSF
    _ -> S.singleton (ldt ^. dtValue . _2)
  where
    sf = ldt ^. dtValue . _2
@@ -172,7 +175,7 @@ leftIsParentCombine ltree rtree = do
        & dtValue %~ f

 updateLeftParentSF :: ItemType -> ItemSF -> ItemSF -> ItemSF
-updateLeftParentSF LASER WeaponTargetingSF TransformerSF = LaserWeaponSF
+updateLeftParentSF LASER WeaponTargetingSF TransformerSF = LaserWeaponXSF 1
 updateLeftParentSF _ psf _ = psf

 rightIsParentCombine :: DTComb CItem
@@ -183,7 +186,8 @@ rightIsParentCombine ltree rtree = do
        & dtValue %~ f

 updateRightParentSF :: ItemType -> ItemSF -> ItemSF -> ItemSF
-updateRightParentSF LASER LaserWeaponSF CapacitorSF = PulseLaserSF
+updateRightParentSF LASER (LaserWeaponXSF 1) CapacitorSF = PulseLaserSF
+updateRightParentSF LASER (LaserWeaponXSF x) BeamSplitterSF = LaserWeaponXSF (x+1)
 updateRightParentSF _ psf _ = psf

 leftChildList :: DTree CItem -> [ItemSF]
@@ -21,7 +21,8 @@ import qualified Quaternion as Q

 turretItemOffset :: Item -> Turret -> Machine -> Point3 -> Point3
 turretItemOffset it tu mc =
-    rotate3 (_tuDir tu + _mcDir mc) . (+.+.+ V3 0 0 shoulderHeight)
+    rotate3z (_tuDir tu + _mcDir mc) 
+        . (+ V3 0 0 shoulderHeight)
        . transToHandle it

 transToHandle :: Item -> Point3 -> Point3
@@ -183,6 +183,7 @@ craftInfo fit = case fit of
    MOTOR -> "A device that can create rotational force."
    TRANSFORMER -> "A device that can step up or down voltage and current."
    PRISM -> "An object that refracts light."
+    BEAMSPLITTER -> "Divides a single light beam into two paths."
    THERMOMETER -> "An object that measures temperature."
    LIGHTER -> "A device that can create a small flame."
    MAGNET -> "A device that attracts according to its dipoles."
@@ -38,7 +38,7 @@ sfInvColor = \case
    ProjectileStabiliserSF -> white
    UnderBarrelPlatformSF -> white
    UnderBarrelSlotSF -> white
-    LaserWeaponSF -> white
+--    LaserWeaponSF -> white
    PulseLaserSF -> white
    CapacitorSF -> yellow
    PulseBallSF -> white
@@ -46,6 +46,8 @@ sfInvColor = \case
    TransformerSF -> yellow
    PumpSF -> yellow
    TorchSF{} -> green
+    LaserWeaponXSF {} -> white
+    BeamSplitterSF {} -> white

 --ammoTypeColor :: AmmoType -> Color
 --ammoTypeColor = \case
@@ -80,7 +80,7 @@ itemShapeMin g = f . (^. _1) . itemSPic
 orientAttachment :: Item -> CItem -> Point3Q
 orientAttachment par (ch,chsf) = case (_itType par, chsf) of
    (ATTACH UNDERBARRELSLOT, _) -> (V3 (-5) (-8) 0, Q.qID)
-    (_,LaserWeaponSF) -> (V3 2 8 0, Q.qID)
+    (_,LaserWeaponXSF {}) -> (V3 2 8 0, Q.qID)
 --    (_,TorchSF) -> (V3 2 8 0, Q.qID)
    --    (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
    --    (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4))
@@ -65,7 +65,7 @@ refract phasev x y wl p
 reflectPulseLaserAlong ::
    Float -> Point2 -> Point2 -> World -> ([(Point2, Object)], [Point2])
 {-# INLINE reflectPulseLaserAlong #-}
-reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHit sp ep w
+reflectPulseLaserAlong phasev sp ep w = f $ filter (isunshad . snd) $ crWlPbHitZ 20 sp ep w
  where
    f = \case
        ((p, OWall wl) : _)
@@ -1,4 +1,5 @@
-module Dodge.Laser.Update (updateLaser, drawLaser) where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Laser.Update (updateLaser, drawLaser, drawPulseLaser,ltToCol) where

 import Dodge.Damage
 import Control.Lens
@@ -17,7 +18,7 @@ updateLaser w pt =
                thHit
                w
        TargetingLaser itid -> w & pointerToItemID itid . itTargeting . itTgPos ?~ last ps
-    , drawLaser (_lpColor pt) (sp : ps)
+    , drawLaser (_lpType pt) (sp : ps)
    )
  where
    phasev = _lpPhaseV pt
@@ -26,9 +27,21 @@ updateLaser w pt =
    xp = sp +.+ 800 *.* unitVectorAtAngle dir
    (thHit, ps) = reflectLaserAlong phasev sp xp w

-drawLaser :: Color -> [Point2] -> Picture
-drawLaser col =
+drawLaser :: LaserType -> [Point2] -> Picture
+drawLaser lt =
    setLayer BloomLayer -- was nozwrite
        . setDepth 19.5
-        . color (brightX 10 1 col)
+        . color (brightX 10 1 (ltToCol lt))
+        . thickLine 3
+
+ltToCol :: LaserType -> Color
+ltToCol = \case
+    DamageLaser {} -> yellow
+    TargetingLaser {} -> green
+
+drawPulseLaser :: [Point2] -> Picture
+drawPulseLaser =
+    setLayer BloomLayer -- was nozwrite
+        . setDepth 19.5
+        . color (brightX 10 1 cyan)
        . thickLine 3
@@ -31,7 +31,7 @@ generateWorldFromSeed rdata i = do
 postGenerationProcessing :: RenderData -> GenWorld -> IO World
 postGenerationProcessing _ gw = do
    let w = _gwWorld gw & cWorld . cwTiles .~ (tilesFromRooms . IM.elems $ _genRooms gw)
-    putStrLn $ show $ gw ^. genInts
+--    print $ gw ^. genInts
    return $ foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)

 assignPushDoors :: World -> Door -> World
@@ -61,10 +61,6 @@ contToIDCont f _ = f . fromJust . _plMID
 jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
 jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing Nothing . const

-jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
-jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $
-    \_ plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt
-
 ps0j :: PSType -> Placement -> Placement
 ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing Nothing (\_ -> const $ Just plmnt)

@@ -25,13 +25,13 @@ lockRoomMultiItems =

 lockRoomKeyItems :: [(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)]
 lockRoomKeyItems =
--    [ (lasCenSensEdge, takeOne [LASER,HELD TESLACOIL, HELD FLATSHIELD])
--    , (sensorRoomRunPast LaserSensor, return LASER)
--    [ (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
--    [ (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])
--    [ (const glassLessonRunPast, takeOne [LASER])
-    [ (const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD])
--    , (keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))
+    [ (lasCenSensEdge, takeOne [LASER,HELD TESLACOIL, HELD FLATSHIELD])
+    , (sensorRoomRunPast LaserSensor, return LASER)
+    , (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
+    , (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])
+    , (const glassLessonRunPast, takeOne [LASER])
+    , (const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD])
+    , (keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))
    ]

 keyCardRunPastRand :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
@@ -89,7 +89,7 @@ updateTurret rotSpeed mc w =
                . mcType
                . mctTurret
                . tuDir
-                %~ ((subtract mcdir) . turnTo rotSpeed mcpos aimpos . (+mcdir))
+                %~ (subtract mcdir . turnTo rotSpeed mcpos aimpos . (+mcdir))
        | otherwise = id
    closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
    updateFiringStatus
@@ -1,4 +1,8 @@
-module Dodge.Placement.Instance.Button where
+module Dodge.Placement.Instance.Button (
+    putLitButOnPos,
+    extTrigLitPos,
+    putLitButOnPosExtTrig,
+) where

 import Color
 import Control.Lens
@@ -8,71 +12,66 @@ import Dodge.LevelGen.PlacementHelper
 import Dodge.LevelGen.Switch
 import Dodge.LightSource
 import Dodge.Placement.Instance.LightSource
-import Dodge.PlacementSpot
+--import Dodge.PlacementSpot
 import Geometry
+import Shape

-triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
-triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
-    \tp ->
-        Just $
-            pContID
-                ps
-                ( PutButton
-                    ( makeSwitch
-                        c1 c2
-                        (SetTrigger True $ trigid tp)
-                        (SetTrigger False $ trigid tp)
-                    )
-                )
-                (const Nothing)
-  where
-    trigid tp = fromJust $ _plMID tp
+--triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
+--triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
+--    \tp ->
+--        Just $
+--            pContID
+--                ps
+--                ( PutButton
+--                    ( makeSwitch
+--                        c1
+--                        c2
+--                        (SetTrigger True $ trigid tp)
+--                        (SetTrigger False $ trigid tp)
+--                    )
+--                )
+--                (const Nothing)
+--  where
+--    trigid tp = fromJust $ _plMID tp
+--
+--triggerSwitchSPicLight :: Color -> Color -> PlacementSpot -> Placement
+--triggerSwitchSPicLight c1 c2 ps = psPtCont ps (PutTrigger False) $
+--    \tp -> Just $
+--        pContID atFstLnkOut (PutLS thels) $
+--            \lsid ->
+--                Just $
+--                    pContID
+--                        ps
+--                        (PutButton (makeSwitch c1 c2 (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
+--                        (const Nothing)
+--  where
+--    thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
+--    trigid tp = fromJust $ _plMID tp
+--    oneff lsid tid = WorldEffects [SetLSCol (V3 0 0.5 0) lsid, SetTrigger True tid]
+--    offeff lsid tid = WorldEffects [SetLSCol (V3 0.5 0 0) lsid, SetTrigger False tid]

-triggerSwitchSPicLight :: Color -> Color -> PlacementSpot -> Placement
-triggerSwitchSPicLight c1 c2 ps = psPtCont ps (PutTrigger False) $
-    \tp -> Just $
-        pContID atFstLnkOut (PutLS thels) $
-            \lsid ->
-                Just $
-                    pContID
-                        ps
-                        (PutButton (makeSwitch c1 c2 (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
-                        (const Nothing)
-  where
-    thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
-    trigid tp = fromJust $ _plMID tp
-    oneff lsid tid = WorldEffects [SetLSCol (V3 0 0.5 0) lsid, SetTrigger True tid]
-    offeff lsid tid = WorldEffects [SetLSCol (V3 0.5 0 0) lsid, SetTrigger False tid]
-
-triggerSwitch :: Color -> PlacementSpot -> Placement
-triggerSwitch col ps = psPtCont ps (PutTrigger False) $
-    \tp ->
-        Just $
-            pContID
-                ps
-                ( PutButton
-                    ( makeSwitch
-                        col
-                        col
-                        (SetTrigger True $ trigid tp)
-                        (SetTrigger False $ trigid tp)
-                    )
-                )
-                (const Nothing)
-  where
-    trigid tp = fromJust $ _plMID tp
+--triggerSwitch :: Color -> PlacementSpot -> Placement
+--triggerSwitch col ps = psPtCont ps (PutTrigger False) $
+--    \tp ->
+--        Just $
+--            pContID
+--                ps
+--                (PutButton (makeSwitch col col (SetTrigger True $ trigid tp) (SetTrigger False $ trigid tp)))
+--                (const Nothing)
+--  where
+--    trigid tp = fromJust $ _plMID tp

 putLitButOnPos :: Color -> PlacementSpot -> (Placement -> Maybe Placement) -> Placement
 putLitButOnPos col theps subpl =
    plSpot .~ theps $
-        mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $
-            \plmnt ->
+        mntLSOn shp ls 0 (V3 0 (-40) 40) $
+            \pmnt ->
                jps0'
-                    (PutButton (makeButton col (changeLight . fromJust $ _plMID plmnt)){_btPos = V2 0 (-1), _btRot = pi})
+                    (PutButton (makeButton col (changeLight $ pmnt ^?! plMID . _Just) & btPos .~ V2 0 (-1) & btRot .~ pi))
                    subpl
-                    <&> plSpot
-                    .~ _plSpot plmnt
+                    <&> plSpot .~ _plSpot pmnt
  where
+    shp = fmap (fmap $ colorSH col) aShape
    changeLight = SetLSCol (V3 0 0.5 0)
    ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50

@@ -107,11 +106,11 @@ putLitButOnPosExtTrig' col thePS cnt =
    psPtCont thePS (PutTrigger False) $
        \tp -> Just $
            plSpot .~ _plSpot tp $
-                mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $
+                mntLSOn shp ls 0 (V3 0 (-40) 40) $
                    \plmnt ->
                        jps0'
                            ( PutButton
-                                (makeButton col (WorldEffects [changeLight (fromJust $ _plMID plmnt), oneff (trigid tp)]))
+                                (makeButton col (buteff (trigid tp) (fromJust $ _plMID plmnt)))
                                    { _btPos = V2 0 (-1)
                                    , _btRot = pi
                                    }
@@ -120,7 +119,7 @@ putLitButOnPosExtTrig' col thePS cnt =
                            <&> plSpot
                                .~ _plSpot plmnt
  where
+    buteff i j = SetTriggerAndSetLSCol True i (V3 0 0.5 0) j
+    shp = fmap (fmap $ colorSH col) aShape
    trigid tp = fromJust $ _plMID tp
-    oneff = SetTrigger True
-    changeLight = SetLSCol (V3 0 0.5 0)
    ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50
@@ -14,78 +14,55 @@ import Dodge.LevelGen.PlacementHelper
 import Geometry
 import Linear

-putDoubleDoor :: Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
-putDoubleDoor wl cond a b speed =
-    putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
+putDoubleDoor :: Wall -> Point2 -> Point2 -> Door -> Placement
+putDoubleDoor wl a b dr = putDoubleDoorThen wl 1 a b dr (const $ const Nothing)

 putDoubleDoorThen ::
    Wall ->
-    WdBl ->
    Float ->
    Point2 ->
    Point2 ->
-    Float ->
+    Door ->
    (Placement -> Placement -> Maybe Placement) ->
    Placement
-putDoubleDoorThen wl cond soff a b speed cont =
-    doorBetween wl cond soff a half speed $
-        \pl1 -> Just $
-            doorBetween wl cond soff b half speed $
-                \pl2 -> cont pl1 pl2
+putDoubleDoorThen wl soff a b dr cont =
+    doorBetween wl soff a half dr $
+        \pl1 -> Just $ doorBetween wl soff b half dr $ \pl2 -> cont pl1 pl2
  where
    half = 0.5 *^ (a + b)

 doorBetween ::
    Wall ->
-    WdBl ->
    Float ->
    Point2 ->
    Point2 ->
-    Float ->
+    Door ->
    (Placement -> Maybe Placement) ->
    Placement
-doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
--    [x, y] -> ptCont (putSlideDr adoor wl soff x y) g
+doorBetween wl soff pa pb dr g = case divideLine 40 pa pb of
    (x : y : zs) ->
-        divideDoorPane
-            Nothing
-            wl
-            cond
-            (soff - dist y pb)
-            speed
-            (zip (x : y : zs) (y : zs))
-            g
+        divideDoorPane Nothing wl (soff - dist y pb) dr (zip (x : y : zs) (y : zs)) g
    _ -> error "tried to create doorBetween with too few points"
--  where
--    adoor =
--        defaultDoor
--            & drTrigger .~ cond
--            & drUpdate .~ DoorLerp speed

 divideDoorPane ::
    Maybe Int ->
    Wall ->
-    WdBl ->
-    Float ->
    Float ->
+    Door ->
    [(Point2, Point2)] ->
    (Placement -> Maybe Placement) ->
    Placement
-divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
+divideDoorPane mid wl soff dr ppairs g = case ppairs of
    [p] -> ptCont (adoor p) g
    (p : ps) -> ptCont (adoor p) $
-        \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
+        \pl -> Just $ divideDoorPane (_plMID pl) wl soff dr ps g
    _ -> undefined
  where
    adoor (x, y) = putSlideDr thedoor wl soff x y
-    thedoor =
-        defaultDoor
-            & drUpdate . drLerpSpeed .~ speed
-            & drTrigger .~ cond
-            & drPushedBy .~ maybe PushesItself PushedBy mid
+    thedoor = dr & drPushedBy .~ maybe PushesItself PushedBy mid

 putAutoDoor :: Point2 -> Point2 -> Placement
-putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
+putAutoDoor a b = pt0 (PutCoord a) $ \apl ->
    Just $
        Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
            let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
@@ -93,7 +70,9 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
             in Just $
                    putDoubleDoor
                        defaultAutoWall
-                        (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrIsAnimate)
                        a
                        b
-                        3
+                        ( defaultDoor
+                            & drTrigger .~ WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor
+                            & drUpdate .~ DoorLerpWithTimer 0 3
+                        )
@@ -36,21 +36,22 @@ mntLSOn ::
    -- | function describing the mount shape
    (Point2 -> Point3 -> Shape) ->
    -- | describing a possible color override for the shape
-    Maybe Color ->
    LightSource ->
    Point2 ->
    Point3 ->
    (Placement -> Maybe Placement) ->
    Placement
-mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _) =
+mntLSOn shapeF ls wallp lsp@(V3 lx ly _) =
    ps0jPushPS (PutLabel "light") .
-    ps0jPushPS (putShape . setCol $ shapeF wallp lsp)
+    ps0jPushPS (putShape $ shapeF wallp lsp)
+    --ps0j (PutLabel "light") .
+    --ps0j (putShape $ shapeF wallp lsp)
        . pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
  where
    lsp' = lsp -.-.- V3 x y 1
    -- hack! perturb the light position
    V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
-    setCol = maybe id colorSH mcol
+--    setCol = maybe id colorSH mcol

 iShape :: Point2 -> Point3 -> Shape
 iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
@@ -95,38 +96,17 @@ aShape wallpos (V3 x y z) = girder (z + 2) 20 10 pout wallpos
    pout = V2 x y -.- 2 *.* squashNormalizeV (V2 x y -.- wallpos)

 vShape :: Point2 -> Point3 -> Shape
-vShape wallpos (V3 x y z) =
-    thinHighBar z wallposUp lxy
-        <> thinHighBar z wallposDown lxy
+vShape p (V3 x y z) = abar n <> abar (-n)
  where
+    abar a = thinHighBar z (p + a) lxy
    lxy = V2 x y
-    n = vNormal (wallpos -.- lxy)
-    wallposUp = wallpos +.+ n
-    wallposDown = wallpos -.- n
+    n = vNormal (p - lxy)

 mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
-mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
+mntLS shp wallp lampp = mntLSOn shp defaultLS wallp lampp (const Nothing)
  where
    defaultLS = LS 0 $ LSParam 0 300 0.6

--mntLSCol :: (Point2 -> Point3 -> Shape) -> Color -> Point2 -> Point3 -> Placement
--mntLSCol shp col wallp lampp = mntLSOn shp (Just col) defaultLS wallp lampp (const Nothing)
--  where
--    defaultLS = LS 0 $ LSParam 0 200 0.6
-
--mntLSLampCol :: (Point2 -> Point3 -> Shape) -> Color -> Point2 -> Point3 -> Placement
--mntLSLampCol shp (V4 x y z _) wallp lampp =
--    mntLSOn
--        shp
--        Nothing
--        (defaultLS & lsParam . lsCol .~ col)
--        wallp
--        lampp
--        (const Nothing)
--  where
--    col = V3 x y z
--    defaultLS = LS 0 $ LSParam 0 200 0.6
-
 mntLSCond ::
    (Point2 -> Point3 -> Shape) ->
    --    -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
@@ -150,7 +130,7 @@ mntLightLnkCond ps = do
    return $ mntLSCond (fmap (fmap $ colorSH black) shp) ps

 mntLightLnkShape :: (Point2 -> Point3 -> Shape) -> PlacementSpot -> Placement
-mntLightLnkShape shp ps = mntLSCond (fmap (fmap $ colorSH black) shp) ps
+mntLightLnkShape shp = mntLSCond (fmap (fmap $ colorSH black) shp)

 mntLightLnkCond' :: PlacementSpot -> Placement
 mntLightLnkCond' = mntLSCond (fmap (fmap $ colorSH black) vShape)
@@ -57,9 +57,7 @@ placePlainPSSpot w rid plmnt shift = case plmnt ^. plType of
        j <- x ^. plExternalID
        return $ gw & genPmnt . at j ?~ x
    recrPlace newplmnt w' =
-        placeSpot
-            rid
-            (w' & genRooms . ix rid . rmPmnts .:~ newplmnt)
+        placeSpot rid (w' & genRooms . ix rid . rmPmnts .:~ newplmnt)

 -- this should be tidied up
 placeSpotUsingRoomPos ::
@@ -94,7 +92,7 @@ placeSpotRoomRand ::
 placeSpotRoomRand rid i f plmnt w =
    let (ps, g) =
            runState
-                (_rmRandPSs (w ^?! genRooms . ix rid) !! i)
+                (w ^?! genRooms . ix rid . rmRandPSs . ix i)
                $ w ^. gwWorld . randGen
     in placeSpot rid (w & gwWorld . randGen .~ g) (plmnt & plSpot .~ f ps)

@@ -102,60 +100,67 @@ placeSpotRoomRand rid i f plmnt w =
 placeSpotID :: Int -> PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
 placeSpotID rid ps pt w = case pt of
    PutTrigger cnd -> plNewID (gwWorld . cWorld . lWorld . triggers) cnd w
-    PutMod mdi -> plNewUpID (gwWorld . cWorld . lWorld . modifications) mdID mdi w
-    PutProp prp -> plNewUpID (gwWorld . cWorld . lWorld . props) prID (mvProp p rot prp) w
+    PutMod mdi ->
+        plNewUpID (gwWorld . cWorld . lWorld . modifications) mdID mdi w
+    PutProp prp ->
+        plNewUpID (gwWorld . cWorld . lWorld . props) prID (mvProp p rot prp) w
    PutButton bt ->
-        plNewUpID
-            (gwWorld . cWorld . lWorld . buttons)
-            btID
-            (mvButton p rot bt)
-            w
+        plNewUpID (gwWorld . cWorld . lWorld . buttons) btID (mvButton p rot bt) w
    PutTerminal tm -> plNewUpID (gwWorld . cWorld . lWorld . terminals) tmID tm w
    PutFlIt itm ->
        let i = IM.newKey (w ^. gwWorld . cWorld . lWorld . items)
         in ( i
            , w
-                & gwWorld . cWorld . lWorld . floorItems . at i ?~ FlIt p rot
-                & gwWorld . cWorld . lWorld . items . at i
-                    ?~ ( itm & itID .~ NInt i
-                            & itLocation .~ OnFloor
-                       )
+                & gwWorld
+                . cWorld
+                . lWorld
+                . floorItems
+                . at i
+                ?~ FlIt p rot
+                & gwWorld
+                . cWorld
+                . lWorld
+                . items
+                . at i
+                ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor)
            )
    PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
    PutForeground fs ->
        (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
    PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
-    PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
+    PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p rot ls) w
    RandPS _ -> error "RandPS should not be reachable here" -- evaluateRandPS rid rgn ps w
    PutDoor dr wl -> plDoor (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
    PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
    PutBlock bl wl ps' ->
-        plBlock
-            (map doShift ps')
-            (bl & blPos %~ doShift & blDir .~ rot)
-            wl
-            w
+        plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot) wl w
    PutLineBlock wl wdth a b -> plLineBlock wl wdth (doShift a) (doShift b) w
    PutWall qs wl -> (0, over gwWorld (placeWallPoly (map doShift qs) wl) w)
    PutNothing -> (0, w)
    PutID i -> (i, w)
    PutWorldUpdate f -> (0, w & f rid ps)
-    PutChasm ps' qs -> (0, placeChasm w rid ps' (map (map doShift) ps') 
-        (foldMap loopPairs (map (map doShift) qs)))
+    PutChasm ps' qs ->
+        ( 0
+        , placeChasm
+            rid
+            ps'
+            (map (map doShift) ps')
+            (foldMap (loopPairs . map doShift) qs)
+            w
+        )
    PutLabel{} -> (0, w)
  where
-    p@(V2 px py) = _psPos ps
-    p' = V3 px py 0
+    p = _psPos ps
    rot = _psRot ps
    doShift = shiftPointBy (p, rot)
    pashift = compP2A (p, rot)

-placeChasm :: GenWorld -> Int -> [[Point2]] -> [[Point2]] -> [(Point2,Point2)] -> GenWorld
-placeChasm gw rid ps shiftps cfs =
-    gw & gwWorld . cWorld . chasms <>~ shiftps
-        & gwWorld . cWorld . cliffs <>~ cfs
-        & genRooms . ix rid . rmPos %~ filter (\rp -> not $ any (pointInPoly (_rpPos rp)) ps)
-        & gwWorld %~ f
+placeChasm :: Int -> [[Point2]] -> [[Point2]] -> [(Point2, Point2)] -> GenWorld -> GenWorld
+placeChasm rid ps shiftps cfs =
+    (gwWorld . cWorld . chasms <>~ shiftps)
+        . (gwWorld . cWorld . cliffs <>~ cfs)
+        . (genRooms . ix rid . rmPos %~ filter (\rp -> not $ any (pointInPoly (_rpPos rp)) ps))
+        . (gwWorld %~ f)
  where
    -- f w = foldl' g w (loopPairs shiftps)
    f w = foldl' g w cfs
@@ -172,19 +177,16 @@ addPane wl w l = insertWall (wl & wlLine .~ l & wlID .~ i) w
    i = IM.newKey $ w ^. cWorld . lWorld . walls

 mvProp :: Point2 -> Float -> Prop -> Prop
-mvProp p a = (prRot +~ a) . (prPos %~ ((p +.+) . rotateV a))
+mvProp p a = (prRot +~ a) . (prPos %~ ((p +) . rotateV a))

 mvButton :: Point2 -> Float -> Button -> Button
-mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
+mvButton p a = (btRot +~ a) . (btPos %~ ((p +) . rotateV a))

 mvCr :: Point2 -> Float -> Creature -> Creature
-mvCr p rot =
-    (crPos . _xy .~ p)
-        . (crOldPos . _xy .~ p)
-        . (crDir .~ rot)
+mvCr p rot = (crPos . _xy .~ p) . (crOldPos . _xy .~ p) . (crDir .~ rot)

 mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
-mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
+mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +) . rotateV a))

 plMachine ::
    [Point2] ->
@@ -196,9 +198,15 @@ plMachine ::
    (Int, GenWorld)
 plMachine wallpoly mc mitm p rot gw =
    ( mcid
-    , gw & tolw . machines . at mcid ?~ themc
-        & gwWorld %~ placeMachineWalls (_mcMaterial mc) wallpoly mcid wlid
-        & tolw %~ maybe id placeturretitm mitm
+    , gw
+        & tolw
+        . machines
+        . at mcid
+        ?~ themc
+        & gwWorld
+        %~ placeMachineWalls (_mcMaterial mc) wallpoly mcid wlid
+        & tolw
+        %~ maybe id placeturretitm mitm
    )
  where
    tolw = gwWorld . cWorld . lWorld
@@ -216,10 +224,13 @@ plMachine wallpoly mc mitm p rot gw =
 placeMachineWalls :: Material -> [Point2] -> Int -> Int -> World -> World
 placeMachineWalls mat poly mcid = insertStructureWalls MachinePart baseWall poly mcid
  where
-    baseWall = defaultMachineWall & wlStructure . wsMachine .~ mcid
-        & wlMaterial .~ mat
+    baseWall =
+        defaultMachineWall
+            & wlStructure
+            . wsMachine
+            .~ mcid
+            & wlMaterial
+            .~ mat

-mvLS :: Point3 -> Float -> LightSource -> LightSource
-mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z + startPos
-  where
-    startPos = onXY (rotateV rot) $ _lsPos (_lsParam ls)
+mvLS :: Point2 -> Float -> LightSource -> LightSource
+mvLS x rot = lsParam . lsPos . _xy %~ ((+ x) . rotateV rot)
@@ -1,6 +1,4 @@
-module Dodge.Render.Lights (
-    lightsToRender,
-) where
+module Dodge.Render.Lights (lightsToRender) where

 import Data.List (sortOn)
 import Data.Maybe
@@ -115,7 +115,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
    OverCombEscape -> rotate (pi / 4) $ drawPlus 5
    OverTerminal _ ts -> drawCursorByTerminalStatus ts
    OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
-    MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
+    MouseGameRotate {} -> rotate a (drawVerticalDoubleArrow 5)
    OverDebug {} -> drawPlus 5 <> rotate (pi/4) (drawPlus 5)
    --OverDebug db i -> scale 0.1 0.1 $ text (show db ++ show i)
  where
@@ -37,7 +37,7 @@ worldSPic cfig u =
                (lw ^. items)
                (filtOn _flItPos _floorItems)
            )
-        <> foldup btSPic (filtOn _btPos _buttons)
+        <> foldup (btSPic (w ^. cWorld . lWorld)) (filtOn _btPos _buttons)
        <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
 --        <> foldMap' drawChasm (w ^. cWorld . chasms)
        <> foldMap' (Prelude.uncurry drawCliff) (w ^. cWorld . cliffs)
@@ -166,8 +166,8 @@ floorItemSPic itm flit =
            (_flItRot flit)
            (itemSPic itm)

-btSPic :: Button -> SPic
-btSPic bt = uncurryV translateSPxy (_btPos bt) $ rotateSP (_btRot bt) (drawButton bt)
+btSPic :: LWorld -> Button -> SPic
+btSPic lw bt = uncurryV translateSPxy (_btPos bt) $ rotateSP (_btRot bt) (drawButton lw bt)

 mcSPic :: CWorld -> Machine -> SPic
 mcSPic cw mc = uncurryV translateSPxy (_mcPos mc) $ rotateSP (_mcDir mc) (drawMachine cw mc)
@@ -26,8 +26,7 @@ import ShapePicture

 -- | A passage with a switch that opens forward access while closing backwards access.
 airlock :: RandomGen g => State g Room
-airlock =
-    join $
+airlock = join $
        takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ]

 xSwitch :: PSType
@@ -44,8 +43,8 @@ decontamRoom i =
        & rmPmnts
            .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $
                    \btid -> Just $
-                        putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-                            \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+                        putDoubleDoorThen defaultDoorWall 1 (V2 0 20) (V2 40 20) (dr1 btid) $
+                            \_ _ -> Just $ putDoubleDoor defaultDoorWall (V2 0 80) (V2 40 80) (dr2 btid)
               , invisibleWall $ rectNSWE 60 40 (-40) (-30)
               , spanLightI (V2 (-20) 30) (V2 (-20) 70)
               , analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i
@@ -55,15 +54,16 @@ decontamRoom i =
        & rmInPmnt .~ [(0, return . f)]
        & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
  where
+    dr1 btid = defaultDoor & drTrigger .~ WdBlNegate (WdBlBtOn btid)
+    dr2 btid = defaultDoor & drTrigger .~ WdBlBtOn btid
    f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
        pmnt <- gw ^? genPmnt . ix i
        return $
            putDoubleDoor
                defaultDoorWall
-                (cond pmnt)
                (V2 (-10) 35)
                (V2 (-10) 65)
-                2
+                (defaultDoor & drTrigger .~ cond pmnt)
    cond pmnt = WdTrig $ pmnt ^?! plMID . _Just
    mcpos = V2 70 50
    cutps = [rectNSWE 100 0 0 40, switchcut]
@@ -84,15 +84,17 @@ airlock0 =
        , _rmPmnts =
            [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $
                \btid -> Just $
-                    putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-                        \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+                    putDoubleDoorThen defaultDoorWall 1 (V2 0 20) (V2 40 20) (dr1 btid) $
+                        \_ _ -> Just $ putDoubleDoor defaultDoorWall (V2 0 80) (V2 40 80) (dr2 btid)
            , invisibleWall $ rectNSWE 60 40 (-40) (-30)
            , spanLightI (V2 (-2) 30) (V2 (-2) 70)
-            , sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
+            , sps0 $ putShape $ thinHighBar 95 (V2 40 50) (V2 (-1) 50)
            ]
        , _rmBound = [rectNSWE 75 15 0 40, switchcut]
        }
  where
+    dr1 btid = defaultDoor & drTrigger .~ WdBlNegate (WdBlBtOn btid)
+    dr2 btid = defaultDoor & drTrigger .~ WdBlBtOn btid
    switchcut = rectNSWE 65 35 (-40) 20
    lnks =
        [ (V2 20 95, 0)
@@ -1,6 +1,7 @@
 {- Rooms that connect other rooms, blocking sight.  -}
 module Dodge.Room.Door where

+import Dodge.Default.Door
 import Dodge.Default.Wall
 import Data.Maybe
 import Dodge.Data.GenWorld
@@ -42,5 +43,6 @@ triggerDoorRoom i =
  where
    f gw = return $ fromMaybe (error "tried to put a door using an empty placement list") $ do
        pmnt <- gw ^? genPmnt . ix i
-        return $ putDoubleDoor defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
+        return $ putDoubleDoor defaultDoorWall (V2 0 20) (V2 40 20)
+            (defaultDoor & drTrigger .~ cond pmnt)
    cond pmnt = WdTrig $ fromJust (_plMID pmnt)
@@ -121,7 +121,7 @@ girderZ h d w x y =
            [ thinHighBar h xt yt
            , thinHighBar h xb yb
            ]
-                <> zipWith (thinHighBar (h )) ps qs
+                <> zipWith (thinHighBar (h-1)) ps qs
  where
    n = w *.* normalizeV (vNormal $ y -.- x)
    xb = x +.+ n
@@ -49,7 +49,7 @@ import Shape

 -- no lights!
 cenLasTur :: (RandomGen g) => State g Room
-cenLasTur = do
+cenLasTur =
    roomNgon 8 200
        <&> rmPmnts
        .~ [ putLasTurret 0.02
@@ -168,7 +168,7 @@ lasCenSensEdge n = do
    lshape <- takeOne [vShape, lShape, jShape, liShape]
    let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a + _rpDir rp))
        blight a = (0, return . alight a . f i)
-    let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, (0.5 * pi), (1.5 * pi)]
+    let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, 0.5 * pi, 1.5 * pi]
    let doorroom = triggerDoorRoom n
    rToOnward "lasCenSensEdge" $
        treeFromTrunk [door] $
@@ -194,7 +194,7 @@ lasRunYinYang = do
                const
                    . ( \rp ->
                            PolyEdge ((npoly + 1) `div` 4)
-                                `S.member` (fold $ rp ^? rpType . rplsType)
+                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    thelight3 <-
        mntLightLnkCond $
@@ -202,7 +202,7 @@ lasRunYinYang = do
                const
                    . ( \rp ->
                            PolyEdge (3 * (npoly + 1) `div` 4)
-                                `S.member` (fold $ rp ^? rpType . rplsType)
+                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    r <-
        shuffleLinks
@@ -231,16 +231,16 @@ lasRunYinYang = do
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
-    awall x v = heightWallPS (PS x 0) 30 v
+    awall x = heightWallPS (PS x 0) 30
    -- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
    rf = 0.8
    offxy = V2 0 (-100)
-    angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi / 4 + a * rf)) $ rectWH 5 (23 - a * 13 / pi))
+    angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * rf) <$> rectWH 5 (23 - a * 13 / pi))
    apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
      where
        a = a' + pi / 16
        f = rotateV (pi / 4 + a * 0.8)
-    bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (fmap (rotateV (pi / 4 + a * rf)) $ rectWH 5 (23 - a * 13 / pi))
+    bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * rf) <$> rectWH 5 (23 - a * 13 / pi))
    bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
      where
        a = a' + pi / 16
@@ -257,7 +257,7 @@ lasRunYinYangCenter = do
                const
                    . ( \rp ->
                            PolyEdge ((npoly + 1) `div` 4)
-                                `S.member` (fold $ rp ^? rpType . rplsType)
+                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    thelight3 <-
        mntLightLnkCond $
@@ -265,7 +265,7 @@ lasRunYinYangCenter = do
                const
                    . ( \rp ->
                            PolyEdge (3 * (npoly + 1) `div` 4)
-                                `S.member` (fold $ rp ^? rpType . rplsType)
+                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    --    thelight3 <- mntLightLnkCond $ rprBool $ const . isOutLnk
    r <-
@@ -293,14 +293,14 @@ lasRunYinYangCenter = do
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
-    awall x v = heightWallPS (PS x 0) 30 v
+    awall x = heightWallPS (PS x 0) 30
    -- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
-    angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi / 4 + a * 0.8)) $ rectWH 5 (23 - a * 13 / pi))
+    angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * 0.8) <$> rectWH 5 (23 - a * 13 / pi))
    apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
      where
        a = a' + pi / 16
        f = rotateV (pi / 4 + a * 0.8)
-    bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (fmap (rotateV (pi / 4 + a * 0.8)) $ rectWH 5 (23 - a * 13 / pi))
+    bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * 0.8) <$> rectWH 5 (23 - a * 13 / pi))
    bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
      where
        a = a' + pi / 16
@@ -334,24 +334,24 @@ lasCenRunClose' = do
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    swall =
-        [ (70, (rectNSWE 10 (-10) (-10) 30))
-        , (125, (rectNSWE 55 (-55) (-10) 10))
-        , (180, (rectNSWE 10 (-10) (-30) 10))
+        [ (70, rectNSWE 10 (-10) (-10) 30)
+        , (125, rectNSWE 55 (-55) (-10) 10)
+        , (180, rectNSWE 10 (-10) (-30) 10)
        ]
    zwall =
-        [ (70, (rectNSWE 10 (-10) (-30) 10))
-        , (125, (rectNSWE 55 (-55) (-10) 10))
-        , (180, (rectNSWE 10 (-10) (-10) 30))
+        [ (70, rectNSWE 10 (-10) (-30) 10)
+        , (125, rectNSWE 55 (-55) (-10) 10)
+        , (180, rectNSWE 10 (-10) (-10) 30)
        ]
    iwall =
-        [ (70, (rectNSWE 10 (-10) (-15) 20))
-        , (180, (rectNSWE 10 (-10) (-30) (-5)))
+        [ (70, rectNSWE 10 (-10) (-15) 20)
+        , (180, rectNSWE 10 (-10) (-30) (-5))
        ]
    jwall =
-        [ (70, (rectNSWE 10 (-10) (-20) 15))
-        , (180, (rectNSWE 10 (-10) 5 30))
+        [ (70, rectNSWE 10 (-10) (-20) 15)
+        , (180, rectNSWE 10 (-10) 5 30)
        ]
-    uwall = [(180, (rectNSWE 10 (-10) (-20) 20))]
+    uwall = [(180, rectNSWE 10 (-10) (-20) 20)]
    obwalls = [swall, zwall, iwall, jwall, uwall]
    linkwall f x =
        heightWallPS
@@ -390,7 +390,7 @@ lasCenRunCloseLongCor = do
  where
    llinks = memtest (FromEdge South 1) (OnEdge West)
    rlinks = memtest (FromEdge South 1) (OnEdge East)
-    awall x v = heightWallPS (PS x 0) 30 v
+    awall x = heightWallPS (PS x 0) 30
    memtest a b x =
        let y = _rlType x
         in a `S.member` y && b `S.member` y
@@ -459,7 +459,7 @@ lasCenRunClose1 = do
        etest
            (memtest (FromEdge East 0) (OnEdge South))
            (memtest (FromEdge South 0) (OnEdge East))
-    awall x v = heightWallPS (PS x 0) 30 v
+    awall x = heightWallPS (PS x 0) 30
    etest f g x = f x || g x
    memtest a b x =
        let y = _rlType x
@@ -500,7 +500,7 @@ lasCenRunClose2 = do
        etest
            (memtest (FromEdge East 0) (OnEdge North))
            (memtest (FromEdge North 0) (OnEdge East))
-    awall x v = heightWallPS (PS x 0) 30 v
+    awall x = heightWallPS (PS x 0) 30
    etest f g x = f x || g x
    memtest a b x =
        let y = _rlType x
@@ -3,6 +3,9 @@
 -- | Rooms containing long doors, probably with a big reveal behind them.
 module Dodge.Room.LongDoor where

+import Dodge.Room.Modify
+import qualified Data.IntMap.Strict as IM
+import Dodge.Default
 import Control.Monad
 import Data.Maybe
 import qualified Data.Set as S
@@ -11,7 +14,6 @@ import Dodge.Creature
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Room
-import Dodge.Default.Wall
 import Dodge.Door.PutSlideDoor
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LevelGen.Switch
@@ -64,7 +66,6 @@ twinSlowDoorRoom w h x =
  where
    --thewall = switchWallCol red
    thewall = defaultDoorWall
-    wlSpeed = 0.5
    lampheight = 41
    ps =
        [ rectNSWE h 0 (- w) w
@@ -72,7 +73,7 @@ twinSlowDoorRoom w h x =
        ]
    thedoor btid =
        defaultDoor
-            & drUpdate . drLerpSpeed .~ wlSpeed
+            & drUpdate . drLerpSpeed .~ 0.5
            & drTrigger .~ WdBlBtOn btid
    col = dim $ dim $ bright red

@@ -116,11 +117,11 @@ addButtonSlowDoor x h =
        $ \btplmnt -> Just
            . putDoubleDoorThen
                defaultDoorWall
-                (WdBlBtOn $ fromJust $ _plMID btplmnt)
                30
                (V2 0 h)
                (V2 x h)
-                0.5
+                (defaultDoor & drTrigger .~ WdBlBtOn (fromJust $ _plMID btplmnt)
+                    & drUpdate . drLerpSpeed .~ 0.5)
            $ \dr1 dr2 ->
                Just
                    . sps0
@@ -137,6 +138,41 @@ addButtonSlowDoor x h =
    lsx = 30
    lp@(V2 lx ly) = V2 100 (-20)

+makeDumbSwitch :: Int -> Button
+makeDumbSwitch i = defaultButton & btEvent .~ ButtonDumbSwitch i
+
+slowCrushRoom :: RandomGen g => State g Room
+slowCrushRoom = do
+    rm <- shuffleLinks =<< roomRectAutoLights 200 100
+    let rm' = removeLights rm
+            & rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
+                , spanLightI (V2 200 60) (V2 165 100)
+                ]
+    return $ rm'
+        & rmLinks %~ setOutLinksByType (OnEdge East)
+        & rmLinks %~ setInLinksByType (OnEdge West)
+        & rmPmnts .:~
+         (ps0 (PutTrigger False) $ \i -> Just $
+            pContID (apos West 5) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (apos East (-5)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+        sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
+        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
+        )
+        
+  where
+    dr = defaultDoor
+        & drUpdate .~ DoorLerp 0.01
+        & drZeroPos .~ (V2 65 (-40), 0)
+        & drOnePos .~ (V2 65 50, 0)
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 35 50))
+    dr1 = dr
+        & drOnePos .~ (V2 135 (-40), 0)
+        & drZeroPos .~ (V2 135 50, 0)
+    apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ V2 x 0))
+    t edge rp _ = case _rpType rp of
+        UnusedLink s -> OnEdge edge `S.member` s
+        _ -> False
+
 slowDoorRoom :: RandomGen g => State g Room
 slowDoorRoom = do
    x <- state $ randomR (400, 800)
@@ -48,10 +48,10 @@ addLightsNGon rm = do
    x = y * tan (0.5 * a)
    f i gw = do
        lshape <- takeOne [vShape, lShape, jShape, liShape]
-        let ps = fromMaybe (PS (V2 y 0) 0) $ rpToPS <$> find iscolorlight (grm ^. rmPos)
+        let ps = maybe (PS (V2 y 0) 0) rpToPS $ find iscolorlight (grm ^. rmPos)
            alight a' = mntLSCond (fmap (fmap $ colorSH black) lshape) (rotateps a' ps)
        takeOne
-            [ spanLightY (V2 0 0) (V2 y x) (V2 (x) y) (V2 (x) (-y))
+            [ spanLightY (V2 0 0) (V2 y x) (V2 x y) (V2 x (-y))
            , spanLightY (V2 20 20) (V2 y 20) (V2 (-y) 20) (V2 20 (-y))
            , spanLightI (V2 22 y) (V2 22 (-y))
            , spanLightI (V2 x y) (V2 (-x) (-y))
@@ -61,7 +61,7 @@ addLightsNGon rm = do
        grm = getRoomFromID i gw
    rotateps a' (PS v d) = PS (rotateV a' v) (a' + d)
    rotateps _ _ = error "in addLightsNGon"
-    rpToPS rp = (PS (_rpPos rp) (_rpDir rp))
+    rpToPS rp = PS (_rpPos rp) (_rpDir rp)
    iscolorlight rp =
        (ColoredLightRP `S.member` (rp ^. rpFlags))
            && islinkroompos rp
@@ -5,6 +5,7 @@ module Dodge.Room.Pillar (
    roomPillarsPassage,
 ) where

+import Linear
 import qualified Data.Set as S
 import Dodge.Cleat
 import Dodge.Data.GenWorld
@@ -60,7 +61,7 @@ roomPillarsSquare = do
                    [ mntLS
                        vShape
                        (rotateVAround (V2 150 150) a (V2 30 30))
-                        (onXY (rotateVAround (V2 150 150) a) $ V3 60 60 95)
+                        (_xy %~ rotateVAround (V2 150 150) a $ V3 60 60 95)
                    | a <- [0, pi / 2, pi, 3 * pi / 2]
                    ]
            , return
@@ -69,7 +70,7 @@ roomPillarsSquare = do
                    [ mntLS
                        vShape
                        (rotateVAround (V2 150 150) a (V2 150 0))
-                        (onXY (rotateVAround (V2 150 150) a) $ V3 150 20 95)
+                        (_xy %~ rotateVAround (V2 150 150) a $ V3 150 20 95)
                    | a <- [0, pi / 2, pi, 3 * pi / 2]
                    ]
            , addGirderLights . set rmPmnts []
@@ -37,7 +37,7 @@ import RandomHelp

 --import Control.Lens
 -- This will need a cleanup, but it might change a bit first
-{- A simple rectangular room with a light in the center.
+{- A simple rectangular room with no lights.
 Creates links and pathfinding graph.  -}
 roomRect :: Float -> Float -> Int -> Int -> Room
 roomRect x y xn yn =
@@ -310,7 +310,4 @@ centerVaultRoom w h d =
                    sPS (V2 0 (d -10)) 0 (putSlideDr (thedoor btid) thewall 1 (V2 21 0) (V2 0 0))
        ]
    thewall = defaultDoorWall
-    thedoor btid =
-        defaultDoor
-            & drTrigger .~ WdBlBtOn btid
-            & drUpdate . drLerpSpeed .~ 2
+    thedoor btid = defaultDoor & drTrigger .~ WdBlBtOn btid
@@ -24,8 +24,6 @@ import Geometry
 import LensHelp
 import RandomHelp

-- TODO fix case where the sensor created by sensInsideDoor blocks another door
-- for roomRectAutoLinks-- make the locked door a center door?
 sensorRoom :: SensorType -> Int -> State LayoutVars (Tree Room)
 sensorRoom senseType n = do
    rm <-
@@ -49,7 +47,7 @@ sensorRoom senseType n = do
        | isclose = rl & rlType . at BlockedLink ?~ ()
        | otherwise = rl
      where
-        p' = p +.+ rotateV d (V2 0 (negate 100))
+        p' = p + rotateV d (V2 0 (negate 100))
        isclose = dist (_rlPos rl) p' < 30

 nonCornerLinks :: RoomLink -> Bool
@@ -8,7 +8,6 @@ import Control.Monad
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Data.Maybe
-import Data.Maybe (mapMaybe)
 import qualified Data.Set as S
 import Dodge.Cleat
 import Dodge.Data.AmmoType
@@ -56,6 +55,8 @@ tutAnoTree = do
    foldMTRS
        [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
        , corDoor
+        , tToBTree "slowCrush" . return . cleatOnward <$> slowCrushRoom
+        , corDoor
        , chasmSpitTerminal
 --a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
 --a        , corDoor
@@ -238,8 +239,8 @@ sqPlatformChasm b a =

 sqSpitChasm :: Float -> Float -> ([[Point2]], [[Point2]])
 sqSpitChasm b a =
-    ( --[[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
-        convexPartition clfs
+    ( [[ibr, obr, otr, itr], [itr, otr, otl, itl], [itl, otl, obl, ibl]]
+--    ( earClip clfs
    , [clfs]
    )
  where
@@ -304,20 +305,21 @@ chasmSpitTerminal = do
        l3 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East North 
        l4 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> f rp East South
    ls <- takeOne [[l1,l2],[l3,l4]
-          ,[spanLightI (V2 120 0) (V2 120 300)]
-         , [spanLightI (V2 0 128) (V2 300 128)]
-         , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
+--          ,[spanLightI (V2 120 0) (V2 120 300)]
+--         , [spanLightI (V2 0 128) (V2 300 128)]
+--         , [spanLightI (V2 300 0) (V2 0 300), sps0 $ putShape $ thinHighBar 95 0 300]
        ]
    gh <- takeOne [55,75,97]
    gird <- takeOne [girderZ gh 30 10,girder gh 30 10,girderV gh 30 10]
-    dec <- takeOne $ -- replicate 3 [] <> 
-            [--[]
--            ,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)
--            ,sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
--            ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
-            [sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
+    dec <- takeOne $  replicate 3 [] <> 
+            [[sps0 $ putShape $ gird (V2 30 0) (V2 30 300)]
+            ,[sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
+            ,[sps0 $ putShape $ gird (V2 30 0) (V2 30 300),sps0 $ putShape $ gird (V2 270 0) (V2 270 300)]
+            ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20)]
+            ,[sps0 $ putShape $ gird (V2 0 200) (V2 300 200)]
+            ,[sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
+            ,[sps0 $ putShape $ gird (V2 0 20) (V2 300 20),sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
            ]
-    -- let y' = y & rmPmnts <>~ [l3, l4, l5]
    let y' = y & rmPmnts <>~ ls <> dec
    return $
        tToBTree "chasmTerm" $
@@ -328,8 +330,8 @@ chasmSpitTerminal = do
                , return $ cleatOnward $ triggerDoorRoom i1
                ]
  where
-    f rp a b = FromEdge a 2 `S.member` (fold $ rp ^? rpType . rplsType)
-        && OnEdge b `S.member` (fold $ rp ^? rpType . rplsType)
+    f rp a b = FromEdge a 2 `S.member` fold (rp ^? rpType . rplsType)
+        && OnEdge b `S.member` fold (rp ^? rpType . rplsType)

 polyChasm :: Int -> Float -> State LayoutVars Room
 polyChasm n x =
@@ -377,8 +379,8 @@ chasmSimpleMaze =

 tutLight :: State LayoutVars (MetaTree Room String)
 tutLight = do
-    x <- shuffleRoomPos =<< chasmSimpleMaze
-    y <- shuffleRoomPos =<< chasmSimpleMaze
+    x <- rmPos shuffle =<< chasmSimpleMaze
+    y <- rmPos shuffle =<< chasmSimpleMaze
    z <- chasmSimpleMaze
    return $
        tToBTree "TutLight" $
@@ -41,21 +41,35 @@ ssScrollUsing ::
    Maybe Selection
 ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)

+-- 
 ssScrollMinOnFail ::
    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
    IMSS a ->
    Maybe Selection ->
    Maybe Selection
-ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
+ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j q) $ l <|> ssLookupMin sss
  where
-    q i j = fromMaybe mempty $ do
-        Sel k _ xs <- msel ^? _Just
-        guard $ j `IS.member` xs && i == k
-        return xs
+    q = fold (msel ^? _Just . slSet)
    l = do
        Sel i j _ <- msel
        f i j sss

+---- this version removes the selected set when scrolling outside it
+--ssScrollMinOnFail' ::
+--    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
+--    IMSS a ->
+--    Maybe Selection ->
+--    Maybe Selection
+--ssScrollMinOnFail' f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
+--  where
+--    q i j = fromMaybe mempty $ do
+--        Sel k _ xs <- msel ^? _Just
+--        guard $ j `IS.member` xs && i == k
+--        return xs
+--    l = do
+--        Sel i j _ <- msel
+--        f i j sss
+
 ssSetCursor ::
    (IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
    IMSS a ->
@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.TestString where

+import Dodge.WallCreatureCollisions
 import Data.List ((\\))
 import ShortShow
 import Geometry
@@ -33,8 +34,23 @@ import Data.Monoid
 import RandomHelp

 testStringInit :: Universe -> [String]
-testStringInit u = [evalState (takeOne ["a","b"]) (_randGen $ _uvWorld u)]
--    (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcType . _McDamSensor . sensAmount)
+testStringInit u = (fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crWallTouch)
+    <> fromMaybe [] (do
+    w1 <- u ^? uvWorld . cWorld . lWorld . walls . ix 18
+    w2 <- u ^? uvWorld . cWorld . lWorld . walls . ix 61
+    let 
+        f = uncurry (-) . (^. wlLine)
+        g = argV . f
+        h = normalizeV . uncurry (-) . (^. wlLine)
+        a = angleVV (f w1) (f w2)
+    return [show $ wlWlCrush w1 w2, show a , show (f w1), show (f w2)
+        , show $ g w1
+        , show $ g w2
+        , show $ h w1
+        , show $ h w2
+        , show (norm (h w1 + h w2))
+        ]
+    )
 --    <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)
 --testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
 --testStringInit u =  map show
@@ -42,6 +42,7 @@ positionRoomsFromTree (Node (r, i) ts) =
  where
    r' = r & rmMID ?~ i

+-- implement a heuristic for "better" room links?
 posRms ::
    PosRooms ->
    RoomInt ->
@@ -155,10 +155,32 @@ updateUniverseLast u =
            %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
        & uvWorld . input . heldWorldPos
            %~ M.union (fmap (const mwp) (u ^. uvWorld . input . mouseButtons))
+        & uvIOEffects %~ doMouseWarping u
  where
    mp = u ^. uvWorld . input . mousePos
    mwp = screenToWorldPos (u ^. uvWorld . wCam) mp

+doMouseWarping :: p -> a -> a
+doMouseWarping _ = id
+
+--doMouseWarping :: Universe -> (Universe -> IO Universe) -> (Universe -> IO Universe)
+--doMouseWarping u f u'
+--    | Just x <- u ^? uvWorld . input . mouseContext . mcoRotateDist
+--        = SDL.warpMouse WarpCurrentFocus (P p) >> f (u' & uvWorld . input . mousePos .~ nmp)
+--    | otherwise = f u'
+--  where
+--    cfig = u' ^. uvConfig
+--    nmp = V2
+--            (fromIntegral x - 0.5 * windowXFloat cfig)
+--            (0.5 * windowYFloat cfig - fromIntegral y)
+--    p@(V2 x y) = (cwin + (msp & each %~ round)) & each %~ fromIntegral
+--    cwin :: V2 Int
+--    cwin = ((getWindowSize _gr_world_res (u' ^. uvConfig))) 
+--    mwp = mouseWorldPosW (u' ^. uvWorld)
+--    msp = u' ^. uvWorld . input . mousePos & _y %~ negate
+--    cc = u' ^. uvWorld . wCam . camCenter
+--    d = dist mwp cc
+
 {- For most menus the only way to change the world is using event handling.  -}
 updateUniverseMid :: Universe -> Universe
 updateUniverseMid u = case _uvScreenLayers u of
@@ -320,6 +342,7 @@ functionalUpdate =
 pushYouOutFromWalls :: World -> World
 pushYouOutFromWalls w = w & cWorld . lWorld . creatures . ix 0 %~ muzzleWallCheck w

+-- rotate creature as well? behaviour on ledges?
 muzzleWallCheck :: World -> Creature -> Creature
 muzzleWallCheck w cr = fromMaybe cr $ do
    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
@@ -329,14 +352,14 @@ muzzleWallCheck w cr = fromMaybe cr $ do
        cp = cr ^. crPos . _xy
 --        cop = cr ^. crOldPos . _xy
    r <- boundPointsRect (cp : ps)
-    let wls = uncurry wlsNearRect r w & filter (not . _wlTouchThrough)
+    let wls = uncurry wlsNearRect r w & IM.elems & filter (not . _wlTouchThrough)
        vs = mapMaybe (g cp wls) ps
    return $ if null vs 
        then cr
        else let v = minimumBy (compare `on` norm) vs
            in cr & crPos . _xy +~ normalize v
  where
-    f loc = map (muzzlePos loc cr)  (itemMuzzles $ loc)
+    f loc = map (muzzlePos loc cr)  (itemMuzzles loc)
    g cp wls p = case collidePoint cp p wls of
        (ep,Just _) -> Just (ep - p)
        _ -> Nothing
@@ -380,14 +403,17 @@ updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
 updateMouseContextGame cfig u = \case
    OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss)
    x@OverInvDragSelect{} -> x
-    _ -> fromMaybe aimcontext (isrotatedrag <|> overterm <|> overinv <|> overcomb)
+    MouseGameRotate x
+        | ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
+    --_ -> fromMaybe aimcontext (isrotatedrag <|> overterm <|> overinv <|> overcomb)
+    _ -> fromMaybe aimcontext (overterm <|> overinv <|> overcomb)
  where
    w = u ^. uvWorld
-    isrotatedrag = do
-        t1 <- w ^. input . mouseButtons . at ButtonLeft
-        t2 <- w ^. input . mouseButtons . at ButtonRight
-        guard $ t1 > t2
-        return MouseGameRotate
+--    isrotatedrag = do
+--        t1 <- w ^. input . mouseButtons . at ButtonLeft
+--        t2 <- w ^. input . mouseButtons . at ButtonRight
+--        guard $ t1 > t2
+--        return $ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
    aimcontext
        | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
        | Display_debug `S.member` (cfig ^. debug_booleans) = getDebugMouseOver u
@@ -515,7 +541,7 @@ updatePulseBall pb w
    thedam = Lasering 100 ep (pb ^. pzbVel)
    sp = pb ^. pzbPos
    ep = sp + pb ^. pzbVel
-    thit = thingHit sp ep w
+    thit = listToMaybe $ thingsHitZ 20 sp ep w

 pbFlicker :: PulseBall -> World -> World
 pbFlicker pt =
@@ -676,7 +702,7 @@ updatePulseLaser pz = case pz ^. pzTimer of
  where
    f w =
        dodam thHit w
-            & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
+            & cWorld . lWorld . flares <>~ drawPulseLaser (sp : ps)
      where
        (thHit, ps) = reflectPulseLaserAlong phasev sp xp w
    dodam thit = case thit of
@@ -695,7 +721,7 @@ updatePulseLaser pz = case pz ^. pzTimer of
    sp = _pzPos pz
    dir = _pzDir pz
    xp = sp +.+ 800 *.* unitVectorAtAngle dir
-    g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
+    g w = w & cWorld . lWorld . flares <>~ drawPulseLaser (sp : ps)
      where
        (_, ps) = reflectPulseLaserAlong phasev sp xp w

@@ -26,6 +26,7 @@ import Geometry
 import LensHelp
 import SDL (MouseButton (..))
 import qualified SDL
+import qualified Data.IntMap.Strict as IM

 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
 update where your avatar's view is from.  -}
@@ -203,12 +204,14 @@ viewDistanceFromItems _ = 1

 rotateCamera :: Config -> World -> World
 rotateCamera cfig w
-    | MouseGameRotate <- w ^. input . mouseContext
+    | MouseGameRotate {} <- w ^. input . mouseContext
      , Just rotation <-
            angleBetween (w ^. input . mousePos)
                <$> (w ^. input . heldPos . at SDL.ButtonRight) =
        w & wCam . camRot -~ rotation
+          & input . inputMemory .~ WasMouseGameRotating
    | _gameplay_rotate_to_wall cfig
+        , WasNotMouseGameRotating <- w ^. input . inputMemory
      , isNothing $ w ^? input . mouseButtons . ix SDL.ButtonRight =
        rotateToOverlappingWall w
    | otherwise = w
@@ -218,23 +221,15 @@ rotateToOverlappingWall w =
    maybe
        id
        (doWallRotate . snd)
-        (overlapCircWallsClosest p r (filter _wlRotateTo $ wlsNearCirc p r w))
+        (overlapCircWallsClosest p r (filter _wlRotateTo . IM.elems $ wlsNearCirc p r w))
        w
  where
-    r = (crRad (cr ^. crType) + 10)
+    r = crRad (cr ^. crType) + 10
    cr = you w
    p = you w ^. crPos . _xy

 doWallRotate :: Wall -> World -> World
 doWallRotate = rotateTo8 . argV . uncurry (-) . _wlLine
--doWallRotate wl w = rotateTo8 
--    | b - b' > 0.01 = w & wCam . camRot +~ 0.01
--    | b - b' < negate 0.01 = w & wCam . camRot -~ 0.01
--    | otherwise = w
--  where
--    a = argV (uncurry (-.-) $ _wlLine wl) - w ^. wCam . camRot
--    b = a * (4 / pi) -- for 8 way cardinal orientation wrt wall
--    b' = fromIntegral (round b :: Int)

 clipZoom ::
    -- | Furthest viewable distance
@@ -251,7 +246,7 @@ farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
 farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w)
  where
    f q = (rotateV (negate (w ^. wCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
-    wls q = filter wlIsOpaque $ wlsNearSeg p q w
+    wls q = filter wlIsOpaque . IM.elems $ wlsNearSeg p q w
    findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine

 findBoundDists :: Config -> World -> (Float, Float, Float, Float)
@@ -5,6 +5,7 @@ module Dodge.Update.Input.InGame (
    updateMouseInGame,
 ) where

+import Dodge.Base.Coordinate
 import Dodge.Button.Event
 import Control.Applicative
 import Control.Monad
@@ -98,7 +99,7 @@ updateMouseHeldInGame :: Config -> World -> World
 updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
    OverInvDragSelect{}
        | ButtonRight `M.member` (w ^. input . mouseButtons) ->
-            w & input . mouseContext .~ MouseGameRotate
+            w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
    OverInvDragSelect (Just sstart) _ ->
        let sss = w ^. hud . diSections
            msel = inverseSelNumPos cfig invDP (w ^. input . mousePos) sss
@@ -289,23 +290,6 @@ startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
  where
    setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))

-concurrentIS :: IS.IntSet -> Bool
-concurrentIS = go . IS.minView
-  where
-    go x = fromMaybe True $ do
-        (i, is) <- x
-        (j, js) <- IS.minView is
-        return $ i + 1 == j && go (Just (j, js))
-
-collectInvItems :: Int -> IS.IntSet -> World -> World
-collectInvItems secid is w = fromMaybe w $ do
-    guard $ secid == 0
-    (j, js) <- IS.minView is
-    return $ h j js w
-  where
-    h j js w' = fromMaybe w' $ do
-        (k, ks) <- IS.minView js
-        return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'

 shiftInvItems ::
    Config ->
@@ -346,20 +330,6 @@ setSelWhileDragging w = fromMaybe w $ do
    guard $ i == k && j `IS.member` xs
    return $ w & hud . diSelection . _Just . slInt .~ j

-shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
-shiftInvItemsUp j is w = IS.foldl' f w is
-  where
-    f w' i' = swapItemWith g (j, i') w'
-    g i' m = fst <$> IM.lookupLT i' m
-
-shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
-shiftInvItemsDown j is w = fromMaybe w $ do
-    let i = IS.findMax is
-    guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
-    return $ IS.foldr f w is
-  where
-    f i' = swapItemWith g (j, i')
-    g i' m = fst <$> IM.lookupGT i' m

 updateFunctionKeys :: Universe -> Universe
 updateFunctionKeys u =
@@ -427,7 +397,7 @@ updateKeysTextInputTerminal tmid u =

 updateKeyInGame :: Universe -> Scancode -> Int -> Universe
 updateKeyInGame uv sc = \case
-    0 -> updateInitialPressInGame uv sc
+    0 -> updateInitialPressInGame uv sc & uvWorld . input . inputMemory .~ WasNotMouseGameRotating
    x | x >= 30 -> updateLongPressInGame uv sc
    _ -> uv

@@ -29,13 +29,15 @@ updateWheelEvent yi w = case w ^. hud . subInventory of
 -- yi should be nonzero
 updateBaseWheelEvent :: Int -> World -> World
 updateBaseWheelEvent yi w
-    --    | Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
    | Just True <- w ^? cWorld . lWorld . lInvLock = w
    | bdown ButtonRight = case _rbState w of
        EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax
        NoRightButtonState -> fromMaybe w (selectedItemScroll yi w)
    | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
-    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
+    | ScancodeCapsLock `M.member` _pressedKeys (_input w) 
+        , ScancodeLShift `M.member` (w ^. input . pressedKeys) = changeSwapSel yi w
+    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSelSet yi w
+    | ScancodeLShift `M.member` (w ^. input . pressedKeys) = multiSelScroll yi w
    | otherwise = scrollAugInvSel yi w
  where
    bdown b = w & has (input . mouseButtons . ix b)
@@ -1,23 +1,20 @@
 -- | Deals with moving creature wall collisions.
-module Dodge.WallCreatureCollisions (
-    colCrsWalls,
-    colCrWall,
-    pushCreatureOutFromWalls,
-    crOnWall,
+module Dodge.WallCreatureCollisions (colCrsWalls,
+    wlWlCrush
    ) where

-import Linear
-import Dodge.Creature.Radius
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
-import Data.Maybe
-import Data.Monoid
+import Data.Foldable
+import qualified Data.IntSet as IS
 import Dodge.Base
+import Dodge.Creature.Radius
 import Dodge.Data.Universe
 import Dodge.Zoning.Wall
 import Geometry
+import Linear

 colCrsWalls :: Universe -> Universe
--colCrsWalls uv = uv
 colCrsWalls uv = uv & uvWorld . cWorld . lWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv))

 noclipCheck :: Config -> World -> Creature -> Creature
@@ -25,77 +22,55 @@ noclipCheck cfig w c
    | debugOn Noclip cfig && _crID c == 0 = c -- for noclip
    | otherwise = colCrWall w c

-- no noclip check, so no need for a configuration file
 colCrWall :: World -> Creature -> Creature
-colCrWall w c
-    | p1 == p2 = pushOrCrush ls c
-    --    | _crPos c' == _crPos c'' = c'
-    --    | otherwise = c & crPos .~ _crOldPos c
-    | otherwise = c'
+colCrWall w c = cornpush . wallpush $ pushthrough c
  where
-    --    c'' = c' & crPos %~ pushOutFromWalls rad ls
-    --c'  = c & crPos %~ pushOutFromWalls' rad (reverse ls)
-    c' =
-        c & crPos . _xy
-            %~ pushOutFromCorners r ls'
-                . pushOutFromWalls r ls'
-                . fst
-                . flip (collidePoint p1) wls -- check push throughs
-                --        . flip (collidePointWalls' p1) wls  -- check push throughs
+    cornpush = crPos . _xy %~ pushOutFromCorners r ls'
+    wallpush = pushCr wls
+    pushthrough = crPos . _xy %~ fst . flip (collidePoint p1) wls -- check push throughs
    r = crRad (c ^. crType) + wallBuffer
    p1 = c ^. crOldPos . _xy
    p2 = c ^. crPos . _xy
-    ls = _wlLine <$> wls
+    ls = _wlLine <$> IM.elems wls
    ls' = filter (uncurry $ isLHS p1) ls
-    wls = filter notff $ wlsNearRect (p2 +.+ V2 r r) (p2 -.- V2 r r) w
+    wls = IM.filter notff $ wlsNearCirc p2 (2*r) w
    notff x = x ^. wlMaterial /= ForceField

+-- might want to check angled crushing
+pushCr :: IM.IntMap Wall -> Creature -> Creature
+pushCr wls cr
+    | (dist ep sp > r && dist ep ap > r)
+        || wlsCrush twls
+            =
+        ecr
+            & crDamage <>~ [Crushing 1000 0]
+            & crPos . _xy .~ ap
+    | otherwise = ecr
+  where
+--    stwls = IM.filter (\wl -> uncurry circOnSegNoEndpoints (wl ^. wlLine) sp r) wls
+    twls = IM.elems $ IM.restrictKeys wls (ecr ^. crWallTouch) -- `IM.union` stwls
+    ep = ecr ^. crPos . _xy
+    ap = cr ^. crOldPos . _xy
+    sp = cr ^. crPos . _xy
+    ecr = foldl' f (cr & crWallTouch .~ mempty) wls
+    r = crRad (cr ^. crType)
+    f acr wl = case pushOutFromWall r (acr ^. crPos . _xy) (wl ^. wlLine) of
+        Just p -> acr & crPos . _xy .~ p & crWallTouch %~ IS.insert (wl ^. wlID)
+        Nothing -> acr
+
+wlsCrush :: [Wall] -> Bool
+wlsCrush [] = False
+wlsCrush (x:xs) = any (wlWlCrush x) xs || wlsCrush xs
+
+wlWlCrush :: Wall -> Wall -> Bool
+wlWlCrush w1 w2 = norm (f w1 + f w2) < 0.2
+  where
+    f = normalizeV . uncurry (-) . (^. wlLine)
+
 -- the amount to push creatures out from walls, extra to their radius
 wallBuffer :: Float
 wallBuffer = 0

-pushCreatureOutFromWalls :: [(Point2, Point2)] -> Creature -> Creature
-pushCreatureOutFromWalls ls cr = cr & crPos . _xy 
-    %~ pushOutFromWalls (crRad (cr ^. crType)) ls
-
-- the following tests whether or not a point is on a wall, and if so pushes it
-- out from the wall
-- this is then repeated if the point ends up on a new wall
-pushOutFromWalls :: Float -> [(Point2, Point2)] -> Point2 -> Point2
-pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall rad p1)) wls of
-    Nothing -> p1
-    Just p2 -> pushOutFromWalls rad (tail wls) p2
-
-- possible improvement: choose between the closer of p2 and "p3" to p1
-
--pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
--pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
--    Nothing -> p1
--    Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
--    -- possible improvement: choose between the closer of p2 and "p3" to p1
-
-pushOrCrush :: [(Point2, Point2)] -> Creature -> Creature
-pushOrCrush wls cr = case mapMaybe (pushOutFromWall (crRad (cr ^. crType)) cpos) wls of
-    [] -> cr
-    (p : _) -> cr & crPos . _xy .~ p
-  where
-    --    (_:p:_)   -> cr
-    --        & crPos .~ p
-    --        & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )
-
-    cpos = cr ^. crPos . _xy
-
-- note the inclusion of endpoints in circOnSeg
-crOnWall :: Creature -> World -> Bool
-crOnWall cr =
-    any (uncurry (circOnSeg p r) . _wlLine)
-        . filter notff
-        . wlsNearCirc p r
-  where
-    notff x = x ^. wlMaterial /= ForceField
-    p = cr ^. crPos . _xy
-    r = crRad (cr ^. crType)
-
 -- assumes that the wall is orientated
 -- assumes wall points are different
 pushOutFromWall :: Float -> Point2 -> (Point2, Point2) -> Maybe Point2
@@ -103,17 +78,16 @@ pushOutFromWall rad cp2 (wp1, wp2)
    | isOnWall = Just newP
    | otherwise = Nothing
  where
-    n = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
-    wp1' = wp1 +.+ rad *.* n
-    wp2' = wp2 +.+ rad *.* n
+    n = errorNormalizeV 61 $ vNormal (wp1 - wp2)
+    wp1' = wp1 + rad *^ n
+    wp2' = wp2 + rad *^ n
    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
    isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad

 pushOutFromCorners :: Float -> [(Point2, Point2)] -> Point2 -> Point2
--pushOutFromCorners r ls p = foldr (squashIntersectCirclePoint r . fst) p ls
 pushOutFromCorners r = flip $ foldr (squashIntersectCirclePoint r . fst)

 squashIntersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
 squashIntersectCirclePoint rad p cCen
    | dist cCen p > rad = cCen
-    | otherwise = p +.+ (rad *.* squashNormalizeV (cCen -.- p))
+    | otherwise = p + (rad *^ squashNormalizeV (cCen - p))
@@ -36,17 +36,15 @@ doWdWd = \case
    NoWorldEffect -> id
    SetTrigger bool tid -> cWorld . lWorld . triggers . ix tid .~ bool
    SetLSCol col lsid -> cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ col
+    SetTriggerAndSetLSCol bool tid col lsid -> (cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ col)
+             . (cWorld . lWorld . triggers . ix tid .~ bool)
    AccessTerminal mtmid -> accessTerminal mtmid
-    WorldEffects wes -> \w -> foldr doWdWd w wes
    UnlockInv -> unlockInv
    MakeStartCloudAt p -> makeCloudAt CryoReleaseCloud 400 p
    TorqueCr x cid -> torqueCr x cid
    SoundStart so p sid mi -> soundStart so p sid mi
    WdWdNegateTrig trid -> cWorld . lWorld . triggers . ix trid %~ not
    WdWdSetSoundFilter x -> wSoundFilter .~ x
-    --    WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
-    --        cr <- w ^? cWorld . lWorld . creatures . ix crid
-    --        return $ doItCrWdWd f it cr w
    MakeTempLight _ 0 -> id
    MakeTempLight x t ->
        (cWorld . lWorld . lights .:~ x)
@@ -14,6 +14,7 @@ module Dodge.WorldEvent.ThingsHit (
    wlHitPos,
    crHit,
    crWlPbHit,
+    crWlPbHitZ,
    wlsHitUnsorted,
    isWalkable,
 ) where
@@ -66,6 +67,20 @@ crWlPbHit sp ep w =
    toobj (Left cr) = OCreature cr
    toobj (Right wl) = OWall wl

+crWlPbHitZ :: Float -> Point2 -> Point2 -> World -> [(Point2, Object)]
+crWlPbHitZ z sp ep w =
+    List.mergeOn
+        (dist sp . fst)
+        (map (fmap toobj) (thingsHitZ z sp ep w))
+        pballs
+  where
+    -- slightly arbitrary
+    pballs 
+        | z > 15 && z < 25 = map (fmap OPulseBall) (pbsHit sp ep w)
+        | otherwise = mempty
+    toobj (Left cr) = OCreature cr
+    toobj (Right wl) = OWall wl
+
 crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
 crsHit sp ep w
    | sp == ep = mempty
@@ -139,19 +154,19 @@ thingsHitExceptCr (Just cid) sp ep = filter t . thingsHit sp ep
    t = (Just cid /=) . (^? _2 . _Left . crID)

 wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
-wlsHit sp ep = sortOn (dist sp . fst) . wlsHitUnsorted sp ep
+wlsHit sp ep = sortOn (dist sp . fst) . IM.elems . wlsHitUnsorted sp ep

 ---- pushes out any hit point by one
 wlHitPos :: Point2 -> Point2 -> World -> Point2
 wlHitPos sp ep = maybe ep ((+ normalize (ep - sp)) . fst) . safeHead . wlsHit sp ep

-wlsHitUnsorted :: Point2 -> Point2 -> World -> [(Point2, Wall)]
+wlsHitUnsorted :: Point2 -> Point2 -> World -> IM.IntMap (Point2, Wall)
 wlsHitUnsorted sp ep
    | sp == ep = const mempty
    | otherwise = overlapSegWalls sp ep . wlsNearSeg sp ep

-wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
-wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
+wlsHitRadial :: Point2 -> Float -> World -> IM.IntMap (Point2, Wall)
+wlsHitRadial p r = IM.mapMaybe f . wlsNearCirc p r
  where
    --f wl = uncurry (intersectSegSeg p (p - r *.* v)) (_wlLine wl) <&> (,wl)
    f wl = mhp <&> (,wl)
@@ -30,7 +30,7 @@ postWorldLoad rdata cw = do
    glNamedBufferStorage newfloorbo (fromIntegral $ 8 * nfloorvxs * floatSize) floorptr 0
    nchasmvxs <- foldM (pokeChasm chptr) 0 (cw ^. uvWorld . cWorld . chasms)
    glBindBufferBase GL_SHADER_STORAGE_BUFFER 7 newchbo
-    glNamedBufferStorage newchbo (fromIntegral $ 2 * (max 1 nchasmvxs) * floatSize) chptr 0
+    glNamedBufferStorage newchbo (fromIntegral $ 2 * max 1 nchasmvxs * floatSize) chptr 0
    -- note the max 1, prevents trying to create empty buffer storage
    checkGLError "during postWorldLoad"
    return $
@@ -11,7 +11,6 @@ module Dodge.Zoning.Wall

 import Control.Lens
 import qualified Data.IntSet as IS
-import Data.Maybe
 import Dodge.Data.World
 import Dodge.Zoning.Base
 import FoldableHelp
@@ -32,21 +31,21 @@ wlIXsNearRect = nearRect wlZoneSize _wlZoning
 wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
 wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)

-wlsFromIXs :: World -> IS.IntSet -> [Wall]
+wlsFromIXs :: World -> IS.IntSet -> IM.IntMap Wall
 {-# INLINE wlsFromIXs #-}
-wlsFromIXs w = mapMaybe (\wlid -> w ^? cWorld . lWorld . walls . ix wlid) . IS.toList
+wlsFromIXs w = IM.restrictKeys (w ^. cWorld . lWorld . walls)

-wlsNearPoint :: Point2 -> World -> [Wall]
+wlsNearPoint :: Point2 -> World -> IM.IntMap Wall
 wlsNearPoint p w = wlsFromIXs w $ wlIXsNearPoint p w

-wlsNearSeg :: Point2 -> Point2 -> World -> [Wall]
+wlsNearSeg :: Point2 -> Point2 -> World -> IM.IntMap Wall
 {-# INLINE wlsNearSeg #-}
 wlsNearSeg sp ep w = wlsFromIXs w $ wlIXsNearSeg sp ep w

-wlsNearRect :: Point2 -> Point2 -> World -> [Wall]
+wlsNearRect :: Point2 -> Point2 -> World -> IM.IntMap Wall
 wlsNearRect sp ep w = wlsFromIXs w $ wlIXsNearRect sp ep w

-wlsNearCirc :: Point2 -> Float -> World -> [Wall]
+wlsNearCirc :: Point2 -> Float -> World -> IM.IntMap Wall
 wlsNearCirc p r w = wlsFromIXs w $ wlIXsNearCirc p r w

 wlZoneSize :: Float
@@ -151,13 +151,20 @@ convexHull :: [Point2] -> [Point2]
 convexHull (x : y : z : xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b, a)) (x : y : z : xs)
 convexHull _ = error "Tried to create the convex hull of two or fewer points"

-- assumes the points go "anticlockwise" around a non-self intersecting shape
-convexPartition :: [Point2] -> [[Point2]]
-convexPartition (x:y:z:[]) = [[x,y,z]]
-convexPartition (x:y:z:xs)
-    | isLHS x y z = [x,y,z] : convexPartition (x:z:xs)
-    | otherwise = convexPartition (y:z:xs <> [x])
-convexPartition _ = error "unexpected shape for convexPartition"
+---- assumes the points go "anticlockwise" around a non-self intersecting shape
+--convexPartition :: [Point2] -> [[Point2]]
+--convexPartition (x:y:z:[]) = [[x,y,z]]
+--convexPartition (x:y:z:xs)
+--    | isLHS x y z = [x,y,z] : convexPartition (x:z:xs)
+--    | otherwise = convexPartition (y:z:xs <> [x])
+--convexPartition _ = error "unexpected shape for convexPartition"
+
+triangulateEarClip :: [Point2] -> [[Point2]]
+triangulateEarClip [x,y,z] = [[x,y,z]]
+triangulateEarClip (x:y:z:xs)
+    | isLHS x y z && not (any (`pointInPoly` [x,y,z]) xs) = [x,y,z] : triangulateEarClip (x:z:xs)
+    | otherwise = triangulateEarClip (y:z:xs ++ [x])
+triangulateEarClip _ = error "triangulateEarClip: non-simple polygon input?"

 {- | Creates the convex hull of a set of points.
 assumes no repetition of points: try nubbing!
@@ -45,11 +45,11 @@ crossProd (V3 x y z) (V3 a b c) = V3
    ( z * a - x * c)
    ( x * b - y * a)

-rotate3 :: Float -> Point3 -> Point3
-{-# INLINE rotate3 #-}
-rotate3 a (V3 x y z) = V3 x' y' z
-  where 
-    (V2 x' y') = rotateV a (V2 x y)
+--rotate3 :: Float -> Point3 -> Point3
+--{-# INLINE rotate3 #-}
+--rotate3 a (V3 x y z) = V3 x' y' z
+--  where 
+--    (V2 x' y') = rotateV a (V2 x y)

 rotate3z :: Float -> Point3 -> Point3
 {-# INLINE rotate3z #-}
@@ -124,10 +124,10 @@ angleVV3 a b
    | a == b = 0
    | otherwise = acos $ dotV3 a b / (magV3 a * magV3 b)

-projV3 :: Point3 -> Point3 -> Point3
-projV3 = undefined
+--projV3 :: Point3 -> Point3 -> Point3
+--projV3 = undefined

-onXY :: (Point2 -> Point2) -> Point3 -> Point3
-onXY f (V3 x y z) = V3 x' y' z
-  where
-    V2 x' y' = f (V2 x y)
+--onXY :: (Point2 -> Point2) -> Point3 -> Point3
+--onXY f (V3 x y z) = V3 x' y' z
+--  where
+--    V2 x' y' = f (V2 x y)
@@ -115,7 +115,7 @@ translate3 = fmap . overPos . (+.+.+)

 tranRot :: V2 Float -> Float -> Picture -> Picture
 {-# INLINE tranRot #-}
-tranRot (V2 x y) r = fmap $ overPos (translateH x y . rotate3 r)
+tranRot (V2 x y) r = fmap $ overPos (translateH x y . rotate3z r)

 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
@@ -144,7 +144,7 @@ scale x = fmap . overPos . scale3 x

 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate = fmap . overPos . rotate3
+rotate = fmap . overPos . rotate3z

 makeArc :: Float -> Point2 -> [Point2]
 {-# INLINE makeArc #-}
@@ -26,7 +26,7 @@ translateXY x y = pyFaces %~ map (map $ first tran)
    tran (V3 a b c) = V3 (a+x) (b+y) c

 rotateXY :: Float -> Polyhedra -> Polyhedra
-rotateXY a = over pyFaces $ map $ map $ first $ rotate3 a
+rotateXY = over pyFaces . map . map . first . rotate3z

 constructEdges :: [[Point3]] -> [(Point3,Point3,Point3,Point3)]
 constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges face) 
@@ -28,7 +28,7 @@ takeOneRem :: (RandomGen g) => [a] -> State g (Maybe (a, [a]))
 takeOneRem [] = return Nothing
 takeOneRem xs =
    state (randomR (0, length xs - 1)) >>= \i -> do
-        let (ys, (z : zs)) = splitAt i xs
+        let (ys, z : zs) = splitAt i xs
        return $ Just (z, ys <> zs)

 takeOneFiltered :: (RandomGen g) => (a -> Bool) -> [a] -> State g (Maybe a)
@@ -253,7 +253,7 @@ translateSHz !z = translateSH (V3 0 0 z)

 rotateSH :: Float -> Shape -> Shape
 {-# INLINE rotateSH #-}
-rotateSH = overPosSH . rotate3
+rotateSH = overPosSH . rotate3z

 overPosSH :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINEABLE overPosSH #-}
Author	SHA1	Message	Date
justin	9e42bb4117	Cleanup	2026-03-26 20:32:52 +00:00
justin	0ddedf7fd6	Improve wall squashing further	2026-03-26 20:25:59 +00:00
justin	62a37388e7	Remove recursive WdWd	2026-03-26 19:33:02 +00:00
justin	01b765300e	Improve door crushing	2026-03-26 19:21:10 +00:00
justin	31d7a00ecf	Crush run-past room	2026-03-26 18:24:42 +00:00
justin	9081bdc97f	Tweak lasers	2026-03-26 16:17:34 +00:00
justin	80ef7ec909	Beamsplitter attachment for lasers	2026-03-26 15:51:16 +00:00
justin	c53e60b956	Improve pulse laser/ball hit detection	2026-03-26 15:07:33 +00:00
justin	40f5d22d88	Cleanup	2026-03-26 13:03:58 +00:00
justin	5a6479faa8	Cleanup	2026-03-26 12:53:56 +00:00
justin	7999373b69	Sometimes crush creatures when doors close on them	2026-03-26 12:39:54 +00:00
justin	e01029d06d	Improve scroll selection	2026-03-24 19:51:32 +00:00
justin	8ff2f37af5	Improve scroll selection/inventory modification	2026-03-24 19:21:04 +00:00
justin	5b297643db	Improve mouse click rotation	2026-03-24 11:46:36 +00:00
justin	32f1740577	Cleanup, improve auto wall rotate	2026-03-24 11:28:11 +00:00
justin	be2f7160ba	Cleanup	2026-03-24 09:38:32 +00:00
justin	832bebb597	Improve doors	2026-03-24 00:35:15 +00:00
justin	7917192b77	Stop gibbed/pitted creatures from opening doors	2026-03-23 22:59:35 +00:00
justin	daba012e83	Improve chasm falls, add ear clipping	2026-03-23 19:35:07 +00:00