Use circles instead of points for zome wall zones

Not perfect for left wrist when aiming two handed twist weapons

.hlint.yaml

@@ -0,0 +1,70 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+# This file contains a template configuration file, which is typically
+# placed as .hlint.yaml in the root of your project
+
+
+# Specify additional command line arguments
+#
+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
+
+
+# Control which extensions/flags/modules/functions can be used
+#
+# - extensions:
+#   - default: false # all extension are banned by default
+#   - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
+#   - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
+#
+# - flags:
+#   - {name: -w, within: []} # -w is allowed nowhere
+#
+# - modules:
+#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
+#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
+#
+# - functions:
+#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
+
+
+# Add custom hints for this project
+#
+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
+
+# The hints are named by the string they display in warning messages.
+# For example, if you see a warning starting like
+#
+# Main.hs:116:51: Warning: Redundant ==
+#
+# You can refer to that hint with `{name: Redundant ==}` (see below).
+
+# Turn on hints that are off by default
+#
+# Ban "module X(module X) where", to require a real export list
+#- warn: {name: Use explicit module export list} # TODO uncomment
+#
+# Replace a $ b $ c with a . b $ c
+#- group: {name: dollar, enabled: true} # TODO uncomment
+#
+# Generalise map to fmap, ++ to <>
+#- group: {name: generalise, enabled: true} # TODO uncomment
+#
+# Warn on use of partial functions
+# - group: {name: partial, enabled: true} # possibly uncomment
+
+- group: {name: use-lens, enabled: true}
+
+# Ignore some builtin hints
+# - ignore: {name: Use let}
+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
+
+
+# Define some custom infix operators
+# - fixity: infixr 3 ~^#^~
+
+
+# To generate a suitable file for HLint do:
+# $ hlint --default > .hlint.yaml

package.yaml

@@ -25,16 +25,16 @@ dependencies:
 - aeson-pretty
 - containers
 - deepseq
-- dlist
+#- dlist
 - directory
 - extra
 - foldl
-- graphviz
+#- graphviz
 - OpenGLRaw
 - text
 - bytestring
 - lens
-- mtl
+#- mtl
 - fgl
 - JuicyPixels
 - random
@@ -81,7 +81,7 @@ executables:
     - -fno-state-hack
     - -funfolding-use-threshold1000 
     #- -funfolding-keeness-factor1000 
-    - -fllvm 
+#    - -fllvm 
     - -optlo-O3
     - -Wall
     #- -Wcompat
@@ -121,7 +121,7 @@ benchmarks:
         - -fno-state-hack
         - -funfolding-use-threshold1000 
           #        - -funfolding-keeness-factor1000 
-        - -fllvm 
+#        - -fllvm 
           #- -optlo-O3
         main:         Bench.hs
         source-dirs:  bench

src/Bound.hs

@@ -1,6 +1,5 @@
-module Bound (
-    boundPoints,
-) where
+module Bound (boundPoints
+    ,boundPointsRect) where
 
 import qualified Control.Foldl as L
 import Control.Lens
@@ -20,3 +19,8 @@ boundPoints =
             )
   where
     f (mn, ms, me, mw) = (,,,) <$> mn <*> ms <*> me <*> mw
+
+boundPointsRect :: [Point2] -> Maybe (Point2,Point2)
+boundPointsRect ps = do
+    (n,s,e,w) <- boundPoints ps
+    return (V2 w s, V2 e n)

src/Color.hs

@@ -1,11 +1,38 @@
 module Color (
-    module Color,
+    withAlpha,
+    red,
+    green,
+    blue,
+    yellow,
+    cyan,
+    magenta,
+    rose,
+    violet,
+    azure,
+    aquamarine,
+    chartreuse,
+    orange,
+    white,
+    black,
+    greyN,
+    mixColors,
+    brightX,
+    mixColorsLinear,
+    mixColorsFrac,
+    dim,
+    bright,
+    light,
+    dark,
+    paletteToColor,
+    lightx4,
+    toColor8,
+    normalizeColor,
     module Color.Data,
 ) where
 
 import Color.Data
-import Geometry
 import Control.Lens
+import Geometry
 
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}
@@ -81,7 +108,7 @@ normalizeColor (V4 r g b a) = V4 (f r) (f g) (f b) (f a)
 
 mixColorsFrac :: Color -> Color -> Float -> Color
 {-# INLINE mixColorsFrac #-}
-mixColorsFrac c1 c2 x = mixColors x (1-x) c1 c2
+mixColorsFrac c1 c2 x = mixColors x (1 - x) c1 c2
 
 mixColors :: Float -> Float -> Color -> Color -> Color
 {-# INLINE mixColors #-}
@@ -107,7 +134,7 @@ light (V4 r g b a) = V4 (r + 0.2) (g + 0.2) (b + 0.2) a
 
 dark :: Color -> Color
 {-# INLINE dark #-}
-dark (V4 r g b a) = V4 (r -0.2) (g -0.2) (b -0.2) a
+dark (V4 r g b a) = V4 (r - 0.2) (g - 0.2) (b - 0.2) a
 
 dim :: Color -> Color
 {-# INLINE dim #-}
@@ -125,23 +152,6 @@ greyN :: Float -> Color
 {-# INLINE greyN #-}
 greyN x = toV4 (x, x, x, 1)
 
-numColor :: Int -> Color
-{-# INLINE numColor #-}
-numColor 0 = toV4 (1, 0, 0, 1)
-numColor 1 = toV4 (0, 1, 0, 1)
-numColor 2 = toV4 (0, 0, 1, 1)
-numColor 3 = toV4 (1, 1, 0, 1)
-numColor 4 = toV4 (0, 1, 1, 1)
-numColor 5 = toV4 (1, 0, 1, 1)
-numColor 6 = toV4 (1, 0, 0.5, 1)
-numColor 7 = toV4 (0.5, 0, 1, 1)
-numColor 8 = toV4 (0, 0.5, 1, 1)
-numColor 9 = toV4 (0, 1, 0.5, 1)
-numColor 10 = toV4 (0.5, 1, 0, 1)
-numColor 11 = toV4 (1, 0.5, 0, 1)
-numColor 12 = toV4 (1, 1, 1, 1)
-numColor _ = toV4 (1, 1, 1, 1)
-
 lightx4 :: Color -> Color
 lightx4 = light . light . light . light
 

src/Dodge/Base/CardinalPoint.hs

@@ -14,8 +14,8 @@ cardVec cp = case cp of
     East -> V2 1 0
     West -> V2 (-1) 0
 
-cardEightVec :: CardinalEightPoint -> Point2
-cardEightVec cp = case cp of
+card8Vec :: Cardinal8 -> Point2
+card8Vec cp = case cp of
     North8 -> V2 0 1
     NorthEast8 -> V2 1 1
     East8 -> V2 1 0

src/Dodge/Base/Collide.hs

@@ -287,7 +287,7 @@ circOnSomeWall :: Point2 -> Float -> World -> Bool
 {-# INLINE circOnSomeWall #-}
 circOnSomeWall p rad =
     any (uncurry (circOnSeg p rad) . _wlLine)
-        . wlsNearPoint p
+        . wlsNearCirc p rad
 
 circOnAnyCr :: Point2 -> Float -> World -> Bool
 {-# INLINE circOnAnyCr #-}

src/Dodge/Base/Coordinate.hs

@@ -31,7 +31,7 @@ worldPosToResOffset cfig cam p =
     (worldPosToScreen cam p & each %~ f)
         + 0.5 *^ ((getWindowSize _gr_world_res cfig :: V2 Int) & each %~ fromIntegral)
   where
-    f x = applyResFactorF (cfig ^. gr_world_res) x
+    f = applyResFactorF (cfig ^. gr_world_res)
 
 -- | The mouse position in world coordinates.
 mouseWorldPos :: Input -> Camera -> Point2

src/Dodge/Combine/Graph.hs

@@ -1,150 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-
-module Dodge.Combine.Graph ( combinationsDotGraph) where
-
-import Dodge.Data.CombAmount
-import Data.Bifunctor
-import qualified Data.Graph.Inductive as FGL
-import Data.GraphViz.Attributes.Complete
-import Data.Text (Text)
-import Data.Text.Lazy (pack, toStrict)
-import Dodge.Combine.Combinations
-import Dodge.Data.Item
-import GraphHelp
-import GraphVizHelp
-import LensHelp
-
-data CombClust
-    = CraftClust
-    | ItemClust
-    | JoinClust
-    deriving (Eq, Ord, Show, Enum, Bounded)
-
-newtype CombNode = CombNode {_unCombNode :: Either ItemType [(CombAmount, ItemType)]}
-    deriving (Eq, Ord, Show)
-
-instance Labellable CombNode where
-    toLabelValue (CombNode Right{}) = StrLabel (pack "")
-    toLabelValue (CombNode (Left ibt)) = StrLabel (pack $ show ibt)
-
-newtype CombEdge = CombEdge {_unCombEdge :: Int}
-    deriving (Eq, Ord, Show)
-
-instance Labellable CombEdge where
-    toLabelValue (CombEdge 0) = StrLabel (pack "")
-    toLabelValue (CombEdge x) = StrLabel (pack $ show x)
-
---bulletCombinations :: [([(ItAmount, ItemType)], Item)]
---bulletCombinations =
---    filter
---        ( (`elem` map totype bulletWeapons)
---            . totype
---            . snd
---        )
---        itemCombinations
---  where
---    totype = _itType
-
-maxShowX :: ItemType -> Maybe Int
-maxShowX = \case
-    HELD (BANGSTICK _) -> Just 2
-    HELD (VOLLEYGUN _) -> Just 3
-    HELD (MINIGUNX _) -> Just 3
-    HELD (GRAPECANNON _) -> Just 1
-    HELD (RLAUNCHERX _) -> Just 2
-    --    HELD (LASWIDE _) -> Just 2
-    --    LASGUNFOCUS _ -> Just 2
-    _ -> Nothing
-
-itemCombinationsEdges :: [(CombNode, CombNode, Int)]
-itemCombinationsEdges = concatMap (f . over _2 _itType) itemCombinations
-  where
-    --itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) bulletCombinations
-
-    f (abts, bt)
-        | bt `elem` bts = []
-        | (not . all belowNumX) bts = []
-        | otherwise = (CombNode $ Right abts, CombNode $ Left bt, 0) : map g abts
-      where
-        bts = map snd abts
-        g (am, bt') = (CombNode $ Left bt', CombNode $ Right abts, _getCombAmount am)
-
-combinationsGraph :: FGL.Gr CombNode CombEdge
-combinationsGraph =
-    FGL.labnfilter (f . _unCombNode . snd)
-        . second CombEdge
-        $ mkGraphFromEdges itemCombinationsEdges
-  where
-    f Right{} = True
-    f (Left (CRAFT _)) = False
-    f (Left bt) = case maxShowX bt of
-        Nothing -> True
-        Just i -> _xNum (_ibtHeld bt) <= i
-
-belowNumX :: ItemType -> Bool
-belowNumX bt = case maxShowX bt of
-    Nothing -> True
-    Just i -> _xNum (_ibtHeld bt) <= i
-
---toCombNodeLabel :: CombNode -> String
---toCombNodeLabel (CombNode (Left ibt)) = show ibt
---toCombNodeLabel (CombNode Right{}) = ""
-
-combinationsDotGraph :: Text
---combinationsDotGraph = toStrict . printDotGraph . graphToDot nonClusteredParams $ combinationsGraph
-combinationsDotGraph =
-    toStrict . printDotGraph . graphToDot myParams $
-        combinationsGraph
-
---    $ first toCombNodeLabel combinationsGraph
-
-myParams :: GraphvizParams Int CombNode CombEdge CombClust CombNode
-myParams =
-    defaultParams -- {globalAttributes = [GraphAttrs [RankDir FromLeft]]}
-        & isDirectedL .~ True
-        --    & globalAttributesL .~ [GraphAttrs [RankDir FromLeft,Splines PolyLine]]
-        & globalAttributesL .~ [GraphAttrs [RankDir FromLeft]]
-        & clusterByL .~ clusterFunc
-        & isDotClusterL .~ const False
-        & clusterIDL .~ setClusterID
-        & fmtClusterL .~ clusterFormatting
-        & fmtEdgeL .~ edgeFormatting
-        & fmtNodeL .~ nodeFormatting
-
-setClusterID :: CombClust -> GraphID
-setClusterID = Num . Int . fromEnum
-
-clusterFunc :: (Int, CombNode) -> NodeCluster CombClust (Int, CombNode)
-clusterFunc n@(_, CombNode (Left bt)) = case bt of
-    CRAFT _ -> C CraftClust (N n)
-    _ -> C ItemClust (N n)
-clusterFunc n = C JoinClust (N n)
-
-clusterFormatting :: CombClust -> [GlobalAttributes]
-clusterFormatting cl = case cl of
-    --    CraftClust -> [GraphAttrs [Rank SameRank]]
-    CraftClust -> []
-    _ -> []
-
-edgeFormatting :: (Int, Int, CombEdge) -> Attributes
---edgeFormatting (_,_,CombEdge 0) = []
---     [ArrowHead (AType [(ArrMod OpenArrow BothSides ,NoArrow)])
---    ,SameTail (pack "b")
---    ]
-edgeFormatting (_, _, ce) = case _unCombEdge ce of
-    0 ->
-        [ xLabel ce
-        , TailPort (CompassPoint East)
-        ]
-    _ ->
-        [ xLabel ce
-        , ArrowHead (AType [(ArrMod OpenArrow BothSides, NoArrow)])
-        , HeadPort (CompassPoint West)
-        ]
-
-nodeFormatting :: (Int, CombNode) -> Attributes
-nodeFormatting (_, CombNode Right{}) = [Shape PointShape]
-nodeFormatting (_, CombNode cn@(Left bt)) = case bt of
-    --CRAFT _ -> [Shape DiamondShape,toLabel (CombNode cn)]
-    CRAFT _ -> [Color [WC (X11Color Green) Nothing], toLabel (CombNode cn)]
-    _ -> [Shape BoxShape, toLabel (CombNode cn)]

src/Dodge/Creature.hs

@@ -129,6 +129,11 @@ inventoryX c = case c of
         , tinMag
         , tinMag
         , tinMag
+        , volleyGun 4
+        , tinMag
+        , tinMag
+        , drumMag
+        , drumMag
         , burstRifle
         , bangCone
         , tinMag
@@ -155,7 +160,7 @@ inventoryX c = case c of
         ]
     "E" -> [alteRifle
         , tinMag
-        , tinMag
+        , drumMag
         ] <>
             fold
         [ makeTypeCraftNum 1 SPRING
@@ -285,6 +290,15 @@ inventoryX c = case c of
                 , FlashBall ]]
         <> [bulletModule (BulletModPayload BulGas)]
         <> [bulletModule (BulletModEffect x) | x <- [minBound .. maxBound]]
+    "W" -> [miniGunX 2
+            , beltMag
+            , miniGunX 3
+            , beltMag
+            , miniGunX 4
+            , beltMag
+            , miniGunX 5
+            , beltMag
+            ]
     _ -> []
 
 testInventory :: [Item]

src/Dodge/Creature/HandPos.hs

@@ -10,6 +10,7 @@ module Dodge.Creature.HandPos (
     backPQ,
     headPQ,
     translateToES,
+    rightHandPQ,
 ) where
 
 import Dodge.Data.Equipment.Misc

src/Dodge/Creature/Impulse.hs

@@ -3,7 +3,8 @@
 
 module Dodge.Creature.Impulse (followImpulse) where
 
-import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
+--import Control.Monad.State -- moving from mtl to transformers
 import Data.Maybe
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.MoveType

src/Dodge/Creature/Impulse/Movement.hs

@@ -37,7 +37,7 @@ crMvByNoStride p lw cr = crMvAbsoluteNoStride lw (rotateV (_crDir cr) p) cr
 
 crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
 crMvAbsolute lw p' cr =
-    advanceStepCounter (magV p) cr
+      cr
         & crPos . _xy +~ p
         & crMvDir .~ argV p
   where
@@ -57,14 +57,6 @@ strengthFactor i
 crMvForward :: Float -> LWorld -> Creature -> Creature
 crMvForward speed = crMvBy (V2 speed 0)
 
-advanceStepCounter :: Float -> Creature -> Creature
-advanceStepCounter speed cr = cr & crStance . carriage %~ f
-  where
-    f car = case car of
-        Standing -> f (Walking 0 RightForward)
-        Walking i ff -> Walking (min (cr ^. crStance . strideLength) (i + speed)) ff
-        _ -> car
-
 creatureTurnTo :: Point2 -> Creature -> Creature
 creatureTurnTo p cr
     | vToTarg == V2 0 0 = cr -- this should deal with the angleVV error

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.Impulse.UseItem (useItem) where
 
+import Dodge.Euse
 import NewInt
 import Control.Lens
 import Data.Maybe
@@ -9,7 +10,6 @@ import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.World
 import Dodge.DoubleTree
-import Dodge.Equipment
 import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar

src/Dodge/Creature/State.hs

@@ -74,7 +74,7 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
     ATTACH CAPACITOR -> tryDrawToCapacitor loc w
     EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
     COPIER _ -> copierItemUpdate itm cr w
-    HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
+    HELD FLATSHIELD -> rootAndAttNotEff createShieldWall removeShieldWall itm cr w
     HELD MINIGUNX{} -> coolMinigun itm w
     HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
     LASER | loc ^. locDT . dtValue . _2 == WeaponTargetingSF

src/Dodge/Creature/Update.hs

@@ -1,5 +1,8 @@
 module Dodge.Creature.Update (updateCreature) where
 
+import Dodge.Creature.Vocalization
+import RandomHelp
+import Data.Maybe
 import Linear
 import NewInt
 import Color
@@ -88,11 +91,22 @@ checkDeath' cr w = case cr ^. crHP of
 corpseOrGib :: Creature -> World -> World
 corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
     Just CookingDamage -> sethp (CrIsCorpse $ scorchSPic thecorpse)
+        . dodeathsound CookDeath
     Just PoisonDamage -> sethp (CrIsCorpse $ poisonSPic thecorpse)
+            . dodeathsound PoisonDeath
     Just PhysicalDamage | _crPain cr > 200 
         -> addCrGibs cr . sethp CrIsGibs
+            . dodeathsound GibsDeath
     _ -> sethp (CrIsCorpse thecorpse)
+            . dodeathsound PlainDeath
   where
+    dodeathsound dt = f dt . stopSoundFrom (CrMouth cid)
+    f dt w = fromMaybe w $ do
+        let (msid, g) = runState (maybeTakeOne (crDeathSounds cr dt)) (_randGen w)
+        sid <- msid
+        return $ w & soundStart (CrMouth cid) (cr ^. crPos . _xy) sid Nothing
+            & randGen .~ g
+    cid = cr ^. crID
     sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
     thecorpse = makeCorpse cr
 
@@ -110,7 +124,8 @@ chasmTest :: Creature -> World -> World
 chasmTest cr w
     | _crZVel cr < 0 = w & tocr . crZVel -~ 0.5
             & tocr . crPos . _z +~ _crZVel cr
-    | Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) = w
+--    | Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms') = w
+    | Just (x, y) <- List.find g (w ^. cWorld . cliffs) = w
             & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
             & tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
     | any f (w ^. cWorld . chasms) = w & tocr . crZVel -~ 0.5

src/Dodge/Creature/Vocalization.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.Vocalization (
     crWarningSounds,
+    crDeathSounds,
     vocalizationTest,
     resetCrVocCoolDown,
 ) where
@@ -39,6 +41,23 @@ crWarningSounds cr = case cr ^. crType of
     BarrelCrit{} -> mempty
     LampCrit{} -> mempty
 
+crDeathSounds :: Creature -> DeathType -> [SoundID]
+crDeathSounds cr dt = case cr ^. crType of
+    Avatar{} -> mempty
+    AvatarDead -> mempty
+    ChaseCrit{} -> defaultDeathSounds dt
+    SwarmCrit -> mempty
+    AutoCrit -> mempty
+    BarrelCrit{} -> mempty
+    LampCrit{} -> mempty
+
+defaultDeathSounds :: DeathType -> [SoundID]
+defaultDeathSounds = \case
+    CookDeath -> mempty
+    PoisonDeath -> mempty
+    PlainDeath -> mempty
+    GibsDeath -> mempty
+
 vocalizationTest :: Creature -> Maybe SoundID
 vocalizationTest cr = case cr ^? crVocalization . vcCoolDown of
     Just 0 -> crVocalizationSound cr

src/Dodge/Data/CWorld.hs

@@ -31,6 +31,7 @@ data CWorld = CWorld
     , _incEdges :: [(Int,Int)]
     , _numberFloorVerxs :: Int
     , _chasms :: [[Point2]]
+    , _cliffs :: [(Point2,Point2)]
     , _numberChasmVerxs :: Int
     , _highlightItems :: IM.IntMap Int
     }

src/Dodge/Data/CardinalPoint.hs

@@ -24,7 +24,7 @@ data CardinalPointBetween
     | NorthWest
     deriving (Eq, Ord, Show, Bounded, Enum)
 
-data CardinalEightPoint
+data Cardinal8
     = North8
     | NorthEast8
     | East8

src/Dodge/Data/Config.hs

@@ -52,7 +52,7 @@ data Config = Config
     , _gr_upscale_filter :: Bool
     , _gr_cloud_shadows :: Bool
     , _gr_distortions :: Bool
-    , _gr_bloom :: Bool
+--    , _gr_bloom :: Bool
     , _gr_shadow_rendering :: ShadowRendering
     , _gr_shadows_on_clouds :: ShadowRendering
     , _gr_shadow_size :: Importance
@@ -98,7 +98,7 @@ data DebugBool
     | Circ_collision_test
     | Show_far_wall_detect
     | Show_walls_near_point_cursor
-    | Show_walls_near_point_you
+    | Show_walls_near_you
     | Show_walls_near_segment
     | Show_zone_near_point_cursor
     | Show_zone_circ
@@ -106,6 +106,7 @@ data DebugBool
     | Show_path_between
     | Show_writable_values
     | Show_mouse_click_pos
+    | Muzzle_positions
     deriving (Eq, Ord, Bounded, Enum, Show)
 
 data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes
@@ -155,7 +156,7 @@ defaultConfig =
         , _volume_music = 0
         , _gr_upscale_filter = True
         , _gr_cloud_shadows = True
-        , _gr_bloom = True
+--        , _gr_bloom = True
         , _gr_shadow_rendering = GeoObjShads
         , _gr_shadows_on_clouds = NoObjShads
         , _gr_shadow_size = Typical

src/Dodge/Data/Creature.hs

@@ -65,6 +65,8 @@ data CrHP
     | CrIsGibs
     | CrIsPitted
 
+data DeathType = CookDeath | PoisonDeath | PlainDeath | GibsDeath
+
 data Intention = Intention
     { _targetCr :: Maybe Int
     , _mvToPoint :: Maybe Point2

src/Dodge/Data/Creature/Stance.hs

@@ -21,7 +21,6 @@ data Stance = Stance
 
 data Carriage
     = Walking {_strideAmount :: Float, _currentFoot :: FootForward}
-    | Standing
     | Floating
     | Flying
     | Boosting Point2

src/Dodge/Data/GenWorld.hs

@@ -10,7 +10,8 @@ module Dodge.Data.GenWorld (
 
 import ShortShow
 import Control.Lens
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 import qualified Data.Set as S
 import Data.Tile
 import Dodge.Data.Room
@@ -57,11 +58,18 @@ data PSType
     | PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld) -- the Int is the roomid
     | PutNothing
     | PutID {_putID :: Int}
-    | PutChasm {_putChasmPoly :: [Point2]}
+    | PutChasm {_putChasmChasms :: [[Point2]], _putChasmCliffs :: [[Point2]]}
+        -- the chasms should be a convex partition of the cliffs.
+        -- Chasm and cliff polygons are orientated anticlockwise, so platforms 
+        -- within a chasm will appear as a clockwise oriented list of points
+        -- in _putChasmCliffs.
     | PutLabel {_putLabel :: String} -- currently not actually put anywhere
         -- just used for later inspection as top level 
         -- of a continuing placement in a room placement list
 
+putConvexChasm :: [Point2] -> PSType
+putConvexChasm ps = PutChasm [ps] [ps]
+
 instance ShortShow PSType where
     shortShow PutCrit {} = "PutCrit"
     shortShow PutMachine {} = "PutMachine"

src/Dodge/Data/Item/Location.hs

@@ -31,7 +31,7 @@ data ItemLocation
         , _ilInvID :: NewInt InvInt
         , _ilIsRoot :: Bool -- of any item
         , _ilIsSelected :: Bool
-        , _ilIsAttached :: Bool -- to selected item
+        , _ilIsAttached :: Bool -- to selected item.  question: downwards and upwards?
         , _ilEquipSite :: Maybe EquipSite
         }
     | OnTurret {_ilTuID :: Int}

src/Dodge/Data/Machine.hs

@@ -47,6 +47,7 @@ data MachineType
     | McTurret {_mctTurret :: Turret}
     | McStorage {_mcsType :: AmmoType, _mcsAmount :: Int}
     | McDistributer {_mcdStorageMachine :: Maybe Int}
+    | McTrigger {_mcTriggerID :: Int}
 --    | McSynthesiser
 
 instance ShortShow MachineType where
@@ -58,6 +59,7 @@ instance ShortShow MachineType where
         McTurret {} -> "McTur"
         McStorage {} -> "McStor"
         McDistributer {} -> "McDist"
+        McTrigger i -> "McTrigger " <> show i
 
 data Turret = Turret
     { _tuWeapon :: Int

src/Dodge/Data/Machine/Sensor.hs

@@ -19,7 +19,6 @@ data SensorType
 data DamageSensor = DamSensor
     { _sensAmount :: Int
     , _sensType :: SensorType
-    , _sensThreshold :: Int
     }
 
 data ProximitySensor = ProxSensor

src/Dodge/Data/MetaTree.hs

@@ -6,7 +6,8 @@ module Dodge.Data.MetaTree where
 import Control.Lens
 import Data.Tree
 import System.Random
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 
 data MetaTree a b = MTree
     {_mtLabel :: b, _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b]}

src/Dodge/Data/SelectionList.hs

@@ -10,15 +10,16 @@ import Dodge.Data.CardinalPoint
 import Dodge.Data.ScreenPos
 import Picture.Data
 
-data ListDisplayParams = ListDisplayParams
+data LDParams = LDP -- List display parameters
     { _ldpPos :: ScreenPos
     , _ldpScale :: Float
     , _ldpVerticalGap :: Float
+    , _ldpBorder :: Maybe (Int,Int) -- the Ints give height and width for a border
     }
 
 data CursorDisplay
-    = BoundaryCursor [CardinalPoint]
-    | BackdropCursor
+    = BoundCurs [CardinalPoint]
+    | BackdropCurs
 
 data SectionCursor = SectionCursor
     { _scurPos :: Int
@@ -36,6 +37,8 @@ data SelSection a = SelSection
 
 type IMSS a = IntMap (SelSection a)
 
+type IMSI a = IntMap (SelectionItem a)
+
 data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
 
 data SelectionItem a = SelItem
@@ -52,8 +55,11 @@ data SelectionItem a = SelItem
 data SIDisplayMod
     = NoSIDisplayMod
     | HighlightSI
+    | DropShadowSI
+    | InventoryHeadSI
+    | InventoryHeadFilterSI
 
-makeLenses ''ListDisplayParams
+makeLenses ''LDParams
 makeLenses ''SelectionItem
 makeLenses ''SelSection
 makeLenses ''SectionCursor

src/Dodge/Data/SoundOrigin.hs

@@ -18,7 +18,8 @@ data SoundOrigin
     | CrWeaponSound Int Int
     | ItemSound Int Int
     | CrWeaponFailSound Int
-    | MachineSound Int
+    | MachinePrimarySound Int
+    | MachineBackgroundSound Int
     | MachineAltSound Int
     | TerminalSound
     | WallSound Int

src/Dodge/Data/Terminal.hs

@@ -28,6 +28,7 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
+    , _tmRebootOnAccess :: Bool
     }
 
 data TerminalLineString = TerminalLineConst String Color

src/Dodge/Debug.hs

@@ -2,6 +2,13 @@
 
 module Dodge.Debug (debugEvents, drawDebug) where
 
+import Geometry.Data
+import Dodge.Render.Label
+import Dodge.Data.DoubleTree
+import Dodge.HeldUse
+import Dodge.DoubleTree
+import Dodge.Item.Grammar
+import NewInt
 import AesonHelp
 import Control.Lens
 import Control.Monad
@@ -55,7 +62,7 @@ debugItem = \case
     Show_wall_search_rays -> mempty
     Show_dda_test -> mempty
     Show_far_wall_detect -> mempty
-    Show_walls_near_point_you -> mempty
+    Show_walls_near_you -> mempty
     Show_zone_near_point_cursor -> mempty
     Show_zone_circ -> mempty
     Inspect_wall -> mempty
@@ -70,6 +77,7 @@ debugItem = \case
     Show_mouse_click_pos -> debugMouseClickPos
     Debug_get -> doDebugGet
     Debug_put -> debugPutItems
+    Muzzle_positions -> mempty
 
 debugGet :: Universe -> [String]
 debugGet u = foldMap getPretty $ u ^. uvWorld . cWorld . lWorld . shockwaves
@@ -224,7 +232,7 @@ drawDebug u = \case
     Show_wall_search_rays -> drawWallSearchRays $ _uvWorld u
     Show_dda_test -> drawDDATest $ _uvWorld u
     Show_far_wall_detect -> drawFarWallDetect $ _uvWorld u
-    Show_walls_near_point_you -> drawWallsNearYou $ _uvWorld u
+    Show_walls_near_you -> drawWallsNearYou $ _uvWorld u
     Show_zone_near_point_cursor -> drawZoneNearPointCursor $ _uvWorld u
     Show_zone_circ -> drawZoneCirc $ _uvWorld u
     Inspect_wall -> drawInspectWalls $ _uvWorld u
@@ -239,3 +247,18 @@ drawDebug u = \case
     Show_path_between -> drawPathBetween u
     Show_writable_values -> mempty
     Show_mouse_click_pos -> mempty
+    Muzzle_positions -> showMuzzlePositions u
+
+
+showMuzzlePositions :: Universe -> Picture
+showMuzzlePositions  u = fold $ do
+    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
+    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
+        ^? ix invid . _2
+    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
+  where
+    f cr loc = foldMap (g . muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
+      where
+        g :: Point3Q -> Picture
+        g pq = translate3 (pq ^. _1) $ crossPic 5

src/Dodge/Debug/Picture.hs

@@ -72,7 +72,7 @@ lineOnScreenCone cfig w p1 p2 =
 
 drawWallFace :: Config -> World -> Wall -> Picture
 drawWallFace cfig w wall
-    | isRHS sightFrom x y || not (wlIsOpaque wall) = blank
+    | isRHS sightFrom x y || not (wlIsOpaque wall) = mempty
     | otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
   where
     (x, y) = _wlLine wall
@@ -214,8 +214,8 @@ drawPathBetween u = concat $ do
              color rose (foldMap (arrowPath . map nodepos) nodelist)
             <> drawCrossCol green sp
             <> drawCrossCol cyan ep
-            <> foldMap (color green . arrow sp) (nodepos <$> walkableNodeNear w sp)
-            <> foldMap (color cyan . flip arrow ep) (nodepos <$> walkableNodeNear w ep)
+            <> foldMap ((color green . arrow sp) . nodepos) (walkableNodeNear w sp)
+            <> foldMap ((color cyan . flip arrow ep) . nodepos) (walkableNodeNear w ep)
             <> foldMap (color orange . arrow sp) (pointTowardsImpulse sp ep w)
   where
     w = u ^. uvWorld
@@ -223,9 +223,10 @@ drawPathBetween u = concat $ do
 drawWallsNearYou :: World -> Picture
 drawWallsNearYou w = concat $ do
     p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy
-    return $ setLayer DebugLayer $ foldMap f $ wlsNearPoint p w
+    return $ setLayer DebugLayer $ foldMap f $ wlsNearCirc p 30 w
   where
     f wl = color violet $ thickLine 3 [a, b]
+        <> uncurryV translate (0.5 *^ (a + b)) (scale 0.05 0.05 . text $ show (_wlID wl))
       where
         (a, b) = _wlLine wl
 

src/Dodge/Default.hs

@@ -21,8 +21,8 @@ import Dodge.Default.Wall
 import Geometry
 import Picture
 
-defaultEquipment :: Item
-defaultEquipment = defaultHeldItem & itUse .~ UseNothing
+defEquipment :: Item
+defEquipment = defHeldItem & itUse .~ UseNothing
 
 defaultFlIt :: FloorItem
 defaultFlIt = FlIt{_flItRot = 0,  _flItPos = V2 0 0}

src/Dodge/Default/Item.hs

@@ -1,13 +1,13 @@
 module Dodge.Default.Item (
-    defaultHeldItem,
-    defaultCraftItem,
+    defHeldItem,
+    defCraftItem,
 ) where
 
 import Control.Lens
 import Dodge.Data.Item
 
-defaultHeldItem :: Item
-defaultHeldItem =
+defHeldItem :: Item
+defHeldItem =
     Item
         { _itType = HELD PISTOL
         , _itConsumables = Nothing
@@ -22,5 +22,5 @@ defaultHeldItem =
         , _itTimeLastUsed = 0
         }
 
-defaultCraftItem :: Item
-defaultCraftItem = defaultHeldItem & itUse .~ UseNothing
+defCraftItem :: Item
+defCraftItem = defHeldItem & itUse .~ UseNothing

src/Dodge/Default/Terminal.hs

@@ -19,6 +19,7 @@ defaultTerminal =
         , _tmStatus = TerminalOff
         , _tmCommandHistory = []
         , _tmToggles = mempty
+        , _tmRebootOnAccess = False
 --        , _tmExternalColor = dark magenta
         }
 

src/Dodge/Default/World.hs

@@ -94,6 +94,7 @@ defaultCWorld =
         , _cwTiles = mempty
         , _numberFloorVerxs = 0
         , _chasms = mempty
+        , _cliffs = mempty
         , _numberChasmVerxs = 0
         , _incGraph = mempty
         , _incNode = mempty

src/Dodge/DisplayInventory.hs

@@ -65,7 +65,7 @@ updateCombineSections w cfig =
     sclose'
         | null sclose =
             IM.singleton 0 $
-                SelItem ["NONE"] 1 25 False white 2 Nothing NoSIDisplayMod
+                SelItem ["NONE"] 1 25 False white 2 Nothing DropShadowSI
         | otherwise = sclose
 
 regexCombs :: IM.IntMap Item -> SelectionItem CombItem -> String -> Bool
@@ -124,8 +124,8 @@ updateDisplaySections w cfig =
                 [ sfinv
                 , sinv
                 , IM.singleton 0 $
-                    SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing NoSIDisplayMod
-                , sfclose
+                    SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing DropShadowSI
+                , sfclose1
                 , sclose
                 , interfaceshead
                 , btitems
@@ -137,6 +137,9 @@ updateDisplaySections w cfig =
         filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
             w ^? hud . diInvFilter . _Just
     closefiltcurs = mselpos ^? _Just . slSec == Just 2
+    sfclose1
+        | null sclose && sfclose ^? ix 0 . siIsSelectable == Just False = mempty
+        | otherwise = sfclose
     (sfclose, sclose) =
         filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
             w ^? hud . diCloseFilter . _Just
@@ -144,7 +147,7 @@ updateDisplaySections w cfig =
     btitems =
         IM.fromDistinctAscList . zip [0 ..] $
             mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
-    makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing NoSIDisplayMod
+    makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing InventoryHeadSI
     cr = you w
     closeitms =
         IM.fromDistinctAscList . zip [0 ..] $
@@ -165,7 +168,7 @@ filterSectionsPair infocus filtfn itms s mfilt = (x, itms')
   where
     filtcurs = if infocus then cFilledRect else cWireRect
     x = IM.singleton 0 $
-        fromMaybe (SelItem [s] 1 (length s) False white 0 Nothing NoSIDisplayMod) $ do
+        fromMaybe (SelItem [s] 1 (length s) False white 0 Nothing InventoryHeadSI) $ do
             str <- mfilt
             return $
                 SelItem
@@ -176,7 +179,7 @@ filterSectionsPair infocus filtfn itms s mfilt = (x, itms')
                     white
                     0
                     Nothing
-                    NoSIDisplayMod
+                    InventoryHeadFilterSI
     f y = y
 --        | null y =
 --            IM.singleton 0 $ SelItem ["(NONE)"] 1 (length s) True (greyN 0.5) 0 Nothing
@@ -256,13 +259,7 @@ updateSectionsPositioning h mselpos allavailablelines lsss sss =
     lk = mselpos ^.. _Just . slSec
     ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls
 
-updateSection ::
-    Int ->
-    Maybe Int ->
-    IM.IntMap (SelectionItem a) ->
-    Int ->
-    Int ->
-    SelSection a
+updateSection :: Int -> Maybe Int -> IMSI a -> Int -> Int -> SelSection a
 updateSection indent mcsel sis availablelines oldoffset =
     SelSection
         { _ssItems = sis
@@ -302,10 +299,14 @@ updateSection indent mcsel sis availablelines oldoffset =
 listSelectionColorPicture :: SelectionItem a -> ([Picture], Sum Int)
 listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
   where
-    textf = case si ^. siDisplayMod of
-        NoSIDisplayMod -> text
-        HighlightSI -> hackBoldText
-    g = translate lindent 0 . color (_siColor si) . textf
+    g = translate lindent 0 . case si ^. siDisplayMod of
+        NoSIDisplayMod -> docolor . text
+        HighlightSI -> docolor . hackBoldText
+        DropShadowSI -> hackDropShadow (si ^. siColor) black
+        InventoryHeadSI -> hackInvertText black white . dopad
+        InventoryHeadFilterSI -> docolor . text
+    dopad s = "  "<>s<>"  "
+    docolor = color (si ^. siColor)
     lindent = 100 * fromIntegral (_siOffX si)
 
 regexList :: String -> [String] -> Bool

src/Dodge/EnergyBall/Draw.hs

@@ -44,7 +44,6 @@ drawFlamelet size pt =
     time = _ebTimer pt
     piu =
         translate3 sp
---        setDepth (z + 5)
 --            . uncurryV translate sp
             . color
                 ( mixColors
@@ -61,8 +60,6 @@ drawFlamelet size pt =
             $ reverse (rectNSWE siz2 (- siz2) (- siz2) siz2)
     pi2 =
         translate3 sp
-        --setDepth (z + 5)
-        --    . uncurryV translate sp
             . color
                 ( mixColors
                     (fromIntegral (max 0 (time -2)))
@@ -79,8 +76,6 @@ drawFlamelet size pt =
             $ rectNSWE siz2 (- siz2) (- siz2) siz2
     pic =
         translate3 sp
-        --setDepth (z + 2)
-        --    . uncurryV translate sp
             . color
                 ( mixColors
                     (fromIntegral (max 0 (time -2)))

src/Dodge/Equipment.hs

@@ -1,64 +0,0 @@
-module Dodge.Equipment (
-    effectOnRemove,
-    effectOnEquip,
-) where
-
-import Linear
-import Control.Lens
-import Data.Maybe
-import Dodge.Creature.HandPos
-import Dodge.Data.World
-import Dodge.Item.Location
-import Dodge.Wall.Delete
-import Dodge.Wall.ForceField
-import Dodge.Wall.Move
-import Geometry
-import qualified IntMapHelp as IM
-import NewInt
-
-effectOnRemove :: Item -> Creature -> World -> World
-effectOnRemove itm = case itm ^. itType of
-    EQUIP WRISTARMOUR -> onRemoveWristShield itm
-    _ -> const id
-
-onRemoveWristShield :: Item -> Creature -> World -> World
-onRemoveWristShield itm _ =
-    (pointerToItem itm . itParams .~ NoParams) . mremovewall
-  where
-    mremovewall = fromMaybe id $ do
-        i <- itm ^? itParams . itParamID
-        return $ deleteWallID i
-
-effectOnEquip :: Item -> Creature -> World -> World
-effectOnEquip itm = case itm ^. itType of
-    EQUIP WRISTARMOUR -> onEquipWristShield itm
-    _ -> const id
-
-onEquipWristShield :: Item -> Creature -> World -> World
-onEquipWristShield itm cr w =
-    w
-        & pointerToItem itm . itParams .~ ItemParamID{_itParamID = i}
-        & cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
-        & setWristShieldPos
-            ( itm & itParams .~ ItemParamID{_itParamID = i}
-            )
-            cr
-  where
-    i = IM.newKey (w ^. cWorld . lWorld . walls)
-
-setWristShieldPos :: Item -> Creature -> World -> World
-setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
-  where
-    i = _itParamID $ _itParams itm
-    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
-    handtrans = case w ^? cWorld . lWorld . items
-            . ix (itm ^. itID . unNInt)
-            . itLocation
-            . ilEquipSite
-            . _Just of
-        Just x -> translateToES cr x -- . g
-        _ -> undefined
-    --    g
-    --        | twists cr = (+.+.+ V3 (-5) 10 0)
-    --        | otherwise = id
-    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans

src/Dodge/Euse.hs

@@ -1,22 +1,25 @@
-module Dodge.Euse (equipBackgroundEffect) where
+module Dodge.Euse (
+    equipBackgroundEffect,
+    effectOnRemove,
+    effectOnEquip,
+) where
 
 import Dodge.Creature.HandPos
-import Dodge.Creature.Test
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
+import Dodge.Item.Location
+import Dodge.Wall.Delete
+import Dodge.Wall.ForceField
 import Dodge.Wall.Move
 import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
 import Linear
+import NewInt
 
-equipBackgroundEffect ::
-    LocationDT OItem ->
-    Creature ->
-    EquipSite ->
-    World ->
-    World
+equipBackgroundEffect :: LocationDT OItem -> Creature -> EquipSite -> World -> World
 equipBackgroundEffect loc cr = case eo of
     EQUIP (MAGSHIELD mt) -> const $ useMagShield mt itm cr
     EQUIP WRISTARMOUR -> setWristShieldPos itm cr
@@ -29,28 +32,31 @@ equipBackgroundEffect loc cr = case eo of
 -- this should probably drain energy
 useMagShield :: MagnetBuBu -> Item -> Creature -> World -> World
 useMagShield mt _ cr w =
-    w & cWorld . lWorld . magnets
+    w
+        & cWorld
+        . lWorld
+        . magnets
         .:~ Magnet
             { _mgPos = cr ^. crPos . _xy
             , _mgField = mt
             }
 
-setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
-setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
-  where
-    i = _itParamID $ _itParams itm
-    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
-    handtrans = case x of
-        OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
-        _ -> translatePointToRightHand
-    g
-        | twists cr = (+.+.+ V3 (-5) 10 0)
-        | otherwise = id
-    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans cr
+--setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
+--setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
+--  where
+--    i = _itParamID $ _itParams itm
+--    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
+--    handtrans = case x of
+--        OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
+--        _ -> translatePointToRightHand
+--    g
+--        | twists cr = (+.+.+ V3 (-5) 10 0)
+--        | otherwise = id
+--    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
 -- TODO the reflection should be controled by the particle
---shieldWallDamage :: Damage -> Wall -> Int -> World -> World
---shieldWallDamage dm _ crid w = case _dmType dm of
+-- shieldWallDamage :: Damage -> Wall -> Int -> World -> World
+-- shieldWallDamage dm _ crid w = case _dmType dm of
 ----    Lasering -> w
 --    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
 --    _ -> w
@@ -58,7 +64,9 @@ setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
 createHeadLamp :: Item -> Creature -> World -> World
 createHeadLamp _ cr w =
     w
-        & cWorld . lWorld . lights
+        & cWorld
+        . lWorld
+        . lights
         .:~ LSParam
             ( _crPos cr
                 +.+.+ rotate3
@@ -67,3 +75,61 @@ createHeadLamp _ cr w =
             )
             200
             0.7
+
+effectOnRemove :: Item -> Creature -> World -> World
+effectOnRemove itm = case itm ^. itType of
+    EQUIP WRISTARMOUR -> onRemoveWristShield itm
+    _ -> const id
+
+onRemoveWristShield :: Item -> Creature -> World -> World
+onRemoveWristShield itm _ =
+    (pointerToItem itm . itParams .~ NoParams)
+        . maybe id deleteWallID (itm ^? itParams . itParamID)
+
+effectOnEquip :: Item -> Creature -> World -> World
+effectOnEquip itm = case itm ^. itType of
+    EQUIP WRISTARMOUR -> onEquipWristShield itm
+    _ -> const id
+
+onEquipWristShield :: Item -> Creature -> World -> World
+onEquipWristShield itm cr w =
+    w
+        & pointerToItem itm
+        . itParams
+        .~ ItemParamID i
+        & cWorld
+        . lWorld
+        . walls
+        . at i
+        ?~ forceField{_wlID = i}
+        & setWristShieldPos
+            ( 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
+
+setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
+setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline
+  where
+    i = _itParamID $ _itParams itm
+    wlline = (f (V3 (-10) y 0), f (V3 10 y 0))
+    y = case esite of
+        OnLeftWrist -> 7
+        OnRightWrist -> -7
+        _ -> error "setWristShieldPos esite is not a wrist"
+    handtrans = case w
+        ^? cWorld
+        . lWorld
+        . items
+        . ix (itm ^. itID . unNInt)
+        . itLocation
+        . ilEquipSite
+        . _Just of
+        Just x -> translateToES cr x -- . g
+        _ -> undefined
+    --    g
+    --        | twists cr = (+.+.+ V3 (-5) 10 0)
+    --        | otherwise = id
+    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans

src/Dodge/Floor.hs

@@ -55,7 +55,7 @@ initialRoomTree =
             , intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
             , rToOnward "chaseCrit+armourChaseCrit rectRoom" .
                     return . cleatOnward =<<
-                        (roomRectAutoLinks 400 400 <&> rmPmnts
+                        (roomRectAutoLights 400 400 <&> rmPmnts
                             .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
                                  , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
                                  ])

src/Dodge/HeldUse.hs

@@ -6,6 +6,8 @@ module Dodge.HeldUse (
     gadgetEffect,
     mcUseHeld,
     heldEffectMuzzles,
+    muzzlePos,
+    itemMuzzles,
 ) where
 
 import Color
@@ -206,14 +208,14 @@ heldItemMuzzles itm = \case
     BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05
     MINIGUNX i ->
         [ Muzzle
-            (V2 (30 + 40 * fromIntegral j / fromIntegral i) 0)
+            (V2 (40 * fromIntegral j / fromIntegral i) 0)
             0
             0.05
             maguse1
             NoFlare
             MuzzleShootBullet
             10
-        | j <- [0 .. i -1]
+        | j <- [1 .. i]
         ]
             & ix 0 . mzFlareType .~ MiniGunFlare
     BANGROD ->
@@ -301,6 +303,7 @@ heldItemMuzzles itm = \case
         dbwMuzzles
             & ix 0 . mzEffect .~ MuzzleScroller
             & ix 0 . mzAmmoSlot . aps .~ UseExactly 100000
+    FLATSHIELD -> mempty
     _ ->
         [ Muzzle
             { _mzPos = V2 20 0
@@ -717,13 +720,8 @@ basicMuzFlare pos dir =
 isAmmoIntLink :: Int -> ItemSF -> Bool
 isAmmoIntLink i sf = Just i == sf ^? amsfLink
 
-useLoadedAmmo ::
-    LocationDT OItem ->
-    Creature ->
-    Muzzle ->
-    Maybe (Int, DTree OItem) ->
-    World ->
-    World
+useLoadedAmmo 
+    :: LocationDT OItem -> Creature -> Muzzle -> Maybe (Int, DTree OItem) -> World -> World
 useLoadedAmmo loc cr mz m w =
     makeMuzzleFlare pq loc (mz ^. mzFlareType) $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
@@ -905,7 +903,8 @@ shootPulseBall (p, q) w =
     i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
 
 removeAmmoFromMag :: Int -> Int -> World -> World
-removeAmmoFromMag x magid = cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
+removeAmmoFromMag x magid 
+    = cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
 
 getBulletType :: DTree OItem -> Maybe Bullet
 getBulletType magtree =
@@ -960,12 +959,8 @@ magAmmoParams itm = case itm ^. itType of
 --        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
 --        _ -> 0
 
-shootBullets ::
-    LocationDT OItem ->
-    Creature ->
-    (Muzzle, Int, DTree OItem) ->
-    World ->
-    World
+shootBullets 
+    :: LocationDT OItem -> Creature -> (Muzzle, Int, DTree OItem) -> World -> World
 shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
     thebullet <- getBulletType magtree
     return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))
@@ -1161,7 +1156,7 @@ doGenFloat (UniRandFloat x y) g = randomR (x, y) g
 
 mcShootLaser :: Item -> Machine -> World -> World
 mcShootLaser _ mc =
-    shootLaser (MachineSound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow
+    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow
   where
     pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
     dir = mc ^?! mcType . _McTurret . tuDir

src/Dodge/Inventory.hs

@@ -16,13 +16,13 @@ module Dodge.Inventory (
     destroyAllInvItems,
 ) where
 
+import Dodge.Euse
 import Linear
 import Data.Function
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
 import Dodge.Data.World
-import Dodge.Equipment
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.Inventory.Swap

src/Dodge/Inventory/SelectionList.hs

@@ -34,7 +34,7 @@ invSelectionItem w indent loc =
     SelItem
         { _siPictures = itemDisplay w cr ci
         , _siHeight = itInvHeight $ ci ^. _1
-        , _siWidth = 15
+        , _siWidth = maximum (15 : (length <$> itemDisplay w cr ci))
         , _siIsSelectable = True
         , _siColor = itemInvColor ci
         , _siOffX = indent
@@ -42,7 +42,7 @@ invSelectionItem w indent loc =
         , _siDisplayMod = dmod
         }
   where
-    dmod = maybe NoSIDisplayMod (const HighlightSI) 
+    dmod = maybe DropShadowSI (const HighlightSI) 
         $ w ^? cWorld . highlightItems . ix (a ^. itID . unNInt)
     ci = (a,b)
     (a,b,_) = loc ^. locDT . dtValue
@@ -51,19 +51,13 @@ invSelectionItem w indent loc =
 -- note the convoluted display of the hotkey/equipment, this was done to avoid a
 -- space leak
 itemDisplay :: World -> Creature -> CItem -> [String]
-itemDisplay w cr ci = -- f
-        basicItemDisplay itm
---        (itemNumberDisplay w cr ci)
-        `g` anyextra
+itemDisplay w cr ci = basicItemDisplay itm `g` anyextra
   where
     itm = ci ^. _1
     NInt itid = itm ^. itID
-    --f (x:xs) (y:_) = itemDisplayPad x y : xs
-    --f xs _ = xs
-    --g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
-    g (x:xs) (y:_) = (x ++ y) : xs
+    g (x:xs) (Just y) = (x <> y) : xs
     g xs _ = xs
-    anyextra = maybeToList (anyscroll <> anyexternal <> anyhotkey <> anyequippos)
+    anyextra = anyscroll <> anyexternal <> anyhotkey <> anyequippos
     anyhotkey = fmap hotkeyToString
         (w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
     anyequippos = do
@@ -221,7 +215,7 @@ closeItemToSelectionItem w i = do
             , _siColor = col
             , _siOffX = 0
             , _siPayload = Nothing
-            , _siDisplayMod = NoSIDisplayMod
+            , _siDisplayMod = DropShadowSI
             }
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
@@ -236,7 +230,7 @@ closeButtonToSelectionItem w i = do
             , _siColor = yellow
             , _siOffX = 0
             , _siPayload = Nothing
-            , _siDisplayMod = NoSIDisplayMod
+            , _siDisplayMod = DropShadowSI
             }
 
 btText :: Button -> String

src/Dodge/Item/Ammo.hs

@@ -16,68 +16,69 @@ module Dodge.Item.Ammo (
 import Control.Lens
 import Dodge.Data.World
 import Dodge.Default.Item
-import Dodge.Item.Attach
-
---import Dodge.Item.Weapon.Bullet
 
 megaTinMag :: Int -> Item
-megaTinMag x =
-    tinMag
-        & itConsumables ?~ x
+megaTinMag x = tinMag & itConsumables ?~ x
 
 tinMag :: Item
 tinMag =
-    defaultHeldItem & itType .~ AMMOMAG TINMAG
+    defHeldItem
+        & itType .~ AMMOMAG TINMAG
         & itUse .~ UseNothing
         & itConsumables ?~ 15
 
 drumMag :: Item
 drumMag =
-    tinMag & itType . ibtAmmoMag .~ DRUMMAG
+    tinMag
+        & itType . ibtAmmoMag .~ DRUMMAG
+        & itUse .~ UseNothing
         & itConsumables ?~ 30
 
 beltMag :: Item
 beltMag =
-    tinMag & itType . ibtAmmoMag .~ BELTMAG
+    tinMag
+        & itType . ibtAmmoMag .~ BELTMAG
         & itConsumables ?~ 10000
 
 megaShellMag :: Item
-megaShellMag =
-    shellMag
-        & itConsumables ?~ 1000000
+megaShellMag = shellMag & itConsumables ?~ 1000000
 
 shellMag :: Item
 shellMag =
-    defaultHeldItem & itType .~ AMMOMAG SHELLMAG
+    defHeldItem
+        & itType .~ AMMOMAG SHELLMAG
         & itUse .~ UseNothing
         & itConsumables ?~ 1
 
 megaBattery :: Item
-megaBattery =
-    battery
-        & itConsumables ?~ 1000000
+megaBattery = battery & itConsumables ?~ 1000000
 
 smallBattery :: Item
 smallBattery = battery & itConsumables ?~ 999
 
 battery :: Item
 battery =
-    defaultHeldItem & itType .~ AMMOMAG BATTERY
+    defHeldItem
+        & itType .~ AMMOMAG BATTERY
         & itUse .~ UseNothing
         & itConsumables ?~ 10 ^ (9 :: Int)
 
 capacitor :: Item
 capacitor =
-    defaultHeldItem & itType .~ ATTACH CAPACITOR
+    defHeldItem
+        & itType .~ ATTACH CAPACITOR
         & itUse .~ UseNothing
         & itConsumables ?~ 0
 
 chemFuelPouch :: Item
 chemFuelPouch =
-    defaultHeldItem & itType .~ AMMOMAG CHEMFUELPOUCH
+    defHeldItem
+        & itType .~ AMMOMAG CHEMFUELPOUCH
         & itUse .~ UseNothing
         & itConsumables
             ?~ 100000
 
 bulletSynthesizer :: Item
-bulletSynthesizer = makeAttach BULLETSYNTH & itUse .~ UseAttach (APInt 0)
+bulletSynthesizer = defHeldItem
+    & itType .~ ATTACH BULLETSYNTH 
+    & itUse .~ UseAttach (APInt 0)

src/Dodge/Item/AmmoSlots.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 
 module Dodge.Item.AmmoSlots (
     itemAmmoSlots,
@@ -29,14 +30,15 @@ heldItemAmmoSlots = \case
     RIFLE -> singleAmmo BulletAmmo
     AUTORIFLE -> singleAmmo BulletAmmo
     BURSTRIFLE -> singleAmmo BulletAmmo
-    ALTERIFLE -> IM.fromList (zip [0..1] $ repeat BulletAmmo)
+    --ALTERIFLE -> IM.fromList (zip [0..1] $ repeat BulletAmmo)
+    ALTERIFLE -> IM.fromList $ [0..1] <&> (,BulletAmmo)
     BANGROD -> singleAmmo BulletAmmo
     ELEPHANTGUN -> singleAmmo BulletAmmo
     AMR -> singleAmmo BulletAmmo
     AUTOAMR -> singleAmmo BulletAmmo
     SNIPERRIFLE -> singleAmmo BulletAmmo
     MINIGUNX _ -> singleAmmo BeltBulletAmmo
-    VOLLEYGUN i -> IM.fromList (zip [0..i-1] $ repeat BulletAmmo)
+    VOLLEYGUN i -> IM.fromList $ [0..i-1] <&> (,BulletAmmo)
     POISONSPRAYER -> singleAmmo GasAmmo
     FLAMETHROWER -> singleAmmo GasAmmo
     FLAMETORRENT -> singleAmmo GasAmmo

src/Dodge/Item/Attach.hs

@@ -1,14 +0,0 @@
-module Dodge.Item.Attach
-    (makeAttach
-    )
-    where
-
-import Dodge.Data.Item
-import Dodge.Default.Item
-import Control.Lens
-
-makeAttach :: AttachType -> Item
-makeAttach t = defaultHeldItem
-    & itType .~ ATTACH t
-    & itUse .~ UseAttach APNothing
-

src/Dodge/Item/BackgroundEffect.hs

@@ -2,6 +2,7 @@ module Dodge.Item.BackgroundEffect (
     itEffectOnPickup,
     itEffectOnDrop,
     rootNotrootEff,
+    rootAndAttNotEff,
     createShieldWall,
     removeShieldWall,
 ) where
@@ -36,6 +37,19 @@ rootNotrootEff f g it
     | it ^? itLocation . ilIsRoot == Just True = f it
     | otherwise = g it
 
+rootAndAttNotEff ::
+    (Item -> Creature -> World -> World) ->
+    (Item -> Creature -> World -> World) ->
+    Item ->
+    Creature ->
+    World ->
+    World
+rootAndAttNotEff f g it
+    | it ^? itLocation . ilIsRoot == Just True 
+        && it ^? itLocation . ilIsAttached == Just True
+        = f it
+    | otherwise = g it
+
 createShieldWall :: Item -> Creature -> World -> World
 createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
     Nothing ->

src/Dodge/Item/Craftable.hs

@@ -10,10 +10,7 @@ import Dodge.Data.Item
 import Dodge.Default.Item
 
 makeTypeCraftNum :: Int -> CraftType -> [Item]
-makeTypeCraftNum i ct =
-    replicate i $
-        defaultCraftItem
-            & itType .~ CRAFT ct
+makeTypeCraftNum i ct = replicate i $ defCraftItem & itType .~ CRAFT ct
 
 makeTypeCraft :: CraftType -> Item
 makeTypeCraft = head . makeTypeCraftNum 1

src/Dodge/Item/Draw/SPic.hs

@@ -321,9 +321,6 @@ shatterGunSPic =
     xa = 1
     xb = 9
 
-baseCaneShape :: Shape
-baseCaneShape = colorSH red $ xCylinderST 3 15
-
 baseRifleShape :: Shape
 baseRifleShape = colorSH red $ xCylinderST 3 25
 
@@ -368,18 +365,22 @@ volleyGunShape i =
 
 -- to get this rotating should probably add extra state to the minigun
 miniGunXPictItem :: Int -> Item -> SPic
-miniGunXPictItem i it = miniGunXPict i (_wTime (_itParams it) - 10)
-
-miniGunXPict :: Int -> Int -> SPic
-miniGunXPict i spin =
-    noPic
-        ( colorSH red (rotateSHx a barrels)
-            <> baseRifleShape
-        )
+miniGunXPictItem i it = miniGunXPict i (f $ _wTime (_itParams it))
   where
-    aBarrel = translateSH (V3 15 2 2) baseCaneShape
+    f x = y * (y + z) / (100 +z)
+      where
+        z = 0 -- increase to adjust acceleration
+        y = fromIntegral x
+
+miniGunXPict :: Int -> Float -> SPic
+miniGunXPict i spin =
+    noPic .
+        colorSH red $ rotateSHx a barrels
+            <> xCylinderST 3 40
+  where
+    aBarrel = translateSH (V3 15 4 2.5) $ xCylinderST 2 25
     barrels = foldMap (\an -> aBarrel & rotateSHx (2 * pi * fromIntegral an / fromIntegral i)) [1 .. i]
-    a = fromIntegral spin / 100
+    a = 2 * pi * spin / 25
 
 --x = fromIntegral am / 10
 --    clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4)

src/Dodge/Item/Equipment.hs

@@ -18,74 +18,58 @@ module Dodge.Item.Equipment (
 ) where
 
 import Dodge.Data.Equipment.Misc
---import Dodge.Item.Weapon.Bullet
 import Dodge.Data.Item
 import Dodge.Data.Magnet
 import Dodge.Default
 import LensHelp
 
 magShield :: MagnetBuBu -> Item
-magShield mt =
-    defaultEquipment
-        --        & itUse . uequipEffect . eeUse .~ EMagShield MagnetRepulse
-        & itType .~ EQUIP (MAGSHIELD mt)
+magShield mt = defEquipment & itType .~ EQUIP (MAGSHIELD mt)
 
 flameShield :: Item
-flameShield =
-    defaultEquipment
-        & itType .~ EQUIP FLAMESHIELD
+flameShield = defEquipment & itType .~ EQUIP FLAMESHIELD
 
 frontArmour :: Item
-frontArmour =
-    defaultEquipment
-        & itType .~ EQUIP FRONTARMOUR
+frontArmour = defEquipment & itType .~ EQUIP FRONTARMOUR
 
 wristArmour :: Item
-wristArmour = defaultEquipment & itType .~ EQUIP WRISTARMOUR
+wristArmour = defEquipment & itType .~ EQUIP WRISTARMOUR
 
 batteryPack :: Item
 batteryPack =
-    defaultEquipment
-        & itConsumables
-            ?~ 10000000
+    defEquipment
+        & itConsumables ?~ 10000000
         & itType .~ EQUIP BATTERYPACK
 
 fuelPack :: Item
 fuelPack =
-    defaultEquipment
-        --        & itUse . uequipEffect . eeUse .~ EFuelSource 10000 10000
+    defEquipment
         & itType .~ EQUIP FUELPACK
-        & itConsumables
-            ?~ 100000
+        & itConsumables ?~ 100000
 
 bulletBeltPack :: Item
 bulletBeltPack =
-    defaultEquipment
+    defEquipment
         & itConsumables ?~ 10000000
         & itType .~ EQUIP BULLETBELTPACK
 
 bulletBeltBracer :: Item
 bulletBeltBracer =
-    defaultEquipment
+    defEquipment
         & itConsumables ?~ 100000
         & itType .~ EQUIP BULLETBELTBRACER
 
 brainHat :: Item
-brainHat = defaultEquipment & itType .~ EQUIP BRAINHAT
+brainHat = defEquipment & itType .~ EQUIP BRAINHAT
 
 hat :: Item
-hat = defaultEquipment & itType .~ EQUIP HAT
+hat = defEquipment & itType .~ EQUIP HAT
 
 headLamp :: Item
-headLamp =
-    defaultEquipment
-        --        & itUse . uequipEffect . eeUse .~ EHeadLamp
-        & itType .~ EQUIP HEADLAMP
+headLamp = defEquipment & itType .~ EQUIP HEADLAMP
 
 powerLegs :: Item
-powerLegs =
-    defaultEquipment
-        & itType .~ EQUIP POWERLEGS
+powerLegs = defEquipment & itType .~ EQUIP POWERLEGS
 
 speedLegs :: Item
 speedLegs = powerLegs & itType .~ EQUIP SPEEDLEGS
@@ -95,10 +79,7 @@ jumpLegs = powerLegs & itType .~ EQUIP JUMPLEGS
 
 wristInvisibility :: Item
 wristInvisibility =
-    defaultEquipment
-        --        & itUse . uequipEffect . eeOnEquip .~ ECamouflage Invisible
-        --        & itUse . uequipEffect . eeOnRemove .~ ECamouflage FullyVisible
-        & itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
+    defEquipment & itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
 
 pulseChecker :: Item
-pulseChecker = defaultEquipment & itType .~ EQUIP WRIST_ECG
+pulseChecker = defEquipment & itType .~ EQUIP WRIST_ECG

src/Dodge/Item/Grammar.hs

@@ -197,11 +197,12 @@ rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2)
 leftRightCombine :: DTComb a -> DTComb a -> DTree a -> DTree a -> Maybe (DTree a)
 leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
   where
-    checkdepth t t'@(DT x ls rs) = fromMaybe (checktop t t') $ do
+    --checkdepth t t'@(DT x ls rs) = fromMaybe (checktop t t') $ do
+    checkdepth t t'@(DT x ls rs) = fromMaybe (f' t t') $ do
         t'' <- safeHead ls
         tx <- checkdepth t t''
         return $ Just $ DT x (tx : tail ls) rs
-    checktop t t' = f' t t'
+    --checktop t t' = f' t t'
 
 joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
 joinItemsInList f = fst . h . ([],)

src/Dodge/Item/Held/BatteryGuns.hs

@@ -18,7 +18,7 @@ sparkGun =
 
 teslaGun :: Item
 teslaGun =
-    defaultHeldItem
+    defHeldItem
         & itParams .~ teslaParams
         & itType .~ HELD TESLAGUN
 
@@ -33,14 +33,7 @@ teslaParams =
 -- previous phaseV parameters: 0.2, 1, 5
 laser :: Item
 laser =
-    defaultHeldItem
---        & itUse . heldParams .~ BeamShooterParams-- Nothing
---        & itAmmoSlots .~ singleAmmo ElectricalAmmo
---        & itUse . heldDelay .~ NoDelay
---        & itUse . heldMuzzles . ix 0 . mzPos .~ V2 6 0
---        & itUse . heldMuzzles . ix 0 . mzInaccuracy .~ 0
---        & itUse . heldMuzzles . ix 0 . mzFlareType .~ LasGunFlare
---        & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleLaser
+    defHeldItem
         & itTargeting
             .~ ItTargeting
                 { _itTgPos = Nothing
@@ -51,12 +44,4 @@ laser =
 
 -- previous attractionPower values: 1, -1, -10, 0
 tractorGun :: Item
-tractorGun =
-    defaultHeldItem
---        & itUse . heldParams .~ BeamShooterParams
---        & itAmmoSlots .~ singleAmmo ElectricalAmmo
---        & itUse . heldMuzzles . ix 0 . mzPos .~ V2 30 0
---        & itUse . heldMuzzles . ix 0 . mzInaccuracy .~ 0
---        & itUse . heldMuzzles . ix 0 . mzFlareType .~ NoFlare
---        & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleTractor
-        & itType .~ HELD TRACTORGUN
+tractorGun = defHeldItem & itType .~ HELD TRACTORGUN

src/Dodge/Item/Held/Cane.hs

@@ -13,11 +13,11 @@ import Dodge.Default
 import LensHelp
 
 volleyGun :: Int -> Item
-volleyGun i = defaultHeldItem & itType .~ HELD (VOLLEYGUN i)
+volleyGun i = defHeldItem & itType .~ HELD (VOLLEYGUN i)
     & itParams .~ VolleyUnfiredBarrels [0..i-1]
 
 rifle :: Item
-rifle = defaultHeldItem & itType .~ HELD RIFLE
+rifle = defHeldItem & itType .~ HELD RIFLE
 
 alteRifle :: Item
 alteRifle = rifle

src/Dodge/Item/Held/Cone.hs

@@ -9,7 +9,7 @@ import Dodge.Data.Item
 import Dodge.Default.Item
 
 bangCone :: Item
-bangCone = defaultHeldItem & itType .~ HELD BANGCONE
+bangCone = defHeldItem & itType .~ HELD BANGCONE
 
 blunderbuss :: Item
 blunderbuss = bangCone & itType .~ HELD BLUNDERBUSS

src/Dodge/Item/Held/Launcher.hs

@@ -13,7 +13,7 @@ import Dodge.Default.Item
 
 rLauncher :: Item
 rLauncher =
-    defaultHeldItem
+    defHeldItem
 --        & itUse . heldDelay . rateMax .~ 20
 --        & itUse . heldMuzzles . ix 0 . mzInaccuracy .~ 0
 --        & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleRLauncher

src/Dodge/Item/Held/Rod.hs

@@ -17,7 +17,7 @@ import LensHelp
 
 bangRod :: Item
 bangRod =
-    defaultHeldItem
+    defHeldItem
 --        & itUse . heldDelay . rateMax .~ 12
         & itType .~ HELD BANGROD
 --        & itUse . heldMuzzles . ix 0 . mzPos .~ V2 30 0

src/Dodge/Item/Held/SprayGuns.hs

@@ -63,7 +63,7 @@ flameWall =
 
 flameThrower :: Item
 flameThrower =
-    defaultHeldItem
+    defHeldItem
         & itType .~ HELD FLAMETHROWER
         & itParams .~ NozzleAngle 0
 --        & itUse . heldDelay .~ NoDelay

src/Dodge/Item/Held/Stick.hs

@@ -13,38 +13,10 @@ import Dodge.Default.Item
 import LensHelp
 
 bangStick :: Int -> Item
-bangStick i =
-    defaultHeldItem
---        & itUse . heldParams . recoil .~ 25
-        & itType .~ HELD (BANGSTICK i)
---        & itUse . heldDelay . rateMax .~ 8
---        & itUse . heldMuzzles
---            .~ [ Muzzle
---                (V2 10 0)
---                a
---                0.01
---                0
---                NoFlare
---                MuzzleShootBullet
---                (UseExactly 1)
---                0
---               | a <- spreadAroundCenter i baseStickSpread
---               ]
---        & itUse . heldMuzzles . ix 0 . mzFlareType .~ NoLightFlare
---        & itUse . heldMuzzles . ix (i `div` 2) . mzFlareType .~ MiniGunFlare
---        & itUse . heldMuzzles . ix (i-1) . mzFlareType .~ NoLightFlare
-
---baseStickSpread :: Float
---baseStickSpread = 0.2
+bangStick i = defHeldItem & itType .~ HELD (BANGSTICK i)
 
 pistol :: Item
-pistol =
-    bangStick 1
---        & itUse . heldDelay . rateMax .~ 6
---        & itUse . heldMuzzles . ix 0 . mzPos %~ const (V2 10 0)
---        & itUse . heldMuzzles . ix 0 . mzInaccuracy %~ const 0.05
---        & itUse . heldMuzzles . ix 0 . mzFlareType %~ const BasicFlare
-        & itType .~ HELD PISTOL
+pistol = bangStick 1 & itType .~ HELD PISTOL
 
 autoPistol :: Item
 autoPistol = pistol & itType .~ HELD AUTOPISTOL

src/Dodge/Item/Held/Utility.hs

@@ -15,20 +15,20 @@ import Dodge.Data.Item
 import Dodge.Default.Item
 
 flatShield :: Item
-flatShield = defaultHeldItem & itType .~ HELD FLATSHIELD
+flatShield = defHeldItem & itType .~ HELD FLATSHIELD
 
 keyCard :: Int -> Item
-keyCard n = defaultHeldItem & itType .~ HELD (KEYCARD n)
+keyCard n = defHeldItem & itType .~ HELD (KEYCARD n)
 
 led :: Item
-led = defaultHeldItem & itType .~ HELD LED
+led = defHeldItem & itType .~ HELD LED
 
 -- | Sends out pulses that display walls.
 detector :: Detector -> Item
-detector dt = defaultHeldItem & itType .~ DETECTOR dt
+detector dt = defHeldItem & itType .~ DETECTOR dt
 
 blinker :: Item
-blinker = defaultHeldItem & itType .~ HELD BLINKER
+blinker = defHeldItem & itType .~ HELD BLINKER
 
 unsafeBlinker :: Item
 unsafeBlinker = blinker & itType .~ HELD BLINKERUNSAFE

src/Dodge/Item/Held/Weapons.hs

@@ -6,9 +6,7 @@ import Control.Lens
 --import Linear.V2
 
 shatterGun :: Item
-shatterGun =
-    defaultHeldItem
-        & itType .~ HELD SHATTERGUN
+shatterGun = defHeldItem & itType .~ HELD SHATTERGUN
 --        & itUse . heldDelay . rateMax .~ 10
 --        & itAmmoSlots .~ singleAmmo ElectricalAmmo
 --        & itUse . heldMuzzles . ix 0 . mzPos .~ V2 30 0

src/Dodge/Item/HeldOffset.hs

@@ -7,6 +7,7 @@ module Dodge.Item.HeldOffset (
     handHandleOrient,
 ) where
 
+import Dodge.Creature.HandPos
 import Dodge.Data.AimStance
 import Dodge.Data.ComposedItem
 import Dodge.Data.Creature
@@ -43,16 +44,10 @@ handOrient cr = case cr ^. crStance . posture of
         OneHand -> (V3 13 (-2) shoulderHeight, Q.qID)
         TwoHandFlat -> (V3 13 0 shoulderHeight, Q.qID)
     AtEase -> \case
-        OneHand -> (V3 (10 + walkhandp) (-7) 15, Q.qID)
+        OneHand -> rightHandPQ cr
         TwoHandFlat -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) $ twoFlatHRot cr)
         TwoHandUnder -> (V3 7 (-8) 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
         TwoHandOver -> (V3 10 0 15, Q.axisAngle (V3 0 0 1) (strideRot cr + 1.2))
-  where
-    walkhandp = case cr ^? crStance . carriage of
-        Just (Walking x LeftForward) -> f x * 50 -2
-        _ -> - 2
-    f i = 0.1 * (sLen - i) / sLen
-    sLen = _strideLength $ _crStance cr
 
 locOrient :: LocationDT OItem -> Creature -> Point3Q
 locOrient loc cr =

src/Dodge/Item/Orientation.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Item.Orientation (
     orientAttachment,
     propagateOrientation,
@@ -34,6 +35,9 @@ orientChild itm = case _itType itm of
 orientByParentChSF :: Item -> ItemSF -> Point3Q
 orientByParentChSF itm lt = case (_itType itm, lt) of
     (HELD FLAMETHROWER, AmmoMagSF{}) -> (V3 4 (-6) 0, Q.qID)
+    (HELD (VOLLEYGUN n), AmmoMagSF i _) 
+        -> (V3 2 (2.5 + fromIntegral i * 5 - (0.5 * 5 * fromIntegral n)) 3, Q.qz (pi/2))
+    (HELD ALTERIFLE, AmmoMagSF i _) -> alteRifleAmmoOrient itm i
     (HELD _, AmmoMagSF{_amsfType = ElectricalAmmo}) -> (V3 0 0 z, Q.qID)
     (HELD _, AmmoMagSF{}) -> (V3 7 (itemShapeMin _y itm) 0, Q.qID)
     (HELD _, WeaponScopeSF) -> (V3 5 0 5, Q.qID)
@@ -44,6 +48,14 @@ orientByParentChSF itm lt = case (_itType itm, lt) of
     y = itemShapeMaxY itm
     z = itemShapeMaxZ itm
 
+alteRifleAmmoOrient :: Item -> Int -> Point3Q
+alteRifleAmmoOrient itm = \case
+    1 -> (V3 18 (itemShapeMin _y itm + s + 1) 0, Q.qID)
+    _ -> (V3 18 (itemShapeMax _y itm + s - 1) 0, Q.qz pi)
+  where
+    s | itm ^? itParams . alteRifleSwitch == Just 0 = 1
+      | otherwise = -1
+
 itemShapeMaxX :: Item -> Float
 itemShapeMaxX = itemShapeMax _1
 

src/Dodge/Item/Scope.hs

@@ -25,139 +25,162 @@ module Dodge.Item.Scope (
     bingate,
 ) where
 
-import Dodge.Item.Attach
 import Control.Lens
 import Dodge.Data.Item
 import Dodge.Default.Item
 
 zoomScope :: Item
-zoomScope = defaultHeldItem
+zoomScope =
+    defHeldItem
         & itType .~ ATTACH ZOOMSCOPE
         & itUse .~ UseScope OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}
 
 targetingScope :: TargetingType -> Item
-targetingScope tt = defaultHeldItem
+targetingScope tt =
+    defHeldItem
         & itType .~ TARGETING tt
         & itUse .~ UseNothing
-        & itTargeting .~ ItTargeting 
+        & itTargeting
+            .~ ItTargeting
                 { _itTgPos = Nothing
                 , _itTgID = Nothing
                 , _itTgActive = False
                 }
 
 homingModule :: Item
-homingModule = makeAttach HOMINGMODULE
+homingModule =
+    defHeldItem
+        & itType .~ ATTACH HOMINGMODULE
+        & itUse .~ UseAttach APNothing
 
 stickyMod :: Item
 stickyMod =
-    defaultHeldItem
+    defHeldItem
         & itType .~ STICKYMOD
         & itUse .~ UseNothing
 
 introScan :: IntroScanType -> Item
 introScan t =
-    defaultHeldItem
+    defHeldItem
         & itType .~ INTROSCAN t
         & itUse .~ UseNothing
 
 itemScan :: Item
 itemScan =
-    defaultHeldItem
+    defHeldItem
         & itType .~ ITEMSCAN
         & itUse .~ UseNothing
+
 --        & itEffect . ieOnDrop .~ ItemCancelExamineInventory
 
 mapper :: Item
 mapper =
-    defaultHeldItem
+    defHeldItem
         & itType .~ MAPPER
         & itUse .~ UseMapper mempty mempty
 
 dropper :: InventoryPathing -> Item
 dropper x =
-    defaultHeldItem
+    defHeldItem
         & itType .~ DROPPER x
         & itUse .~ UseInt 0
 
 clicker :: InventoryPathing -> Item
 clicker x =
-    defaultHeldItem
+    defHeldItem
         & itType .~ CLICKER x
         & itUse .~ UseInt 0
 
 copier :: InventoryPathing -> Item
 copier x =
-    defaultHeldItem
+    defHeldItem
         & itType .~ COPIER x
         & itUse .~ UseValue (Left 0)
         & itScroll .~ ItemScrollInt 0
 
 nulgate :: Item
 nulgate =
-    defaultHeldItem
+    defHeldItem
         & itType .~ NULGATE
         & itUse .~ UseNothing
         & itScroll .~ ItemScrollIntRange 2 0
 
 unigate :: Item
 unigate =
-    defaultHeldItem
+    defHeldItem
         & itType .~ UNIGATE
         & itUse .~ UseNothing
         & itScroll .~ ItemScrollIntRange 4 0
 
 bingate :: Item
 bingate =
-    defaultHeldItem
+    defHeldItem
         & itType .~ BINGATE
         & itUse .~ UseNothing
         & itScroll .~ ItemScrollIntRange 16 0
 
-
 bulletModule :: BulletMod -> Item
 bulletModule bm =
-    defaultHeldItem
+    defHeldItem
         & itType .~ BULLETMOD bm
-        & itUse .~ UseBulletMod {_ubMod = bm}
+        & itUse .~ UseBulletMod{_ubMod = bm}
 
 shellModule :: Payload -> Item
-shellModule p = defaultHeldItem
+shellModule p =
+    defHeldItem
         & itType .~ ATTACH (SHELLPAYLOAD p)
         & itUse .~ UseNothing
 
---bulletTargetingModule :: BulletTrajectoryType -> Item
---bulletTargetingModule = bulletModule . BulletModTrajectory
+-- bulletTargetingModule :: BulletTrajectoryType -> Item
+-- bulletTargetingModule = bulletModule . BulletModTrajectory
 
 bulletPayloadModule :: BulletPayload -> Item
 bulletPayloadModule = bulletModule . BulletModPayload
 
 arHUD :: Item
-arHUD = defaultHeldItem
+arHUD =
+    defHeldItem
         & itType .~ ARHUD
         & itUse .~ UseNothing
 
 remoteScreen :: Item
-remoteScreen = makeAttach REMOTESCREEN
---    & itUse . uaParams .~ APLinkProjectile Nothing 
-    & itUse . uaParams .~ APProjectiles [] 
+remoteScreen =
+    defHeldItem
+        & itType .~ ATTACH REMOTESCREEN
+        & itUse .~ UseAttach (APProjectiles [])
 
 remoteDetonator :: Item
-remoteDetonator = makeAttach REMOTEDETONATOR
---    & itUse .~ UseHammer HammerUp
-    & itUse . uaParams .~ APProjectiles [] 
+remoteDetonator =
+    defHeldItem
+        & itType .~ ATTACH REMOTEDETONATOR
+        & itUse .~ UseAttach (APProjectiles [])
 
 joystick :: Item
-joystick = makeAttach JOYSTICK
---    & itUse . uaParams .~ APLinkProjectile Nothing 
+joystick =
+    defHeldItem
+        & itType .~ ATTACH JOYSTICK
+        & itUse .~ UseNothing
 
 gimbal :: Item
-gimbal = makeAttach GIMBAL
+gimbal =
+    defHeldItem
+        & itType .~ ATTACH GIMBAL
+        & itUse .~ UseNothing
 
 gyroscope :: Item
-gyroscope = makeAttach GYROSCOPE
+gyroscope =
+    defHeldItem
+        & itType .~ ATTACH GYROSCOPE
+        & itUse .~ UseNothing
 
 underBarrelSlot :: Item
-underBarrelSlot = makeAttach UNDERBARRELSLOT
+underBarrelSlot =
+    defHeldItem
+        & itType .~ ATTACH UNDERBARRELSLOT
+        & itUse .~ UseNothing
 
 smokeReducer :: Item
-smokeReducer = makeAttach SMOKEREDUCER
+smokeReducer =
+    defHeldItem
+        & itType .~ ATTACH SMOKEREDUCER
+        & itUse .~ UseNothing

src/Dodge/Layout/Generate.hs

@@ -4,7 +4,8 @@ Random generation of high level layout of rooms.
 module Dodge.Layout.Generate
     where
 import Data.Tree
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 --import System.Random
 
 generateLayout :: State g (Tree RoomProperties)

src/Dodge/LevelGen.hs

@@ -1,7 +1,8 @@
 module Dodge.LevelGen (generateWorldFromSeed) where
 
 import Control.Lens
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 import Data.Foldable
 import Data.Preload.Render
 import Dodge.Data.GenWorld

src/Dodge/ListDisplayParams.hs

@@ -1,8 +1,8 @@
 module Dodge.ListDisplayParams (
     invDP,
---    secDP,
     invCursorParams,
     secondColumnLDP,
+    terminalLDP,
     subInvX,
     menuLDP,
 ) where
@@ -16,9 +16,9 @@ import Dodge.Data.World
 import Linear
 import SDL (MouseButton (..))
 
-defaultListDisplayParams :: ListDisplayParams
-defaultListDisplayParams =
-    ListDisplayParams
+defaultLDP :: LDParams
+defaultLDP =
+    LDP
         { _ldpVerticalGap = 0
         , _ldpScale = 1
         , _ldpPos =
@@ -26,24 +26,27 @@ defaultListDisplayParams =
                 { _spScreenOff = V2 (-0.5) 0.5 -- top left
                 , _spPixelOff = 0
                 }
+        , _ldpBorder = Nothing
         }
 
-invDP :: ListDisplayParams
-invDP =
-    defaultListDisplayParams
---        & ldpPos . spPixelOff .~ V2 6 (-1)
-        & ldpPos . spPixelOff .~ V2 6 0
+invDP :: LDParams
+invDP = defaultLDP & ldpPos . spPixelOff .~ V2 16 (-20)
 
 invCursorParams :: World -> CursorDisplay
-invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
---    Just ExamineInventory{} -> [North, South, East, West]
+invCursorParams w = BoundCurs $ case w ^? hud . subInventory of
+    --    Just ExamineInventory{} -> [North, South, East, West]
     Just CombineInventory{} -> []
-    _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
+    _
+        | ButtonRight `M.member` _mouseButtons (_input w)
+            && null (w ^? rbState . opSel) ->
+            [North, South, East, West]
     _ -> [North, South, West]
 
-secondColumnLDP :: ListDisplayParams
---secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX (-20)
-secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX 0
+secondColumnLDP :: LDParams
+secondColumnLDP = defaultLDP & ldpPos . spPixelOff .~ V2 subInvX (-20)
+
+terminalLDP :: LDParams
+terminalLDP = secondColumnLDP & ldpBorder ?~ (49, 16)
 
 subInvX :: Float
 subInvX = 10 * fromIntegral topInvW + 170
@@ -51,9 +54,5 @@ subInvX = 10 * fromIntegral topInvW + 170
 topInvW :: Int
 topInvW = 15
 
-menuLDP :: ListDisplayParams
-menuLDP =
-    defaultListDisplayParams
-        & ldpPos . spPixelOff .~ V2 11 (-70)
-        & ldpScale .~ 2
-        & ldpVerticalGap .~ 0
+menuLDP :: LDParams
+menuLDP = defaultLDP & ldpPos . spPixelOff .~ V2 11 (-70) & ldpScale .~ 2

src/Dodge/Machine.hs

@@ -1,56 +0,0 @@
-module Dodge.Machine where
-
-import Linear
-import Dodge.Base
-import Dodge.Data.World
-import Dodge.Machine.Damage
-import Dodge.SoundLogic
-import Dodge.Wall.Delete
-import Geometry
-import qualified IntMapHelp as IM
-import LensHelp
-import Sound.Data
-
-basicMachineUpdate :: (Machine -> World -> World) -> Machine -> World -> World
-basicMachineUpdate f mc = basicMachineApplyDamage mc . f mc
-
-machineUpdateLiveDieEff ::
-    -- | effect when hp >= 1
-    (Machine -> World -> World) ->
-    -- | effect (once) when hp < 1
-    (Machine -> World -> World) ->
-    Machine ->
-    World ->
-    World
-machineUpdateLiveDieEff livef dief mc
-    | _mcHP mc < 1 =
-        dief mc
-            . (cWorld . lWorld . machines %~ IM.delete mcid)
-            . deleteWallIDs (_mcWallIDs mc)
-    | otherwise = livef mc . (cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams)))
-  where
-    dams = sum $ map _dmAmount $ _mcDamage mc
-    mcid = _mcID mc
-
-machineUpdateDeathEff ::
-    (Machine -> World -> World) ->
-    Machine ->
-    World ->
-    World
-machineUpdateDeathEff f mc
-    | _mcHP mc < 1 =
-        f mc
-            . (cWorld . lWorld . machines %~ IM.delete mcid)
-            . deleteWallIDs (_mcWallIDs mc)
-    | otherwise = cWorld . lWorld . machines . ix mcid %~ ((mcDamage .~ []) . (mcHP -~ dams))
-  where
-    dams = sum $ map _dmAmount $ _mcDamage mc
-    mcid = _mcID mc
-
-machineAddSound :: SoundID -> (Machine -> World -> World) -> Machine -> World -> World
-machineAddSound sid f mc w
-    | d < 200 = soundContinueVol (1 -0.005 * d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w
-    | otherwise = f mc w
-  where
-    d = dist (you w ^. crPos . _xy) (_mcPos mc)
-    mid = _mcID mc

src/Dodge/Machine/Destroy.hs

@@ -24,6 +24,7 @@ destroyMcType mt mc w = case mt of
     McTurret tu -> fromMaybe w $ do
         itm <- w ^? cWorld . lWorld . items . ix (tu ^. tuWeapon)
         return $ copyItemToFloor (_mcPos mc) itm w
+    McTrigger i -> w & cWorld . lWorld . triggers . ix i %~ not
     _ -> w
 
 mcKillTerm :: Machine -> World -> World

src/Dodge/Machine/Draw.hs

@@ -1,6 +1,5 @@
 module Dodge.Machine.Draw (drawMachine) where
 
-import Dodge.Room.Foreground
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -8,6 +7,7 @@ import Dodge.Data.CWorld
 import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import Dodge.Placement.TopDecoration
+import Dodge.Room.Foreground
 import Dodge.Terminal.Color
 import Geometry
 import Picture
@@ -20,16 +20,18 @@ drawMachine cw mc = case _mcType mc of
     McTerminal -> terminalSPic lw mc
     McTurret tu -> drawBaseMachine 20 mc <> drawTurret lw tu mc
     McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor gp se
-    McProxSensor {} -> drawBaseMachine 25 mc
-    McStorage {} -> noPic $ colorSH (mcColor mc) storageShape
-    McDistributer {} -> drawBaseMachine 25 mc
+    McProxSensor{} -> drawBaseMachine 25 mc
+    McStorage{} -> noPic $ colorSH (mcColor mc) storageShape
+    McDistributer{} -> drawBaseMachine 25 mc
+    McTrigger{} -> drawBaseMachine 25 mc
   where
     lw = cw ^. lWorld
     gp = cw ^. cwGen . cwgParams . sensorCoding
 
 storageShape :: Shape
-storageShape = upperBox Large Typical 31 (polyCirc 4 20) <>
-    foldMap toprail (take 8 [0, pi / 4 ..])
+storageShape =
+    upperBox Large Typical 31 (polyCirc 4 20)
+        <> foldMap toprail (take 8 [0, pi / 4 ..])
   where
     toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi / 4) $ V2 0 20)
 
@@ -82,12 +84,12 @@ mcColor :: Machine -> Color
 mcColor mc = case mc ^. mcType of
     McStatic -> blue
     McTerminal -> dark magenta
-    McDamSensor {} -> yellow
-    McProxSensor {} -> aquamarine
-    McTurret {} -> blue
-    McStorage {} -> orange
-    McDistributer {} -> red
-    
+    McDamSensor{} -> yellow
+    McProxSensor{} -> aquamarine
+    McTurret{} -> blue
+    McStorage{} -> orange
+    McDistributer{} -> green
+    McTrigger{} -> red
 
 drawTurret :: LWorld -> Turret -> Machine -> SPic
 drawTurret lw tu mc = fold $ do

src/Dodge/Machine/Update.hs

@@ -2,8 +2,9 @@
 
 module Dodge.Machine.Update (updateMachine) where
 
-import Linear
 import Control.Monad
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
 import Data.List (partition)
 import Data.Maybe
 import Dodge.Base.Collide
@@ -18,8 +19,8 @@ import Dodge.Terminal
 import Dodge.Terminal.Color
 import Geometry
 import LensHelp
-import qualified Data.IntMap.Strict as IM
-import qualified Data.IntSet as IS
+import Linear
+import Sound.Data
 
 updateMachine :: Machine -> World -> World
 updateMachine mc
@@ -36,8 +37,9 @@ mcTypeUpdate mc = \case
     McTurret tu -> updateTurret (_tuTurnSpeed tu) mc
     McDamSensor se -> mcDamSensorTriggerUpdate se mc . mcDamSensorUpdate se mc
     McProxSensor se -> mcProxSensorTriggerUpdate se mc . mcProxSensorUpdate se mc
-    McStorage {} -> id
-    McDistributer {} -> id
+    McStorage{} -> id
+    McDistributer{} -> id
+    McTrigger{} -> id
 
 terminalScreenGlow :: Machine -> World -> World
 terminalScreenGlow mc w = fromMaybe w $ do
@@ -45,7 +47,10 @@ terminalScreenGlow mc w = fromMaybe w $ do
     term <- w ^? cWorld . lWorld . terminals . ix tid
     V4 x y z _ <- termScreenColor term
     return $
-        w & cWorld . lWorld . lights
+        w
+            & cWorld
+            . lWorld
+            . lights
             .:~ LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
 
 updateTurret :: Float -> Machine -> World -> World
@@ -56,7 +61,10 @@ updateTurret rotSpeed mc w =
         & elecDamBranch
   where
     dodamage =
-        cWorld . lWorld . machines . ix mcid
+        cWorld
+            . lWorld
+            . machines
+            . ix mcid
             %~ ( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10))])
                     . (mcHP -~ dam)
                )
@@ -72,7 +80,13 @@ updateTurret rotSpeed mc w =
     elecDam = sum $ map _dmAmount elecDams
     doTurn
         | seesYou =
-            cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuDir
+            cWorld
+                . lWorld
+                . machines
+                . ix mcid
+                . mcType
+                . _McTurret
+                . tuDir
                 %~ turnTo rotSpeed mcpos ypos
         | otherwise = id
     closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
@@ -80,7 +94,13 @@ updateTurret rotSpeed mc w =
         | closeFireAngle =
             cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
         | otherwise =
-            cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime
+            cWorld
+                . lWorld
+                . machines
+                . ix mcid
+                . mcType
+                . _McTurret
+                . tuFireTime
                 %~ (max 0 . subtract 1)
 
 isElectrical :: Damage -> Bool
@@ -100,7 +120,7 @@ mcUseItem mc w = fromMaybe w $ do
 mcDamSensorTriggerUpdate :: DamageSensor -> Machine -> World -> World
 mcDamSensorTriggerUpdate se mc = fromMaybe id $ do
     trid <- mc ^? mcMounts . ix OTTrigger
-    bval <- mcTriggerVal se
+    let bval = se ^. sensAmount > damageTypeThreshold (se ^. sensType)
     return $ cWorld . lWorld . triggers . ix trid ||~ bval
 
 mcProxSensorTriggerUpdate :: ProximitySensor -> Machine -> World -> World
@@ -109,25 +129,41 @@ mcProxSensorTriggerUpdate se mc = fromMaybe id $ do
     bval <- se ^? proxToggle . _Just
     return $ cWorld . lWorld . triggers . at trid ?~ bval
 
-mcTriggerVal :: DamageSensor -> Maybe Bool
-mcTriggerVal se = Just $ _sensAmount se > _sensThreshold se
+damageTypeThreshold :: SensorType -> Int
+damageTypeThreshold = \case
+    LaserSensor -> 1000
+    ElectricSensor -> 500
+    ThermalSensor -> 1000
+    PhysicalSensor -> 1000
+
 
 mcPlaySound :: Machine -> World -> World
-mcPlaySound mc w = case _mcType mc of
-    McTerminal
-        | d < 100 ->
+mcPlaySound mc w = fromMaybe w $ do
+    guard $ d < 100
+    (sid,x) <- mcBackgroundSound mc
+    return $
         soundContinueVol
-                (1 -0.01 * d)
-                (MachineSound mid)
+            (x * (1 - 0.01 * d))
+            (MachineBackgroundSound mid)
             (_mcPos mc)
-                fridgeHumS
+            sid
             (Just 2)
             w
-    _ -> w
   where
-    d = max 0 (dist ( you w ^. crPos . _xy) (_mcPos mc) - 100)
+    d = max 0 (dist (you w ^. crPos . _xy) (_mcPos mc) - 100)
     mid = _mcID mc
 
+mcBackgroundSound :: Machine -> Maybe (SoundID,Float)
+mcBackgroundSound mc = case mc ^. mcType of
+    McStatic -> Nothing
+    McTerminal -> Just (fridgeHumS,1)
+    McTurret{} -> Just (fridgeHumS,1)
+    McDamSensor{} -> Just (fridgeHumS,1)
+    McProxSensor{} -> Just (throbC4S,0.5)
+    McStorage{} -> Nothing
+    McDistributer{} -> Just (lowWhirS,1)
+    McTrigger{} -> Just (throb1S,0.5)
+
 mcApplyDamage :: [Damage] -> Machine -> World -> World
 mcApplyDamage ds mc = case mc ^? mcType . _McDamSensor of
     Nothing -> mcpointer %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
@@ -136,7 +172,7 @@ mcApplyDamage ds mc = case mc ^? mcType . _McDamSensor of
     mcpointer = cWorld . lWorld . machines . ix (_mcID mc)
 
 mcDamSensorUpdate :: DamageSensor -> Machine -> World -> World
-mcDamSensorUpdate se = senseDamage (_sensThreshold se) (_sensType se)
+mcDamSensorUpdate se = senseDamage (damageTypeThreshold (se ^. sensType)) (se ^. sensType)
 
 mcProxSensorUpdate :: ProximitySensor -> Machine -> World -> World
 mcProxSensorUpdate se mc = case se ^. proxSensorType of
@@ -146,13 +182,23 @@ mcProxSensorUpdate se mc = case se ^. proxSensorType of
 mcNoItemsTest :: Machine -> [Point2] -> World -> World
 mcNoItemsTest mc ps w
     | t && (falsetog || notog) =
-        w & mcsenslens . proxToggle ?~ True
+        w
+            & mcsenslens
+            . proxToggle
+            ?~ True
             & playsound dedaS
-            & mctermlens . tmFutureLines .:~ makeTermLine "SENSOR SUCCESS: ZONE CLEAR"
+            & mctermlens
+            . tmFutureLines
+            .:~ makeTermLine "SENSOR SUCCESS: ZONE CLEAR"
     | not t && (truetog || notog) =
-        w & mcsenslens . proxToggle ?~ False
+        w
+            & mcsenslens
+            . proxToggle
+            ?~ False
             & playsound dedumS
-            & mctermlens . tmFutureLines .:~ makeTermLine "SENSOR FAIL: ITEM IN ZONE"
+            & mctermlens
+            . tmFutureLines
+            .:~ makeTermLine "SENSOR FAIL: ITEM IN ZONE"
     | otherwise = w
   where
     truetog = mc ^? mcType . _McProxSensor . proxToggle . _Just == Just True
@@ -176,16 +222,23 @@ mcProximitySensorUpdate mc sens pr w
     | truetog || dist (ycr ^. crPos . _xy) (_mcPos mc) > 40 = w
     | mcProxTest w pr =
         w
-            & mcsenslens . proxToggle ?~ True
+            & mcsenslens
+            . proxToggle
+            ?~ True
             & playsound dedaS
-            & mctermlens . tmFutureLines
+            & mctermlens
+            . tmFutureLines
             <>~ [makeTermLine "SENSOR SUCCESS: DEACTIVATED"]
             <> tlSetStatus (TerminalPressTo "QUIT")
             <> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
     | notog =
-        w & playsound dedumS
-            & mcsenslens . proxToggle ?~ False
-            & mctermlens . tmFutureLines
+        w
+            & playsound dedumS
+            & mcsenslens
+            . proxToggle
+            ?~ False
+            & mctermlens
+            . tmFutureLines
             .:~ makeTermLine ("SENSOR FAIL: REQUIRES " ++ sensorReqToString pr)
     | otherwise = w
   where
@@ -207,9 +260,13 @@ mcProxTest w = \case
     RequireHealth x -> fromMaybe 0 (cr ^? crHP . _HP) >= x
     RequireEquipment ct ->
         any
-            (\itm -> _itType itm == ct)
-            ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
-    RequireDeadCreatures is -> all (\x -> null (x ^? crHP . _HP))
+            ( (\itm -> _itType itm == ct)
+                . (\k -> w ^?! cWorld . lWorld . items . ix k)
+            )
+            (_crInv cr)
+    RequireDeadCreatures is ->
+        all
+            (\x -> null (x ^? crHP . _HP))
             (IM.restrictKeys (w ^. cWorld . lWorld . creatures) (IS.fromList is))
   where
     cr = you w
@@ -219,8 +276,13 @@ senseDamage threshold dt mc =
     (cWorld . lWorld . machines . ix mcid %~ upmc)
         . updatels
   where
-    upmc = mcType . _McDamSensor . sensAmount 
-        %~ min (100 * threshold) . max 0 . (+ newsense)
+    upmc =
+        mcType
+            . _McDamSensor
+            . sensAmount
+            %~ min (100 * threshold)
+            . max 0
+            . (+ newsense)
     mcid = _mcID mc
     newsense
         | x > 0 = x

src/Dodge/Material/Damage.hs

@@ -36,7 +36,8 @@ damageStone dm ecw w = case dm of
         Piercing _ p t -> 
             f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
                 . makeDustAt Stone 200 (addZ 20 (outTo p t))
-                . randsound p [slapS, slap1S]
+--                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
+                . randsound p [slapS, slap1S, slap2S]
         Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
         Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
         Crushing{} -> f dmam  id
@@ -133,7 +134,8 @@ damageDirt dm _ w =
             makeDustAt Dirt 200 (addZ 20 (outTo p t))
         Piercing _ p t ->
             makeDustAt Dirt 200 (addZ 20 (outTo p t))
-                . randsound p [slapS, slap1S]
+                -- . randsound p [slapS, slap1S]
+                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
         Blunt _ p t -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
         Shattering _ p t -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
         Crushing{} -> id
@@ -153,7 +155,7 @@ damageDirt dm _ w =
 
 damageGlass :: Damage -> ECW -> World -> (Int,World)
 damageGlass dm ecw w = case dm of
-        Lasering {} -> f 0 $ id
+        Lasering {} -> f 0  id
         Piercing _ p t -> 
             f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
 --                . makeDustAt Stone 200 (addZ 20 (outTo p t))
@@ -219,7 +221,7 @@ damageGlass dm ecw w = case dm of
 
 damageCrystal :: Damage -> ECW -> World -> (Int,World)
 damageCrystal dm ecw w = case dm of
-        Lasering {} -> f $ id
+        Lasering {} -> f  id
         Piercing _ p t -> 
             f $ makeSpark NormalSpark (outTo p t) (rdir p t)
                  . randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]

src/Dodge/Material/Sound.hs

@@ -1,4 +1,4 @@
-module Dodge.Material.Sound where
+module Dodge.Material.Sound (destroyMatS) where
 
 import Dodge.Data.Material
 import Dodge.SoundLogic.ExternallyGeneratedSounds
@@ -16,14 +16,14 @@ destroyMatS mat = case mat of
     Flesh -> [gut1S, gut2S, gut3S, gut4S, gut5S, gut6S]
     ForceField -> []
 
-weakenMatS :: Material -> [SoundID]
-weakenMatS mat = case mat of
-    Glass -> [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
-    Crystal -> [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
-    Stone -> [stone1S, stone2S, stone3S, stone4S, stone5S]
-    Dirt -> [stone1S, stone3S]
-    Wood -> [stone1S, stone3S]
-    Metal -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S, metal7S]
-    Electronics -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S, metal7S]
-    Flesh -> [blood1S, blood2S, blood3S, blood4S, blood5S, blood6S, blood7S, blood8S]
-    ForceField -> []
+--weakenMatS :: Material -> [SoundID]
+--weakenMatS mat = case mat of
+--    Glass -> [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
+--    Crystal -> [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
+--    Stone -> [stone1S, stone2S, stone3S, stone4S, stone5S]
+--    Dirt -> [stone1S, stone3S]
+--    Wood -> [stone1S, stone3S]
+--    Metal -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S, metal7S]
+--    Electronics -> [metal1S, metal2S, metal3S, metal4S, metal5S, metal6S, metal7S]
+--    Flesh -> [blood1S, blood2S, blood3S, blood4S, blood5S, blood6S, blood7S, blood8S]
+--    ForceField -> []

src/Dodge/Menu.hs

@@ -8,9 +8,7 @@ import Control.Monad
 import qualified Data.Aeson.Encode.Pretty as AEP
 import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Maybe
-import qualified Data.Text.IO as TIO
 import Dodge.Base.Coordinate
-import Dodge.Combine.Graph
 import Dodge.Concurrent
 import Dodge.Config
 import Dodge.Data.Universe
@@ -149,7 +147,7 @@ logOptions =
 generateGraphs :: IO ()
 generateGraphs = do
     createDirectoryIfMissing True "generated/graph"
-    TIO.writeFile "generated/graph/itemCombinations.gv" combinationsDotGraph
+    print "Placeholder for graph generation activated"
 
 gameplayMenu :: Universe -> ScreenLayer
 gameplayMenu = titleOptionsMenu "OPTIONS:GAMEPLAY" gameplayMenuOptions
@@ -194,7 +192,7 @@ graphicsMenuOptions =
     , enumOption gr_shadows_on_clouds "SHADOW DETAIL ON CLOUDS" id
     , enumOption gr_shadow_size "SHADOW DETAIL" id
     , enumOption gr_distortions "ENABLE DISTORTIONS" id
-    , enumOption gr_bloom "ENABLE BLOOM" id
+--    , enumOption gr_bloom "ENABLE BLOOM" id
     , boolOption gr_cloud_shadows "CLOUD SHADOWS TOGGLE"
     , enumOption gr_num_shadow_casters "NUM SHADOW CASTERS" id
     ]

src/Dodge/Picture.hs

@@ -8,7 +8,7 @@ import Picture
 
 wedgeOfThickness :: Float -> Point2 -> Point2 -> Picture
 wedgeOfThickness t x y 
-    | x == y    = blank
+    | x == y    = mempty
     | otherwise = fold 
         [uncurryV translate x $ circleSolid (0.5*t)
         ,polygon [x +.+ n x y, x -.- n x y, y]

src/Dodge/Picture/SizeInvariant.hs

@@ -75,7 +75,7 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
     borderPoint = intersectSegPolyFirst campos p bords
     windowPoint = intersectSegPolyFirst campos p winps
     arrowPic = case borderPoint of
-        Nothing -> blank
+        Nothing -> mempty
         Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
     (V2 x y) = fromMaybe p borderPoint
     campos = w ^. wCam . camCenter

src/Dodge/Placement/Instance/Button.hs

@@ -62,11 +62,7 @@ triggerSwitch col ps = psPtCont ps (PutTrigger False) $
   where
     trigid tp = fromJust $ _plMID tp
 
-putLitButOnPos ::
-    Color ->
-    PlacementSpot ->
-    (Placement -> Maybe Placement) ->
-    Placement
+putLitButOnPos :: Color -> PlacementSpot -> (Placement -> Maybe Placement) -> Placement
 putLitButOnPos col theps subpl =
     plSpot .~ theps $
         mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $
@@ -77,20 +73,19 @@ putLitButOnPos col theps subpl =
                     <&> plSpot
                     .~ _plSpot plmnt
   where
-    changeLight lsid = SetLSCol (V3 0 0.5 0) lsid
+    changeLight = SetLSCol (V3 0 0.5 0)
     ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50
 
 -- creates a lit external trigger, passes the trigger placement forward
 extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement
 extTrigLitPos ps f = psPtCont ps (PutTrigger False) $
     \tp -> Just $
-        pContID (ps' tp) (PutLS thels) $
+        pContID (_plSpot tp) (PutLS thels) $
             \lsid ->
                 Just $
-                    pContID (ps' tp) (PutMod $ themod lsid tp) $
+                    pContID (_plSpot tp) (PutMod $ themod lsid tp) $
                         const (f tp)
   where
-    ps' tp = _plSpot tp
     themod lsid tp =
         ModIDID
             { _mdID = 0
@@ -126,6 +121,6 @@ putLitButOnPosExtTrig' col thePS cnt =
                             .~ _plSpot plmnt
   where
     trigid tp = fromJust $ _plMID tp
-    oneff tid = SetTrigger True tid
+    oneff = SetTrigger True
     changeLight = SetLSCol (V3 0 0.5 0)
     ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50

src/Dodge/Placement/Instance/Sensor.hs

@@ -12,34 +12,16 @@ import Geometry
 
 damageSensor :: SensorType -> Float -> Maybe Int -> PlacementSpot -> Placement
 damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
-    \lsid -> psPtJpl ps
-        $
+    \lsid ->
+        psPtJpl ps $
             PutMachine
                 (reverse $ square wdth)
                 ( defaultMachine
---                    & mcColor .~ yellow
                     & mcMounts . at OTTrigger .~ mtrid
                     & mcMounts . at OTLightSource ?~ lsid
-                    & mcType
-                        .~ McDamSensor
-                            ( DamSensor
-                                0
-                                dt
-                                (damageTypeThreshold dt)
-                            )
+                    & mcType .~ McDamSensor (DamSensor 0 dt)
                 )
                 Nothing
 
-damageTypeThreshold :: SensorType -> Int
-damageTypeThreshold dt = case dt of
-    LaserSensor -> 1000
-    ElectricSensor -> 500
-    ThermalSensor -> 1000
-    PhysicalSensor -> 1000
-
-lightSensor ::
-    Float ->
-    Maybe Int ->
-    PlacementSpot ->
-    Placement
+lightSensor :: Float -> Maybe Int -> PlacementSpot -> Placement
 lightSensor = damageSensor LaserSensor

src/Dodge/Placement/Instance/Terminal.hs

@@ -51,16 +51,11 @@ putTerminalFull f mc tm =
 putTerminal :: Machine -> Terminal -> Placement
 putTerminal = putTerminalFull (\_ _ _ -> Nothing)
 
+tmMachine :: Machine
+tmMachine = defaultMachine & mcType .~ McTerminal & mcHP .~ 100
+
 putMessageTerminal :: Terminal -> Placement
-putMessageTerminal =
-    putTerminal $
-        defaultMachine
-            & mcType .~ McTerminal
-            & mcHP .~ 100
+putMessageTerminal = putTerminal tmMachine
 
 putImmediateMessageTerminal :: Terminal -> Placement
-putImmediateMessageTerminal =
-    putTerminalImediateAccess $
-        defaultMachine
-            & mcType .~ McTerminal
-            & mcHP .~ 100
+putImmediateMessageTerminal = putTerminalImediateAccess tmMachine

src/Dodge/Placement/PlaceSpot.hs

@@ -6,7 +6,8 @@
 -}
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 import Data.Bifunctor
 import Data.Foldable
 import qualified Data.IntSet as IS
@@ -57,11 +58,10 @@ placePlainPSSpot w rid plmnt shift = case plmnt ^. plType of
     f x gw = fromMaybe gw $ do
         j <- x ^. plExternalID
         return $ gw & genPmnt . at j ?~ x
-    recrPlace newplmnt w' pl =
+    recrPlace newplmnt w' =
         placeSpot
             rid
             (w' & genRooms . ix rid . rmPmnts .:~ newplmnt)
-            pl
 
 -- this should be tidied up
 placeSpotUsingLink ::
@@ -142,7 +142,8 @@ placeSpotID rid ps pt w = case pt of
     PutNothing -> (0, w)
     PutID i -> (i, w)
     PutWorldUpdate f -> (0, w & f rid ps)
-    PutChasm ps' -> (0, placeChasm w rid ps' $ map doShift ps')
+    PutChasm ps' qs -> (0, placeChasm w rid ps' (map (map doShift) ps') 
+        (foldMap loopPairs (map (map doShift) qs)))
     PutLabel{} -> (0, w)
   where
     p@(V2 px py) = _psPos ps
@@ -151,13 +152,15 @@ placeSpotID rid ps pt w = case pt of
     doShift = shiftPointBy (p, rot)
     pashift = compP2A (p, rot)
 
-placeChasm :: GenWorld -> Int -> [Point2] -> [Point2] -> GenWorld
-placeChasm gw rid ps shiftps =
-    gw & gwWorld . cWorld . chasms .:~ shiftps
-        & genRooms . ix rid . rmPos %~ filter (\rp -> not $ pointInPoly (_rpPos rp) ps)
+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
   where
-    f w = foldl' g w (loopPairs shiftps)
+    --f w = foldl' g w (loopPairs shiftps)
+    f w = foldl' g w cfs
     g w (x, y) = obstructPathsCrossing (S.singleton ChasmObstacle) x y w
 
 placeWallPoly :: [Point2] -> Wall -> World -> World

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -87,8 +87,8 @@ plLineBlock basePane blwidth a b gw =
             $ upperBox Medium Typical 3
             [a + x + n - midp, a + x - (n + midp), b - (n + x + midp), b + n - (x + midp)]
             )
-    midp = (0.5 * (a + b))
-    x = (blwidth + 1) *^ (normalize $ a - b)
+    midp = 0.5 * (a + b)
+    x = (blwidth + 1) *^ normalize (a - b)
     n = vNormal x
     insertBlock (i, p) =
         insertWalls (makeWallAt p i)

src/Dodge/PlacementSpot.hs

@@ -14,6 +14,7 @@ module Dodge.PlacementSpot (
     isUnusedLnk,
     isInLnk,
     isOutLnk,
+    isOutLnkNum,
     unusedSpotNearInLink,
     randDirPS,
     unusedSpotAwayFromInLink,
@@ -38,7 +39,8 @@ module Dodge.PlacementSpot (
 ) where
 
 import Control.Lens
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 import Data.Bifunctor
 import Data.Maybe
 import qualified Data.Set as S
@@ -168,6 +170,11 @@ isOutLnk rp = case _rpType rp of
     UsedOutLink{} -> null $ _rpPlacementUse rp
     _ -> False
 
+isOutLnkNum :: Int -> RoomPos -> Bool
+isOutLnkNum i rp = case _rpType rp of
+    UsedOutLink{_rplsChildNum = j} | j == i -> null $ _rpPlacementUse rp
+    _ -> False
+
 useUnusedLnk :: PlacementSpot
 useUnusedLnk = rprBool isUnusedLnk
 

src/Dodge/Projectile/Update.hs

@@ -1,8 +1,7 @@
---{-# LANGUAGE LambdaCase #-}
---{-# OPTIONS_GHC -Wno-unused-imports #-}
+-- {-# LANGUAGE LambdaCase #-}
+-- {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update (updateProjectile) where
 
-import Dodge.WorldEvent.Cloud
 import Control.Monad
 import Data.List (delete)
 import Data.Maybe
@@ -14,7 +13,8 @@ import Dodge.Item.Location
 import Dodge.Movement.Turn
 import Dodge.Payload
 import Dodge.SoundLogic
---import Dodge.WorldEvent.Cloud
+import Dodge.WorldEvent.Cloud
+-- import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.Sound
 import Geometry
 import qualified IntMapHelp as IM
@@ -76,7 +76,10 @@ bounceSound pj = soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1
 
 stickHitSound :: Projectile -> World -> World
 stickHitSound pj =
-    soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
+    soundOriginIDsAt
+        (ShellSound (pj ^. pjID))
+        [slapS, slap1S, slap2S, slap3S, slap4S, slap5S, slap6S, slap7S]
+        (pj ^. pjPos . _xy)
 
 shellHitCreature :: Point3 -> Creature -> Projectile -> World -> World
 shellHitCreature p cr pj
@@ -89,7 +92,7 @@ shellHitCreature p cr pj
     gren =
         GStuckCreature
             (cr ^. crID)
-            (rotate3z (- cr ^. crDir) (p - cr ^. crPos))
+            (rotate3z (-cr ^. crDir) (p - cr ^. crPos))
             (pj ^. pjDir - cr ^. crDir)
 
 shellHitFloor :: Point3 -> Projectile -> World -> World
@@ -129,8 +132,15 @@ tryThrust pj = fromMaybe id $ do
 doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
 doThrust pj smoke w =
     w
-        & randGen .~ g
-        & cWorld . lWorld . projectiles . ix i . pjVel . _xy %~ (\v -> accel + frict *^ v)
+        & randGen
+        .~ g
+        & cWorld
+        . lWorld
+        . projectiles
+        . ix i
+        . pjVel
+        . _xy
+        %~ (\v -> accel + frict *^ v)
         & soundContinue (ShellSound i) (ep ^. _xy) missileLaunchS (Just 1)
         & makeFlamelet
             (sp - 0.5 *^ vel)
@@ -157,15 +167,28 @@ doThrust pj smoke w =
 
 doBarrelSpin :: Int -> Float -> Projectile -> World -> World
 doBarrelSpin cid i pj w =
-    w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
-        & cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
+    w
+        & cWorld
+        . lWorld
+        . projectiles
+        . ix pjid
+        . pjSpin
+        .~ newSpin
+        & cWorld
+        . lWorld
+        . projectiles
+        . ix pjid
+        . pjBarrelSpin
+        .~ Nothing
   where
     pjid = _pjID pj
     dir = argV $ pj ^. pjVel . _xy
     newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
         Just cr ->
             negate $
-                min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
+                min 0.2 $
+                    max (-0.2) $
+                        normalizeAnglePi (dir - _crDir cr) / spinFactor
         _ -> 0
     spinFactor = 5 * (6 - i)
 
@@ -176,13 +199,21 @@ pjRemoteSetDirection ph pj w = case ph of
         | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
             == lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
             w
-                & pjlens . pjDir .~ mousedir
-                & pjlens . pjSpin .~ 0.5 * diffAngles mousedir pjdir
+                & pjlens
+                . pjDir
+                .~ mousedir
+                & pjlens
+                . pjSpin
+                .~ 0.5
+                * diffAngles mousedir pjdir
     HomeUsingTargeting itid
         | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
             w
-                & pjlens . pjDir %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
-                & pjlens . pjSpin
+                & pjlens
+                . pjDir
+                %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
+                & pjlens
+                . pjSpin
                 .~ 0.5
                 * diffAngles
                     (turnTo 0.2 (pj ^. pjPos . _xy) tp pjdir)
@@ -201,9 +232,17 @@ moveStuckGrenade cid poff d pj w = fromMaybe (w & pjlens . pjType .~ Grenade GSt
         cdir = cr ^. crDir
     return $
         w
-            & pjlens . pjPos . _xy .~ xyV3 (cpos + rotate3z cdir poff)
-            & pjlens . pjDir .~ d + cdir
-            & pjlens . pjVel .~ (cpos - cr ^. crOldPos)
+            & pjlens
+            . pjPos
+            . _xy
+            .~ xyV3 (cpos + rotate3z cdir poff)
+            & pjlens
+            . pjDir
+            .~ d
+            + cdir
+                & pjlens
+                . pjVel
+                .~ (cpos - cr ^. crOldPos)
   where
     pjlens = cWorld . lWorld . projectiles . ix (pj ^. pjID)
 
@@ -219,9 +258,15 @@ moveProjectile pj w
         (_, Just (_, OChasmWall)) -> w & pjlens . pjTimer .~ 0 -- no stick or bounce for now
         _ ->
             w
-                & pjlens . pjSpin *~ 0.99
-                & pjlens . pjPos +~ _pjVel pj
-                & pjlens . pjDir +~ _pjSpin pj
+                & pjlens
+                . pjSpin
+                *~ 0.99
+                & pjlens
+                . pjPos
+                +~ _pjVel pj
+                & pjlens
+                . pjDir
+                +~ _pjSpin pj
   where
     pjlens = cWorld . lWorld . projectiles . ix (pj ^. pjID)
     sp = _pjPos pj
@@ -229,9 +274,15 @@ moveProjectile pj w
 explodeShell :: Projectile -> World -> World
 explodeShell pj w =
     w
-        & pjlens . pjType .~ RetiredProjectile
-        & pjlens . pjVel .~ 0
-        & pjlens . pjTimer .~ 30
+        & pjlens
+        . pjType
+        .~ RetiredProjectile
+        & pjlens
+        . pjVel
+        .~ 0
+        & pjlens
+        . pjTimer
+        .~ 30
         & usePayload (_pjPayload pj) (pj ^. pjPos) (pj ^. pjVel)
         & stopSoundFrom (ShellSound pjid)
         & updatedetonator

src/Dodge/RandImpulse.hs

@@ -1,6 +1,7 @@
 module Dodge.RandImpulse where
 
-import Control.Monad.State
+--import Control.Monad.State
+import Control.Monad.Trans.State.Lazy
 import Dodge.Data.ActionPlan
 import RandomHelp