Cleanup, split CWorld into separate file

appDodge/Main.hs

@@ -97,7 +97,7 @@ updateRenderSplit u = do
 
 playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
 playSoundUnlessRewinding u
-    | _timeFlow (_cWorld w) == RewindingNow = return M.empty
+    | _timeFlow w == RewindingNow = return M.empty
     | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
   where
     w = _uvWorld u

src/Dodge/Button/Event.hs

@@ -8,7 +8,7 @@ import Control.Lens
 doButtonEvent :: ButtonEvent -> Button -> World -> World
 doButtonEvent be = case be of
     ButtonDoNothing -> const id
-    ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f
+    ButtonPress newstate newevent thesound f -> \b -> doWdWd f
         . set (cWorld . buttons . ix (_btID b) . btState) newstate
         . set (cWorld . buttons . ix (_btID b) . btEvent) newevent
         . soundStart (LeverSound 0) (_btPos b) thesound Nothing
@@ -18,9 +18,9 @@ doButtonEvent be = case be of
 
 flipSwitch :: WdWd -> WdWd -> Button -> World -> World
 flipSwitch oneff offeff bt 
-    | _btState bt == BtOff = doWorldEffect oneff . dosound
+    | _btState bt == BtOff = doWdWd oneff . dosound
         . over (cWorld . buttons . ix (_btID bt)) turnon
-    | otherwise = doWorldEffect offeff . dosound
+    | otherwise = doWdWd offeff . dosound
         . over (cWorld . buttons . ix (_btID bt)) turnoff
   where
     turnon  = (btState .~ BtOn ) .  (btText .~ "SWITCH\\")

src/Dodge/Creature.hs

@@ -128,7 +128,6 @@ inventoryX c = case c of
         [ blinkGun
         , unsafeBlinkGun
         , autoDetector WALLDETECTOR
-        --        , effectGun "GIBBER" addCrGibs
         ]
     'E' ->
         [ makeTypeCraftNum 3 PIPE
@@ -176,8 +175,7 @@ inventoryX c = case c of
         [ lasGun
         , lasGun
         , dualBeam
-        , --            , lasWidePulse
+        , makeTypeCraftNum 10 TRANSFORMER
-          makeTypeCraftNum 10 TRANSFORMER
         ]
     'K' ->
         [ autoRifle
@@ -216,27 +214,11 @@ testInventory =
             , makeTypeCraft INCENDIARYMODULE
             , makeTypeCraft STATICMODULE
             , makeTypeCraft CONCUSSMODULE
-            , --    , bounceModule
+            , teleportModule
-              --    , medkit 50 & itConsumption . itAmount .~ 3
+            , makeTypeCraftNum 10 HARDWARE
-              teleportModule
-            , --    , makeTypeCraftNum 1 LIGHTER
-              --    , makeTypeCraftNum 15 TUBE
-              --    , makeTypeCraftNum 9 TRANSFORMER
-              --    , makeTypeCraftNum 5 CREATURESENSOR
-              --    , makeTypeCraftNum 9 PRISM
-              --    , makeTypeCraftNum 3 DRUM
-              --    , makeTypeCraftNum 3 PUMP
-              --    , makeTypeCraftNum 3 BATTERY
-              --    , makeTypeCraftNum 1 MAGNET
-              --    , makeTypeCraftNum 1 TRANSMITTER
-              makeTypeCraftNum 10 HARDWARE
             , makeTypeCraftNum 3 SPRING
             , makeTypeCraftNum 10 CAN
-            , --    , makeTypeCraftNum 3 TIN
+            , makeTypeCraftNum 3 PLANK
-              makeTypeCraftNum 3 PLANK
-              --    , makeTypeCraftNum 1 MOTOR
-              --    , makeTypeCraftNum 5 MICROCHIP
-              --    , makeTypeCraftNum 5 AIUNIT
             ]
 
 stackedInventory :: IM.IntMap Item
@@ -244,8 +226,7 @@ stackedInventory =
     IM.fromList $
         zip
             [0 ..]
-            [ --sonicGun
+            [ burstRifle
-              burstRifle
             , pipe
             , rewindGun
             , tractorGun
@@ -254,28 +235,12 @@ stackedInventory =
             , teslaGun
             , blinkGun
             , miniGunX 3
-            , --    ,multGun
+            , boosterGun
-              boosterGun
             , remoteLauncher
             , flatShield
-            , --    ,grenade
+            , spawnGun (lamp 5)
-              spawnGun (lamp 5)
             , lasGun
             , flameThrower
             , poisonSprayer
             , launcher
-            --    ,droneLauncher
-            --,lasGun
-            --,grenade
-            --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
-            --,longGun
-            --,hvAutoGun
-            --,teslaGun
-            --,latchkey 0
-            --,miniGun
-            --,medkit 50
-            --,bezierGun
             ]
-
---smokeGenGun :: Item
---smokeGenGun = effectGun "smoke" $ const spawnSmokeAtCursor

src/Dodge/Creature/Action.hs

@@ -1,55 +1,45 @@
 --{-# LANGUAGE TupleSections #-}
-{- | Actions performed by creatures within the world
- -}
-module Dodge.Creature.Action 
-    ( performActions
-    , stripNoItems
-    , setMinInvSize
-    , dropUnselected
-    , dropExcept
-    , dropItem
---    , startReloadingWeapon
-    , blinkAction
-    , blinkActionFail
-    , unsafeBlinkAction
-    , sizeSelf
---    , crAutoReload
-    , copyInvItemToFloor
-    , youDropItem
-    , pickUpItem
-    , pickUpItemID
-    )
-    where
-import Dodge.FloatFunction
-import Dodge.Inventory.Add
-import Dodge.CreatureEffect
---import Dodge.ShortShow
-import Dodge.Path
-import Dodge.Default
-import Dodge.WallCreatureCollisions
-import Dodge.Creature.Stance.Data
-import Dodge.WorldEvent.Shockwave
-import Dodge.Data
-import Dodge.Base
---import Dodge.Zone
-import Dodge.SoundLogic
---import Dodge.WorldEvent
-import Dodge.Inventory
-import Dodge.FloorItem
---import Dodge.LightSources
-import Geometry
-import Picture
-import qualified IntMapHelp as IM
-import LensHelp
 
---import Control.Monad
+-- | Actions performed by creatures within the world
---import Control.Applicative
+module Dodge.Creature.Action (
-import Data.Maybe
+    performActions,
+    stripNoItems,
+    setMinInvSize,
+    dropUnselected,
+    dropExcept,
+    dropItem,
+    blinkAction,
+    blinkActionFail,
+    unsafeBlinkAction,
+    sizeSelf,
+    copyInvItemToFloor,
+    youDropItem,
+    pickUpItem,
+    pickUpItemID,
+) where
 import Data.Bifunctor
 import Data.List (findIndex)
---import qualified Data.Map as M
+import Data.Maybe
+import Dodge.Base
+import Dodge.CreatureEffect
+import Dodge.Data
+import Dodge.Default
+import Dodge.FloatFunction
+import Dodge.FloorItem
+import Dodge.Inventory
+import Dodge.Inventory.Add
+import Dodge.Path
+import Dodge.SoundLogic
+import Dodge.WallCreatureCollisions
+import Dodge.WorldEvent.Shockwave
+import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
+import Picture
+
 performActions :: World -> Creature -> Creature
-performActions w cr = cr
+performActions w cr =
+    cr
         & crActionPlan . apImpulse .~ concat iss
         & crActionPlan . apAction .~ catMaybes mayas
   where
@@ -66,7 +56,8 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
     aimSp = case cr ^? crMvType . mvAimSpeed of
         Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
         Nothing -> error "creature without aiming type"
-    tpos | canSee'   = _crPos (_creatures (_cWorld w) IM.! tcid)
+    tpos
+        | canSee' = _crPos (_creatures (_cWorld w) IM.! tcid)
         | otherwise = p
 
 performPathTo :: Creature -> World -> Point2 -> OutAction
@@ -74,13 +65,14 @@ performPathTo cr w p
     | dist cpos p <= _crRad cr = ([], Nothing)
     | isWalkable cpos p w = ([MvTurnToward p, MvForward, RandomTurn jit], Just (PathTo p))
     | otherwise = case pointTowardsImpulse p cpos w of
-        Just q -> ([MvTurnToward q
+        Just q ->
+            (
+                [ MvTurnToward q
                 , MvForward
                 , RandomTurn jit
---                ,ArbitraryImpulseEffect . const 
---                    $ debugPicture .~ drawPathList cpos p w
                 ]
-            , Just (PathTo p))
+            , Just (PathTo p)
+            )
         _ -> ([], Nothing)
   where
     cpos = _crPos cr
@@ -98,7 +90,7 @@ performTurnToA cr p
 
 {- | Performing an action means that a creature has some impulses for a frame, and
  updates or deletes the action itself.
--- doAction -}
+-}
 performAction :: Creature -> World -> Action -> OutAction
 performAction cr w ac = case ac of
     ActionNothing -> ([], Nothing)
@@ -152,12 +144,13 @@ performAction cr w ac = case ac of
         (imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac)
     NoAction -> ([], Nothing)
 
-{- | Like a blink action, but no ingoing distortion -}
+-- | Like a blink action, but no ingoing distortion
-blinkActionFail
+blinkActionFail ::
-    :: Creature
+    Creature ->
-    -> World 
+    World ->
-    -> World
+    World
-blinkActionFail cr w = w
+blinkActionFail cr w =
+    w
         & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
         & cWorld . distortions .:~ distortionBulge
         & cWorld . creatures . ix cid . crPos .~ p3
@@ -172,9 +165,10 @@ blinkActionFail cr w = w
     r = 1.5 * _crRad cr
     p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
 
-{- | Teleport a creature to the mouse position -}
+-- | Teleport a creature to the mouse position
 blinkAction :: Creature -> World -> World
-blinkAction cr w = w
+blinkAction cr w =
+    w
         & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
         & cWorld . distortions .++~ distortionBulge
         & cWorld . creatures . ix cid . crPos .~ p3
@@ -194,21 +188,24 @@ blinkAction cr w = w
     p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
 
 {- | Teleport a creature to the mouse position.
-Can go through walls, if ending up in wall does big damage. -}
+Can go through walls, if ending up in wall does big damage.
-unsafeBlinkAction 
+-}
-    :: Creature
+unsafeBlinkAction ::
-    -> World 
+    Creature ->
-    -> World
+    World ->
+    World
 unsafeBlinkAction cr w
-    | success = soundMultiFrom [TeleSound 0,TeleSound 1] mwp teleS Nothing
+    | success =
+        soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
             . (cWorld . distortions .++~ distortionBulge)
             . set (cWorld . creatures . ix cid . crPos) mwp
             . blinkShockwave cid mwp
             $ inverseShockwaveAt cpos 40 2 2 w
-    | otherwise = w 
+    | otherwise =
+        w
             & blinkActionFail cr
-        & cWorld . creatures . ix cid . crState . csDamage .:~
+            & cWorld . creatures . ix cid . crState . csDamage
-            Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
+                .:~ Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
   where
     success = fromMaybe True $ do
         wl <- snd $ collidePointWallsFilterStream (const True) mwp cpos w
@@ -222,11 +219,12 @@ unsafeBlinkAction cr w
     mwp = mouseWorldPos w
     cpos = _crPos cr
 
-blinkShockwave 
+blinkShockwave ::
-    :: Int      -- ^ Blinking creature ID.
+    -- | Blinking creature ID.
-    -> Point2 
+    Int ->
-    -> World 
+    Point2 ->
-    -> World
+    World ->
+    World
 blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
 
 setMinInvSize :: Int -> Creature -> World -> World
@@ -234,14 +232,17 @@ setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
 
 -- maybe this should be removed...
 stripNoItems :: Creature -> World -> World
-stripNoItems cr = organiseInvKeys (_crID cr) .
+stripNoItems cr =
-    ( cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just )
+    organiseInvKeys (_crID cr)
+        . (cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
 
 organiseInvKeys :: Int -> World -> World
-organiseInvKeys cid w = w & cWorld . creatures . ix cid %~
+organiseInvKeys cid w =
-    ( ( crInvSel . iselPos .~ newSelKey ) 
+    w & cWorld . creatures . ix cid
+        %~ ( (crInvSel . iselPos .~ newSelKey)
                 . (crInv .~ newInv)
-    . ( crInvSel . iselAction .~ NoInvSelAction) )
+                . (crInvSel . iselAction .~ NoInvSelAction)
+           )
   where
     cr = _creatures (_cWorld w) IM.! cid
     pairs = IM.toList (_crInv cr)
@@ -249,17 +250,20 @@ organiseInvKeys cid w = w & cWorld . creatures . ix cid %~
     newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
 
 dropUnselected :: Creature -> World -> World
-dropUnselected cr w = foldr (dropItem cr) w . IM.keys 
+dropUnselected cr w =
-    $ crSel cr `IM.delete` _crInv cr 
+    foldr (dropItem cr) w . IM.keys $
+        crSel cr `IM.delete` _crInv cr
 
 dropExcept :: Creature -> Int -> World -> World
-dropExcept cr invid w = foldr (dropItem cr) w . IM.keys 
+dropExcept cr invid w =
-    $ invid `IM.delete` _crInv cr 
+    foldr (dropItem cr) w . IM.keys $
+        invid `IM.delete` _crInv cr
 
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . mayberemoveequip
   where
     cid = _crID cr
+
 -- the following should be done in rmInvItem
 --    mayberemoveequip = case _crLeftInvSel cr of
 --        Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
@@ -270,30 +274,33 @@ youDropItem w
     | _crInvLock (you w) = w
     | otherwise = youDropItem' w
 
-{- | Get your creature to drop the item under the cursor.  -}
+-- | Get your creature to drop the item under the cursor.
 youDropItem' :: World -> World
 youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
-    Just Uncursed -> w
+    Just Uncursed ->
+        w
             & dropItem cr (crSel cr)
             & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
     _ -> w
   where
     cr = you w
 
-{- | Copy an inventory item to the floor.  -}
+-- | Copy an inventory item to the floor.
 copyInvItemToFloor :: Creature -> Int -> World -> World
-copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) 
+copyInvItemToFloor cr i =
-    $ _crInv cr IM.! i 
+    copyItemToFloor (_crPos cr) $
+        _crInv cr IM.! i
             & itIsHeld .~ False
 
 sizeSelf :: Float -> Creature -> World -> Maybe World
 sizeSelf x cr w
-    -- | _crPos cr1 == _crPos cr2 = Just $ w
+    | not (crOnWall cr1 w) =
-    | not (crOnWall cr1 w) = Just $ w
+        Just $
+            w
                 & soundMultiFrom [TeleSound 0, TeleSound 1] cpos teleS Nothing
                 & cWorld . distortions .:~ distortionBulge
-        & cWorld . creatures . ix cid %~ 
+                & cWorld . creatures . ix cid
-            ( (crRad .~ 10 * x) 
+                    %~ ( (crRad .~ 10 * x)
                             . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
                             . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
                        )
@@ -311,7 +318,8 @@ sizeSelf x cr w
 pickUpItemID :: Int -> Int -> World -> World
 pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w
 
-{- | Pick up a specific item. -}
+-- | Pick up a specific item.
 pickUpItem :: Int -> FloorItem -> World -> World
-pickUpItem cid flit w = maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd)
+pickUpItem cid flit w =
-    $ tryPutItemInInv cid flit w
+    maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
+        tryPutItemInInv cid flit w

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,6 +1,7 @@
 module Dodge.Creature.Impulse.UseItem
     ( useItem
     , useLeftItem
+    , itemEffect
     ) where
 import Dodge.Data
 import Dodge.Luse
@@ -41,8 +42,8 @@ itemEffect cr it w = case it ^? itUse of
         HammerUp -> f w
         _ -> w & setuhamdown
     setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
-    doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions (_cWorld w)) (crSel cr) cr
+    doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
-        . activateEquipmentAt (_rbOptions (_cWorld w)) cr)
+        . activateEquipmentAt (_rbOptions w) cr)
 
 tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
 tryReload cr it w f

src/Dodge/Data.hs

@@ -58,9 +58,6 @@ module Dodge.Data (
     module Dodge.Distortion.Data,
     module Dodge.Data.Damage,
     module Dodge.Data.SoundOrigin,
-    module Dodge.Creature.Stance.Data,
-    module Dodge.Creature.Perception.Data,
-    module Dodge.Creature.Memory.Data,
     module Dodge.Config.Data,
     module MaybeHelp,
     module Dodge.Data.ItemAmount,
@@ -83,14 +80,14 @@ module Dodge.Data (
     module Dodge.Data.GenParams,
     module Dodge.Data.Terminal,
     module Dodge.Data.FloorItem,
+    module Dodge.Data.CWorld,
 ) where
 
+import Dodge.Data.CWorld
 import Color
 import Control.Lens
 import Control.Monad.State
 import Data.Aeson
-import Data.Graph.Inductive
-import qualified Data.IntSet as IS
 import qualified Data.Map.Strict as M
 import Data.Preload
 import qualified Data.Set as S
@@ -99,9 +96,6 @@ import Data.Tile
 import Dodge.Combine.Data
 import Dodge.Config.Data
 import Dodge.Config.KeyConfig
-import Dodge.Creature.Memory.Data
-import Dodge.Creature.Perception.Data
-import Dodge.Creature.Stance.Data
 import Dodge.Data.ActionPlan
 import Dodge.Data.Ammo
 import Dodge.Data.ArcStep
@@ -163,10 +157,8 @@ import Dodge.Data.Wall
 import Dodge.Data.WorldEffect
 import Dodge.Data.Zoning
 import Dodge.Distortion.Data
-import Dodge.GameRoom
 import Dodge.RoomCluster.Data
 import GHC.Generics
-import Geometry.ConvexPoly
 import Geometry.Data
 import qualified IntMapHelp as IM
 import MaybeHelp
@@ -176,8 +168,6 @@ import Sound.Data
 import Streaming
 import System.Random
 
-type CRUpdate = Creature -> World -> (World -> World, Maybe Creature)
-
 type CRUpdate' = Creature -> World -> (World -> World, Creature)
 
 data Universe = Universe
@@ -206,100 +196,16 @@ data World = World
     , _keys :: S.Set Scancode
     , _mouseButtons :: M.Map MouseButton Bool
     , _hammers :: M.Map WorldHammer HammerPosition
-    }
-
-data CWorld = CWorld
-    { _cameraCenter :: Point2
-    , _cameraRot :: Float
-    , _cameraZoom :: Float -- smaller values zoom out
-    , _itemZoom :: Float
-    , _defaultZoom :: Float
-    , _cameraViewFrom :: Point2
-    , _viewDistance :: Float
-    , _boundBox :: [Point2]
-    , _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
-    , _creatures :: IM.IntMap Creature
-    , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet) --Zoning IM.IntMap Creature
-    , _creatureGroups :: IM.IntMap CrGroupParams
-    , _itemPositions :: IM.IntMap ItemPos
-    , _clouds :: [Cloud]
-    , _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature
-    , _gusts :: IM.IntMap Gust
-    , _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
-    , _props :: IM.IntMap Prop
-    , _projectiles :: IM.IntMap Proj
-    , _instantBullets :: [Bullet]
-    , _bullets :: [Bullet]
-    , _radarSweeps :: [RadarSweep]
-    , _energyBalls :: [EnergyBall]
-    , _posEvents :: [PosEvent]
-    , _flames :: [Flame]
-    , _sparks :: [Spark]
-    , _radarBlips :: [RadarBlip]
-    , _flares :: [Flare]
-    , _newBeams :: WorldBeams
-    , _beams :: WorldBeams
-    , _teslaArcs :: [TeslaArc]
-    , _shockwaves :: [Shockwave]
-    , _lasers :: [LaserStart]
-    , _lasersToDraw :: [Laser]
-    , _linearShockwaves :: IM.IntMap LinearShockwave
-    , _tractorBeams :: [TractorBeam]
-    , _walls :: IM.IntMap Wall
-    , _wallDamages :: IM.IntMap [Damage]
-    , _doors :: IM.IntMap Door
-    , _machines :: IM.IntMap Machine
-    , _terminals :: IM.IntMap Terminal
-    , _magnets :: IM.IntMap Magnet
-    , _blocks :: IM.IntMap Block
-    , _coordinates :: IM.IntMap Point2
-    , _triggers :: IM.IntMap Bool
-    , _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
-    , _floorItems :: IM.IntMap FloorItem
-    , _floorTiles :: [(Point3, Point3)]
-    , _modifications :: IM.IntMap Modification
-    , _yourID :: Int
-    , _worldEvents :: [WdWd]
-    , _delayedEvents :: [(Int, WdWd)]
-    , _pressPlates :: IM.IntMap PressPlate
-    , _buttons :: IM.IntMap Button
-    , _decorations :: IM.IntMap Picture
-    , _foregroundShapes :: IM.IntMap ForegroundShape
-    , _corpses :: IM.IntMap Corpse
-    , _clickMousePos :: Point2
-    , _pathGraph :: Gr Point2 PathEdge
-    , _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
-    , _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature
-    , _hud :: HUD
-    , _lightSources :: IM.IntMap LightSource
-    , _tempLightSources :: [TempLightSource]
-    , _closeObjects :: [Either FloorItem Button]
-    , _rbOptions :: RightButtonOptions
-    , _seenLocations :: IM.IntMap (WdP2, String)
-    , _selLocation :: Int
-    , _distortions :: [Distortion]
-    , _worldBounds :: Bounds
-    , _gameRooms :: [GameRoom] -- consider using an IntMap
-    , _roomClipping :: [ConvexPoly]
-    , _maybeWorld :: Maybe' CWorld
-    , _rewindWorlds :: [CWorld]
-    , _timeFlow :: TimeFlowStatus
-    , _worldClock :: Int
-    , _backspaceTimer :: Int
-    , _genParams :: GenParams
-    , _deathDelay :: Maybe Int
     , _testFloat :: Float
     , _lLine :: (Point2, Point2)
     , _rLine :: (Point2, Point2)
     , _lSelect :: Point2
     , _rSelect :: Point2
+    , _backspaceTimer :: Int
+    , _timeFlow :: TimeFlowStatus
+    , _rbOptions :: RightButtonOptions
     }
-    deriving (Eq, Show, Read, Generic)
 
-instance ToJSON CWorld where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CWorld
 
 instance ToJSON MouseButton where
     toEncoding = genericToEncoding defaultOptions
@@ -397,18 +303,6 @@ data MenuOption
 
 data IntID a = IntID Int a
 
-data WorldBeams = WorldBeams
-    { _blockingBeams :: [Beam]
-    , _lightBeams :: [Beam]
-    , _positronBeams :: [Beam]
-    , _electronBeams :: [Beam]
-    }
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON WorldBeams where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON WorldBeams
 
 type HitEffect' =
     Flame ->
@@ -531,9 +425,7 @@ makeLenses ''World
 --makeLenses ''Particle
 makeLenses ''Universe
 makeLenses ''ScreenLayer
-makeLenses ''WorldBeams
 makeLenses ''GenWorld
-makeLenses ''CWorld
 
 ----- ROOM LENSES
 

src/Dodge/Data/ActionPlan.hs

@@ -1,17 +1,18 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
 --{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
+
-{-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data.ActionPlan where
-import GHC.Generics
+
-import Data.Aeson
-import Dodge.Creature.Stance.Data
-import Dodge.Data.CreatureEffect
---import Dodge.ShortShow
 import Control.Lens
+import Data.Aeson
+import Dodge.Data.Creature.Stance
+import Dodge.Data.CreatureEffect
+import GHC.Generics
 import Geometry.Data
 import Sound.Data
---import GHC.Generics
+
 data ActionPlan
     = Inanimate
     | ActionPlan
@@ -21,16 +22,22 @@ data ActionPlan
         , _apGoal :: [Goal]
         }
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON ActionPlan where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON ActionPlan
+
 data RandImpulse
     = RandImpulseList [Impulse]
     | RandImpulseCircMove Float
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON RandImpulse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON RandImpulse
+
 data Impulse
     = Move Point2
     | MoveForward Float
@@ -64,14 +71,22 @@ data Impulse
         }
     | ImpulseNothing
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Impulse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Impulse
+
 infixr 9 `WaitThen`
+
 infixr 9 `DoActionThen`
+
 infixr 9 `DoActionWhile`
+
 infixr 9 `DoReplicate`
+
 infixr 9 `DoImpulsesAlongside`
+
 data Action
     = LabelAction
         { _actLabel :: String
@@ -88,10 +103,10 @@ data Action
     | TurnToPoint
         { _turnToPoint :: Point2
         }
---    | PickupItem 
+    | --    | PickupItem
       --        {_pickupItemID :: Int
       --        }
-    | ImpulsesList 
+      ImpulsesList
         { _impulsesListList :: [[Impulse]]
         }
     | DoImpulses
@@ -131,10 +146,10 @@ data Action
         { _doActionThenFirst :: Action
         , _doActionThenSecond :: Action
         }
---    | DoGuardActions 
+    | --    | DoGuardActions
       --        {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
       --        }
-    | DoReplicate 
+      DoReplicate
         { _doReplicateTimes :: Int
         , _doReplicateAction :: Action
         }
@@ -162,15 +177,18 @@ data Action
         }
     | ArbitraryAction
         {_arbitraryAction :: CrWdAc}
-    | DoImpulsesAlongside 
+    | -- | Repeatedly perform impulses alongside a main action until the main action terminates
-    -- ^ Repeatedly perform impulses alongside a main action until the main action terminates
+      DoImpulsesAlongside
         { _sideImpulses :: [Impulse]
         , _mainAction :: Action
         }
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Action where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Action
+
 data Strategy
     = Flank Int
     | Ambush Int
@@ -188,17 +206,23 @@ data Strategy
     | Flee
     | MeleeStrike
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Strategy where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Strategy
+
 data Goal
     = LiveLongAndProsper
     | Kill Int
     | SentinelAt Point2 Float
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Goal where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Goal
+
 makeLenses ''ActionPlan
 makeLenses ''Impulse
 makeLenses ''Action

src/Dodge/Data/CWorld.hs

@@ -0,0 +1,159 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.CWorld where
+
+import Control.Lens
+import Data.Aeson
+import Data.Graph.Inductive
+import qualified Data.IntSet as IS
+import Dodge.Data.Beam
+import Dodge.Data.Block
+import Dodge.Data.Bounds
+import Dodge.Data.Bullet
+import Dodge.Data.Button
+import Dodge.Data.Cloud
+import Dodge.Data.Corpse
+import Dodge.Data.CrGroupParams
+import Dodge.Data.Creature
+import Dodge.Data.Damage
+import Dodge.Data.Door
+import Dodge.Data.EnergyBall
+import Dodge.Data.Flame
+import Dodge.Data.Flare
+import Dodge.Data.FloorItem
+import Dodge.Data.ForegroundShape
+import Dodge.Data.GenParams
+import Dodge.Data.Gust
+import Dodge.Data.HUD
+import Dodge.Data.Item
+import Dodge.Data.Laser
+import Dodge.Data.LightSource
+import Dodge.Data.LinearShockwave
+import Dodge.Data.Machine
+import Dodge.Data.Magnet
+import Dodge.Data.Modification
+import Dodge.Data.PathGraph
+import Dodge.Data.PosEvent
+import Dodge.Data.PressPlate
+import Dodge.Data.Projectile
+import Dodge.Data.Prop
+import Dodge.Data.RadarBlip
+import Dodge.Data.RadarSweep
+import Dodge.Data.Shockwave
+import Dodge.Data.Spark
+import Dodge.Data.Terminal
+import Dodge.Data.TeslaArc
+import Dodge.Data.TractorBeam
+import Dodge.Data.Wall
+import Dodge.Data.WorldEffect
+import Dodge.Distortion.Data
+import Dodge.GameRoom
+import GHC.Generics
+import Geometry.ConvexPoly
+import Geometry.Data
+import qualified IntMapHelp as IM
+import MaybeHelp
+import Picture.Data
+
+data CWorld = CWorld
+    { _cameraCenter :: Point2
+    , _cameraRot :: Float
+    , _cameraZoom :: Float -- smaller values zoom out
+    , _itemZoom :: Float
+    , _defaultZoom :: Float
+    , _cameraViewFrom :: Point2
+    , _viewDistance :: Float
+    , _boundBox :: [Point2]
+    , _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
+    , _creatures :: IM.IntMap Creature
+    , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
+    , _creatureGroups :: IM.IntMap CrGroupParams
+    , _itemPositions :: IM.IntMap ItemPos
+    , _clouds :: [Cloud]
+    , _clZoning :: IM.IntMap (IM.IntMap [Cloud])
+    , _gusts :: IM.IntMap Gust
+    , _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
+    , _props :: IM.IntMap Prop
+    , _projectiles :: IM.IntMap Proj
+    , _instantBullets :: [Bullet]
+    , _bullets :: [Bullet]
+    , _radarSweeps :: [RadarSweep]
+    , _energyBalls :: [EnergyBall]
+    , _posEvents :: [PosEvent]
+    , _flames :: [Flame]
+    , _sparks :: [Spark]
+    , _radarBlips :: [RadarBlip]
+    , _flares :: [Flare]
+    , _newBeams :: WorldBeams
+    , _beams :: WorldBeams
+    , _teslaArcs :: [TeslaArc]
+    , _shockwaves :: [Shockwave]
+    , _lasers :: [LaserStart]
+    , _lasersToDraw :: [Laser]
+    , _linearShockwaves :: IM.IntMap LinearShockwave
+    , _tractorBeams :: [TractorBeam]
+    , _walls :: IM.IntMap Wall
+    , _wallDamages :: IM.IntMap [Damage]
+    , _doors :: IM.IntMap Door
+    , _machines :: IM.IntMap Machine
+    , _terminals :: IM.IntMap Terminal
+    , _magnets :: IM.IntMap Magnet
+    , _blocks :: IM.IntMap Block
+    , _coordinates :: IM.IntMap Point2
+    , _triggers :: IM.IntMap Bool
+    , _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
+    , _floorItems :: IM.IntMap FloorItem
+    , _floorTiles :: [(Point3, Point3)]
+    , _modifications :: IM.IntMap Modification
+    , _yourID :: Int
+    , _worldEvents :: [WdWd]
+    , _delayedEvents :: [(Int, WdWd)]
+    , _pressPlates :: IM.IntMap PressPlate
+    , _buttons :: IM.IntMap Button
+    , _decorations :: IM.IntMap Picture
+    , _foregroundShapes :: IM.IntMap ForegroundShape
+    , _corpses :: IM.IntMap Corpse
+    , _clickMousePos :: Point2
+    , _pathGraph :: Gr Point2 PathEdge
+    , _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
+    , _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature
+    , _hud :: HUD
+    , _lightSources :: IM.IntMap LightSource
+    , _tempLightSources :: [TempLightSource]
+    , _closeObjects :: [Either FloorItem Button]
+    , _seenLocations :: IM.IntMap (WdP2, String)
+    , _selLocation :: Int
+    , _distortions :: [Distortion]
+    , _worldBounds :: Bounds
+    , _gameRooms :: [GameRoom] -- consider using an IntMap
+    , _roomClipping :: [ConvexPoly]
+    , _maybeWorld :: Maybe' CWorld
+    , _rewindWorlds :: [CWorld]
+    , _worldClock :: Int
+    , _genParams :: GenParams
+    , _deathDelay :: Maybe Int
+    }
+    deriving (Eq, Show, Read, Generic)
+
+instance ToJSON CWorld where
+    toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON CWorld
+
+data WorldBeams = WorldBeams
+    { _blockingBeams :: [Beam]
+    , _lightBeams :: [Beam]
+    , _positronBeams :: [Beam]
+    , _electronBeams :: [Beam]
+    }
+    deriving (Eq, Ord, Show, Read, Generic)
+
+instance ToJSON WorldBeams where
+    toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON WorldBeams
+
+makeLenses ''CWorld
+makeLenses ''WorldBeams

src/Dodge/Data/Creature.hs

@@ -5,6 +5,9 @@ module Dodge.Data.Creature
     ( module Dodge.Data.Creature
     , module Dodge.Data.Creature.Misc
     , module Dodge.Data.Creature.State
+    , module Dodge.Data.Creature.Perception
+    , module Dodge.Data.Creature.Memory
+    , module Dodge.Data.Creature.Stance
     ) where
 import GHC.Generics
 import Data.Aeson
@@ -15,9 +18,9 @@ import Dodge.Data.LoadAction
 import Dodge.Data.Material
 import Dodge.Data.ActionPlan
 import Dodge.Data.Hammer
-import Dodge.Creature.Perception.Data
+import Dodge.Data.Creature.Perception
-import Dodge.Creature.Memory.Data
+import Dodge.Data.Creature.Memory
-import Dodge.Creature.Stance.Data
+import Dodge.Data.Creature.Stance
 import Geometry.Data
 import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M

src/Dodge/Data/Creature/Memory.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Creature.Memory.Data
+module Dodge.Data.Creature.Memory
     where
 import GHC.Generics
 import Data.Aeson

src/Dodge/Data/Creature/Perception.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Creature.Perception.Data
+module Dodge.Data.Creature.Perception
     ( Perception (..)
     , Vigilance (..)
     , Attention (..)

src/Dodge/Data/Creature/Stance.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Creature.Stance.Data
+module Dodge.Data.Creature.Stance
   where
 import GHC.Generics
 import Data.Aeson

src/Dodge/Data/Item/HeldUse.hs

@@ -25,16 +25,22 @@ data HeldUse
     | HeldForceField
     | HeldShatter
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON HeldUse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON HeldUse
+
 data Cuse
     = CDoNothing
     | CHeal Int
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Cuse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Cuse
+
 data Euse
     = EDoNothing
     | EDetector Detector
@@ -45,9 +51,12 @@ data Euse
     | EonWristShield
     | EoffWristShield
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Euse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Euse
+
 data Luse
     = LDoNothing
     | LRewind
@@ -56,13 +65,17 @@ data Luse
     | LUnsafeBlink
     | LBoost
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON Luse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Luse
+
 data HeldMod
     = HeldModNothing
     | PoisonSprayerMod
     | FlameSpitterMod
+    | FlameSpitterRepeatMod
     | FlameThrowerMod
     | LauncherMod
     | TeslaMod
@@ -88,11 +101,15 @@ data HeldMod
     | AutoPistolMod
     | MachinePistolMod
     | BurstRifleMod
+    | BurstRifleRepeatMod
     | MiniGunMod Int
     | SmgMod
     | RevolverXMod
+    | RevolverXRepeatMod
     | BangConeMod
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON HeldMod where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON HeldMod

src/Dodge/Data/WorldEffect.hs

@@ -3,12 +3,20 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data.WorldEffect where
+import Dodge.Data.Item
 import Data.Aeson
 import GHC.Generics
 import Dodge.Data.CreatureEffect
 import Sound.Data
 import Geometry.Data
 import Dodge.Data.SoundOrigin
+data ItCrWdWd = ItCrWdId
+    | ItCrWdItemEffect
+  deriving (Eq,Ord,Show,Read,Generic)
+instance ToJSON ItCrWdWd  where
+    toEncoding = genericToEncoding defaultOptions
+instance FromJSON ItCrWdWd 
+
 data WdWd = NoWorldEffect
     | SetTrigger Bool Int 
     | WorldEffects [WdWd]
@@ -19,6 +27,8 @@ data WdWd = NoWorldEffect
     | MakeStartCloudAt Point3
     | TorqueCr Float Int
     | WdWdNegateTrig Int
+    | WdWdFromItixCrixWdWd Int Int ItCrWdWd
+    | WdWdFromItCrixWdWd Item Int ItCrWdWd
   deriving (Eq,Ord,Show,Read,Generic)
 instance ToJSON WdWd  where
     toEncoding = genericToEncoding defaultOptions

src/Dodge/Default/World.hs

@@ -19,6 +19,14 @@ defaultWorld = World
     , _mouseButtons     = mempty
     , _mousePos = V2 0 0
     , _hammers = defaultWorldHammers
+    , _testFloat = 0
+    , _lLine  = (0,0)
+    , _rLine  = (0,0)
+    , _lSelect   = 0
+    , _rSelect   = 0
+    , _backspaceTimer = 0
+    , _timeFlow = NormalTimeFlow
+    , _rbOptions        = NoRightButtonOptions
     }
 
 defaultCWorld :: CWorld
@@ -95,7 +103,6 @@ defaultCWorld = CWorld
     , _lightSources = IM.empty
     , _tempLightSources = []
     , _closeObjects     = []
-    , _rbOptions        = NoRightButtonOptions
     , _seenLocations        = IM.fromList 
         [(0, (WdYouPos, "CURRENT POSITION"))
         ,(1, (WdP2Const (V2 0 0) , "START POSITION"))
@@ -109,19 +116,12 @@ defaultCWorld = CWorld
     , _worldBounds = defaultBounds
     , _maybeWorld = Nothing'
     , _rewindWorlds = []
-    , _timeFlow = NormalTimeFlow
-    , _backspaceTimer = 0
     , _genParams = GenParams M.empty
 --    , _genPlacements = IM.empty
 --    , _genRooms = IM.empty
     , _deathDelay = Nothing
-    , _testFloat = 0
     , _boundBox = square 100
     , _boundDist = (100,-100,100,-100)
-    , _lLine  = (0,0)
-    , _rLine  = (0,0)
-    , _lSelect   = 0
-    , _rSelect   = 0
     }
 defaultWorldHammers :: M.Map WorldHammer HammerPosition
 defaultWorldHammers = M.fromSet (const HammerUp) $ S.fromList [minBound.. maxBound]

src/Dodge/Event.hs

@@ -97,7 +97,7 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
             -- functions that modify the inventory should be centralised so that
             -- this lock can be sensibly applied, perhaps
         | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
-        | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions (_cWorld w)) of
+        | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
             (_,EquipOptions{}) -> scrollRBOption y w
             (Nothing,_) -> closeObjScrollDir y w
             (Just f,_)  -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
@@ -159,8 +159,8 @@ nullCommand = TerminalCommand
 
 scrollRBOption :: Float -> World -> World
 scrollRBOption y w
-    | y < 0 = w & cWorld . rbOptions . opSel %~ (min (length (_opEquip (_rbOptions (_cWorld w)))-1) . (+1))
+    | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
-    | y > 0 = w & cWorld . rbOptions . opSel %~ (max 0 . subtract 1)
+    | y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
     | otherwise = w
 
 moveTweakSel :: Int -> World -> World

src/Dodge/Event/Keyboard.hs

@@ -68,9 +68,9 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
 
 handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
 handlePressedKey True ScancodeBackspace u 
-    | _backspaceTimer (_cWorld $ _uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u
+    | _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u
-        <&> _Just . uvWorld . cWorld . backspaceTimer .~ 0
+        <&> _Just . uvWorld . backspaceTimer .~ 0
-    | otherwise  = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1
+    | otherwise  = return $ Just $ u & uvWorld . backspaceTimer -~ 1
 handlePressedKey True _    u   = return $ Just u
 handlePressedKey _   scode u = case scode of
     ScancodeF1          -> Just <$> (writeSaveSlot (SaveSlotNum 1) u >> return u)
@@ -107,7 +107,7 @@ handlePressedKeyTerminal tmid scode w = case scode of
     ScancodeReturn  -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid)
     ScancodeBackspace -> w 
         & cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace
-        & cWorld . backspaceTimer .~ 5
+        & backspaceTimer .~ 5
     _               -> w
   where
     doBackspace t = case T.unsnoc t of

src/Dodge/HeldUse.hs

@@ -35,7 +35,14 @@ useMod hm = case hm of
         [ ammoCheckI
         , useTimeCheck
         , lockInvFor 10
-        , repeatOnFrames [1..9]
+        , repeatOnFrames [1..9] FlameSpitterRepeatMod
+        , withRandomItemParams f
+        , useAmmoAmount 1
+        , withSidePushI 5
+        , withSidePushAfterI 20
+        ]
+    FlameSpitterRepeatMod ->
+        [ ammoCheckI
         , withRandomItemParams f
         , useAmmoAmount 1
         , withSidePushI 5
@@ -239,7 +246,16 @@ useMod hm = case hm of
         , useTimeCheck
         , sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2)
         , lockInvFor 7
-        , \f' it -> repeatOnFrames (take (_laLoaded (_itConsumption it) - 1) [3,6]) f' it
+        , repeatOnFrames [3,6] BurstRifleRepeatMod
+        , withSoundStart tap3S
+        , useAmmoAmount 1
+        , applyInaccuracy
+        , withMuzFlareI
+        , withRecoil
+        ]
+    BurstRifleRepeatMod ->
+        [ ammoCheckI
+        , sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2)
         , withSoundStart tap3S
         , useAmmoAmount 1
         , applyInaccuracy
@@ -278,7 +294,19 @@ useMod hm = case hm of
         -- rather than locking the inventory, a better solution may be to check
         -- that the weapon is still in your hands in the repeated frames
         , lockInvFor 10
-        , \f' it -> repeatOnFrames (take (_laLoaded (_itConsumption it) - 1) [2,4,6,8,10]) f' it
+        , repeatOnFrames [2,4,6,8,10] RevolverXRepeatMod
+        , withSoundStart tap3S 
+        , useAmmoUpTo 1
+        , applyInaccuracy
+        , withMuzFlareI
+--        , spreadLoaded
+        , withTorqueAfter
+        , withRecoil
+        ]
+    RevolverXRepeatMod ->
+        [ ammoCheckI
+        -- rather than locking the inventory, a better solution may be to check
+        -- that the weapon is still in your hands in the repeated frames
         , withSoundStart tap3S 
         , useAmmoUpTo 1
         , applyInaccuracy

src/Dodge/Inventory.hs

@@ -185,17 +185,17 @@ updateCloseObjects w = w
 
 updateRBList :: World -> World
 updateRBList w 
-    | w ^? cWorld . rbOptions . opCurInvPos == Just curinvid 
+    | w ^? rbOptions . opCurInvPos == Just curinvid 
         = w & setEquipAllocation & setEquipActivation
     | otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of
         Just esite -> w 
-            & cWorld . rbOptions .~ EquipOptions (equipSiteToPositions esite) 
+            & rbOptions .~ EquipOptions (equipSiteToPositions esite) 
                 (chooseEquipmentPosition cr (equipSiteToPositions esite)) 
                 curinvid 
                 DoNotMoveEquipment 
                 NoChangeActivateEquipment
             & setEquipAllocation & setEquipActivation
-        Nothing -> w & cWorld . rbOptions .~ NoRightButtonOptions
+        Nothing -> w & rbOptions .~ NoRightButtonOptions
 --    | otherwise = w & rbOptions .~ NoRightButtonOptions
   where
     curinvid = crSel cr
@@ -212,53 +212,53 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
     hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
 
 setEquipAllocation :: World -> World
-setEquipAllocation w = case _rbOptions (_cWorld w) of
+setEquipAllocation w = case _rbOptions w of
     EquipOptions {_opEquip = es,_opSel=i} ->
         case you w ^? crInvEquipped . ix (crSel (you w)) of
             Just epos | es !! i == epos
-                    -> w & cWorld . rbOptions . opAllocateEquipment .~ RemoveEquipment
+                    -> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
                         {_allocOldPos = epos}
             Just epos | isJust (you w ^? crEquipment . ix (es !! i))
-                    -> w & cWorld . rbOptions . opAllocateEquipment .~ SwapEquipment
+                    -> w & rbOptions . opAllocateEquipment .~ SwapEquipment
                         {_allocOldPos = epos
                         ,_allocNewPos = es !! i
                         ,_allocSwapID = _crEquipment (you w) M.! (es !! i)
                         }
-            Just epos -> w & cWorld . rbOptions . opAllocateEquipment .~ MoveEquipment
+            Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment
                         {_allocOldPos = epos
                         ,_allocNewPos = es !! i
                         }
             Nothing | isJust (you w ^? crEquipment . ix (es !! i))
-                    -> w & cWorld . rbOptions . opAllocateEquipment .~ ReplaceEquipment
+                    -> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment
                         {_allocNewPos = es !! i
                         ,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
                         }
-            Nothing -> w & cWorld . rbOptions . opAllocateEquipment .~ PutOnEquipment
+            Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment
                         {_allocNewPos = es !! i}
     _ -> w
 --  where
 --    curpos = invSelPos w
 
 setEquipActivation :: World -> World
-setEquipActivation w = case w ^? cWorld . rbOptions . opAllocateEquipment of
+setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
     Just DoNotMoveEquipment -> w
     Just RemoveEquipment { }
         -> case _crLeftInvSel (you w) of
-            Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment
+            Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment
                 {_deactivateEquipment = i}
-            _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
     Just rbos
         -> case _crLeftInvSel (you w) of
-            Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+            Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-            Just i | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
+            Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
                 {_activateEquipment = invsel,_deactivateEquipment = i}
             Just i | Just i == rbos ^? allocRemoveID
-                   -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment i
+                   -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
-            Just _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-            Nothing | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateEquipment
+            Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment
                 {_activateEquipment = invsel}
-            Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-    Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
   where
     invsel = crSel (you w)
     invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)

src/Dodge/ItEffect.hs

@@ -39,7 +39,6 @@ rewindEffect itm cr w
     maxcharge = _wpMaxCharge . _itConsumption $ itm
     cw = _cWorld w 
         & rewindWorlds .~ []
-        & timeFlow .~ NormalTimeFlow
 
 resetAttachmentEffect :: Item -> Creature -> World -> World
 resetAttachmentEffect itm cr w 

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -1,25 +1,28 @@
-module Dodge.Item.Weapon.BulletGun.Cane 
+module Dodge.Item.Weapon.BulletGun.Cane (
-    ( volleyGun
+    volleyGun,
-    , repeater
+    repeater,
-    , rifle
+    rifle,
-    , autoRifle
+    autoRifle,
-    , burstRifle
+    burstRifle,
-    , miniGunX
+    miniGunX,
 ) where
-import Dodge.Reloading.Action
+
 import Dodge.Data
-import Dodge.Default.Weapon
 import Dodge.Default
+import Dodge.Reloading.Action
 import Geometry
 import LensHelp
 
 defaultBangCane :: Item
-defaultBangCane = defaultBulletWeapon
+defaultBangCane =
-    & itParams .~ BulletShooter
+    defaultBulletWeapon
+        & itParams
+            .~ BulletShooter
                 { _muzVel = 0.8
                 , _rifling = 0.9
                 , _bore = 2
-        , _gunBarrels = SingleBarrel 
+                , _gunBarrels =
+                    SingleBarrel
                         { _brlInaccuracy = 0.01
                         }
                 , _recoil = 50
@@ -36,8 +39,10 @@ defaultBangCane = defaultBulletWeapon
         & itType . iyBase .~ error "undefined bangCane baseitemtype"
         & itConsumption . laMax .~ 1
         & itConsumption . laCycle .~ [loadPartialInsert 10 1]
+
 volleyGun :: Int -> Item
-volleyGun i = defaultBangCane
+volleyGun i =
+    defaultBangCane
         & itUse . useDelay . rateMax .~ 6
         & itUse . useMods .~ VolleyGunMod
         & itUse . useAim . aimWeight .~ 6
@@ -47,115 +52,95 @@ volleyGun i = defaultBangCane
         & itUse . useAim . aimHandlePos .~ 5
         & itUse . useAim . aimMuzPos .~ 15
         & itConsumption . laMax .~ i
-    & itParams .~ BulletShooter
+        & itParams
+            .~ BulletShooter
                 { _muzVel = 0.8
                 , _rifling = 0.9
                 , _bore = 2
-        , _gunBarrels = SingleBarrel 
+                , _gunBarrels =
+                    SingleBarrel
                         { _brlInaccuracy = 0.01
                         }
                 , _recoil = 50
                 , _torqueAfter = 0.1
                 , _randomOffset = 0
                 }
-    & itParams . gunBarrels .~ MultiBarrel
+        & itParams . gunBarrels
+            .~ MultiBarrel
                 { _brlSpread = AlignedBarrels
                 , _brlNum = i
                 , _brlInaccuracy = 0.1
                 }
         & itParams . torqueAfter .~ 0.48 + 0.2 * fromIntegral i
         & itType . iyBase .~ HELD (VOLLEYGUN i)
+
 rifle :: Item
-rifle = defaultBangCane
+rifle =
+    defaultBangCane
         & itUse . useAim . aimStance .~ TwoHandTwist
         & itType . iyBase .~ HELD RIFLE
         & itConsumption . laMax .~ 1
         & itConsumption . laCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
         & itUse . useAim . aimWeight .~ 6
         & itUse . useAim . aimRange .~ 1
---    & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
         & itUse . useAim . aimZoom .~ defaultItZoom{_itZoomFac = 2}
         & itType . iyModules . at ModHeldAttach ?~ EMPTYMODULE
+
 repeater :: Item
-repeater = rifle
+repeater =
+    rifle
         & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
         & itType . iyBase .~ HELD REPEATER
         & itConsumption . laCycle .~ [loadEject 20, loadInsert 20, loadPrime 20]
         & itConsumption . laMax .~ 15
 
-
 autoRifle :: Item
-autoRifle = repeater
+autoRifle =
+    repeater
         & itType . iyBase .~ HELD AUTORIFLE
         & itUse . useMods .~ AutoRifleMod
         & itType . iyModules . at ModAutoMag ?~ EMPTYMODULE
+
 --    & itUse . useDelay . rateMax .~ 6
 burstRifle :: Item
-burstRifle = repeater
+burstRifle =
+    repeater
         & itType . iyBase .~ HELD BURSTRIFLE
         & itParams . gunBarrels . brlInaccuracy .~ 0.05
         & itUse . useDelay . rateMax .~ 18
         & itUse . useMods .~ BurstRifleMod
---fastBurstRifle :: Item
+
---fastBurstRifle = repeater
---    & itType . iyBase .~ FASTBURSTRIFLE
---    & itParams . gunBarrels . brlInaccuracy .~ 0.06
---    & itUse . useDelay . rateMax .~ 18
---    & itUse . useMods .~
---        [ ammoHammerCheck
---        , useTimeCheck
---        , sideEffectOnFrame 9 (torqueSideEffect 0.4)
---        , lockInvFor 9
---        , \f it -> repeatOnFrames (take (_laLoaded (_itConsumption it) - 1) [2,4,6,8]) f it
---        , withSoundStart tap3S
---        , useAmmoAmount 1
---        , applyInaccuracy
---        , withMuzFlareI
---        , withRecoil
---        ]
---completeBurstRifle :: Item
---completeBurstRifle = repeater
---    & itType . iyBase .~ COMPLETEBURSTRIFLE
---    & itType . iyModules . at ModRifleMag .~ Nothing
---    & itParams . gunBarrels . brlInaccuracy .~ 0.1
---    & itUse . useDelay . rateMax .~ 28
---    & itUse . useMods .~
---        [ ammoHammerCheck
---        , useTimeCheck
---        , sideEffectOnFrame 15 (torqueSideEffect 0.8)
---        , lockInvFor 15
---        , \f it -> repeatOnFrames (take (_laLoaded (_itConsumption it) - 1) [1..14]) f it
---        , withSoundStart tap3S
---        , useAmmoAmount 1
---        , applyInaccuracy
---        , withMuzFlareI
---        , withRecoil
---        ]
 miniGunUse :: Int -> ItemUse
-miniGunUse i = defaultrUse
+miniGunUse i =
+    defaultrUse
         & rUse .~ HeldUseAmmoParams
         & useDelay .~ NoDelay
         & useMods .~ MiniGunMod i
 
 miniGunX :: Int -> Item
-miniGunX i = defaultAutoGun 
+miniGunX i =
-    { _itConsumption = defaultBulletLoadable
+    defaultAutoGun
+        { _itConsumption =
+            defaultBulletLoadable
                 { _laMax = 1500
                 , _laLoaded = 1500
                 }
                 & laCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
-    , _itUse = miniGunUse i
+        , _itUse =
+            miniGunUse i
                 & useDelay .~ WarmUpNoDelay{_warmTime = 0, _warmMax = 100}
                 & useAim . aimWeight .~ 6
                 & useAim . aimRange .~ 1
                 & useAim . aimStance .~ TwoHandTwist
                 & useAim . aimZoom .~ defaultItZoom{_itZoomFac = 1.5}
---    , _itFloorPict = miniGunPictItem
+        , --    , _itFloorPict = miniGunPictItem
-    , _itParams = BulletShooter
+          _itParams =
+            BulletShooter
                 { _muzVel = 1
                 , _rifling = 0.9
                 , _bore = 2
-        , _gunBarrels = MultiBarrel 
+                , _gunBarrels =
+                    MultiBarrel
                         { _brlSpread = RotatingBarrels 0.01
                         , _brlNum = i
                         , _brlInaccuracy = 0

src/Dodge/Item/Weapon/TriggerType.hs

@@ -1,4 +1,4 @@
---{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections #-}
 {- |
 Weapon effects when pulling the trigger.  -}
 module Dodge.Item.Weapon.TriggerType
@@ -558,12 +558,12 @@ torqueSideEffect torque _ cr w
     (rot, g) = randomR (-torque,torque) $ _randGen w
 
 -- pump the updated creature into the chain in later frames
-repeatOnFrames :: [Int] -> ChainEffect
+repeatOnFrames :: [Int] -> HeldMod -> ChainEffect
-repeatOnFrames = const id
+--repeatOnFrames is hm f it cr w = f it cr w
---repeatOnFrames is f it cr w = f it cr w
+repeatOnFrames is hm f it cr w = f it cr $ w
---    & delayedEvents .++~ (is <&> (, f'))
+    & cWorld . delayedEvents .++~ (is <&> (, WdWdFromItCrixWdWd (it & itUse . useMods .~ hm)  (_crID cr) ItCrWdItemEffect))
 --  where
---    f' w' = fromMaybe w' $ do
+--    f' = fromMaybe w' $ do
 --        cr' <- w' ^? creatures . ix (_crID cr)
 --        return $ f it cr' w'
 

src/Dodge/Render/HUD.hs

@@ -141,7 +141,7 @@ subInventoryDisplay subinv cfig w = case subinv of
     equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
     f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
     rboptions = if ButtonRight `M.member` _mouseButtons w
-        then drawRBOptions cfig w (_rbOptions (_cWorld w))
+        then drawRBOptions cfig w (_rbOptions w)
         else mempty
 
 itmInfo :: Maybe Item -> [String]
@@ -187,7 +187,7 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a
   where
     midtext str = listTextPictureAt 252 0 cfig curpos (text str)
     extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
-    deactivatetext = case w ^? cWorld . rbOptions . opActivateEquipment . deactivateEquipment of
+    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
         Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
         Nothing -> ""
     curpos = invSelPos w
@@ -255,7 +255,7 @@ topCursorTypeWidth ctype width cfig w i
     = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
 
 determineInvSelCursorWidth :: World -> Int
-determineInvSelCursorWidth w = case _rbOptions (_cWorld w) of
+determineInvSelCursorWidth w = case _rbOptions w of
     NoRightButtonOptions -> topInvW
     EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w
         then 47

src/Dodge/Render/ShapePicture.hs

@@ -207,22 +207,22 @@ drawPathBetween w = setLayer DebugLayer
   where
     nodepos = (`getNodePos` w)
     nodelist = makePathBetween sp ep w
-    sp = _lSelect (_cWorld w)
+    sp = _lSelect w
-    ep = _rSelect (_cWorld w)
+    ep = _rSelect w
 
 drawNodesNearSelect :: World -> Picture
 drawNodesNearSelect w = setLayer DebugLayer 
     $  runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
     <> color green (drawCross sp)
   where
-    sp = _lSelect (_cWorld w)
+    sp = _lSelect w
 
 drawInspectWalls :: World -> Picture
 drawInspectWalls w = foldMap (drawInspectWall w) 
     $ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine)
     $ IM.elems $ _walls (_cWorld w)
   where
-    (a,b) = _lLine (_cWorld w)
+    (a,b) = _lLine w
 
 drawInspectWall :: World -> Wall -> Picture
 drawInspectWall w wl = setLayer DebugLayer
@@ -252,8 +252,8 @@ drawWorldSelect w = setLayer DebugLayer
     $  color cyan (line [a,b])
     <> color magenta (line [c,d])
   where
-    (a,b) = _lLine (_cWorld w)
+    (a,b) = _lLine w
-    (c,d) = _rLine (_cWorld w)
+    (c,d) = _rLine w
 
 drawFarWallDetect :: World -> Picture
 drawFarWallDetect w = setLayer DebugLayer 

src/Dodge/Update.hs

@@ -1,63 +1,64 @@
 {-# LANGUAGE BangPatterns #-}
+
 {- |
 Module      : Dodge.Update
 Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
-import Dodge.Magnet.Update
+
-import Dodge.TmTm
 import Color
-import Dodge.DrWdWd
+--import Dodge.Zone
-import Dodge.TractorBeam.Update
+
-import Dodge.Prop.Update
+import Control.Applicative
-import Dodge.LinearShockwave.Update
+import Data.List
-import Dodge.Shockwave.Update
+import qualified Data.Map.Strict as M
-import Dodge.Tesla.Arc
+import Data.Maybe
-import Dodge.Laser.Update
+import Dodge.Base
-import Dodge.PressPlate
-import Dodge.ModificationEffect
-import Dodge.CrGroupUpdate
-import Dodge.Zoning.Cloud
-import Dodge.Zoning.Creature
-import Dodge.WorldEffect
-import Dodge.Data
 import Dodge.Beam
-import Dodge.LightSource.Update
+import Dodge.Bullet
-import Dodge.Projectile.Update
+import Dodge.CrGroupUpdate
 import Dodge.Creature.Update
-import Dodge.RadarSweep
+import Dodge.CullBox
-import Dodge.PosEvent
+import Dodge.Data
-import Dodge.Spark
+import Dodge.Distortion
+import Dodge.DrWdWd
 import Dodge.EnergyBall
 import Dodge.Flame
-import Dodge.Bullet
-import Dodge.Update.Cloud
-import Dodge.Machine.Update
-import Dodge.RadarBlip
 import Dodge.Flare
-import Dodge.Menu
-import Dodge.CullBox
-import Dodge.Distortion
-import Dodge.SoundLogic
-import Dodge.Update.WallDamage
-import Dodge.Base
---import Dodge.Zone
 import Dodge.Hammer
-import Dodge.WallCreatureCollisions
-import Dodge.Update.Camera
 import Dodge.Inventory
-import Sound.Data
+import Dodge.Laser.Update
+import Dodge.LightSource.Update
+import Dodge.LinearShockwave.Update
+import Dodge.Machine.Update
+import Dodge.Magnet.Update
+import Dodge.Menu
+import Dodge.ModificationEffect
+import Dodge.PosEvent
+import Dodge.PressPlate
+import Dodge.Projectile.Update
+import Dodge.Prop.Update
+import Dodge.RadarBlip
+import Dodge.RadarSweep
+import Dodge.Shockwave.Update
+import Dodge.SoundLogic
+import Dodge.Spark
+import Dodge.Tesla.Arc
+import Dodge.TmTm
+import Dodge.TractorBeam.Update
+import Dodge.Update.Camera
+import Dodge.Update.Cloud
+import Dodge.Update.WallDamage
+import Dodge.WallCreatureCollisions
+import Dodge.WorldEffect
+import Dodge.Zoning.Cloud
+import Dodge.Zoning.Creature
 import Geometry
-import LensHelp
-import FoldableHelp
-
-import Data.List
-import Data.Maybe
 import qualified IntMapHelp as IM
-import qualified Data.Map.Strict as M
+import LensHelp
-import Control.Applicative
 --import qualified Streaming.Prelude as S
 import SDL
+import Sound.Data
 
 {- For most menus the only way to change the world is using event handling.  -}
 updateUniverse :: Universe -> Universe
@@ -65,18 +66,22 @@ updateUniverse u = case _menuLayers u of
     (WaitScreen s i : _)
         | i < 1 -> u & over uvWorld doWorldEvents
         | otherwise -> u & menuLayers %~ ((WaitScreen s (i -1) :) . tail)
-    (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~
+    (OptionScreen{_scOptionFlag = GameOverOptions} : _) ->
-        ( --updateParticles 
+        u & uvWorld
+            %~ (
+                 --updateParticles
                  (cWorld . radarBlips .~ [])
                     --        . updateIMl _props _pjUpdate
                     . updateLightSources
-        . updateClouds )
+                    . updateClouds
+               )
     (_ : _) -> u
     [] -> functionalUpdate u
 
-{- | The update step. -}
+-- | The update step.
 functionalUpdate :: Universe -> Universe
-functionalUpdate w = checkEndGame 
+functionalUpdate w =
+    checkEndGame
         --    . updateRandGen
         . over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
         . over uvWorld (cWorld . worldClock +~ 1)
@@ -131,35 +136,40 @@ functionalUpdate w = checkEndGame
         $ over uvWorld updateCloseObjects w
 
 doWorldEvents :: World -> World
-doWorldEvents w = foldr doWorldEffect (w & cWorld . worldEvents .~ []) (_worldEvents (_cWorld w))
+doWorldEvents w = foldr doWdWd (w & cWorld . worldEvents .~ []) (_worldEvents (_cWorld w))
 
 updateLasers :: World -> World
-updateLasers w = w'
+updateLasers w =
+    w'
         & cWorld . lasers .~ []
         & cWorld . lasersToDraw .~ ls
   where
     (w', ls) = mapAccumR updateLaser w (_lasers (_cWorld w))
 
 zoneClouds :: World -> World
-zoneClouds w = w 
+zoneClouds w =
+    w
         & cWorld . clZoning .~ mempty
         & cWorld . clZoning %~ \zn ->
             foldl' (flip zoneCloud) zn (_clouds (_cWorld w))
+
 --runIdentity (S.fold_ (flip $ updateZoning (:)) (zn & znObjects .~ mempty) id (_clouds w))
 
 updateWorldSelect :: World -> World
 updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of
     (Nothing, Nothing) -> w
-    (Just False,Nothing)  -> w & cWorld . lLine . _1 .~ mwp
+    (Just False, Nothing) -> w & lLine . _1 .~ mwp
-    (Just True ,Nothing)  -> w & cWorld . lLine . _2 .~ mwp
+    (Just True, Nothing) -> w & lLine . _2 .~ mwp
     (Nothing, _) -> w
-    (Just False,_)        -> w & cWorld . rLine . _1 .~ mwp
+    (Just False, _) -> w & rLine . _1 .~ mwp
-    (Just True ,_)        -> w & cWorld . rLine . _2 .~ mwp
+    (Just True, _) -> w & rLine . _2 .~ mwp
   where
     mwp = mouseWorldPos w
-    f   | ButtonLeft `M.member` _mouseButtons w  = cWorld . lSelect .~ mwp
+    f
+        | ButtonLeft `M.member` _mouseButtons w = lSelect .~ mwp
         | otherwise = id
-    g   | ButtonRight `M.member` _mouseButtons w = cWorld . rSelect .~ mwp
+    g
+        | ButtonRight `M.member` _mouseButtons w = rSelect .~ mwp
         | otherwise = id
 
 --mcChooseUpdate :: Machine -> Machine -> World -> World
@@ -175,21 +185,25 @@ tmUpdate :: Terminal -> World -> World
 tmUpdate tm w = case w ^? cWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
     Nothing -> w
     Just tl | _tlPause tl > 0 -> w & pointTermParams . tmFutureLines . ix 0 . tlPause -~ 1
-    Just (TerminalLineDisplay _ f) -> w & pointTermParams %~
+    Just (TerminalLineDisplay _ f) ->
-        ( ( tmFutureLines %~ tail )
+        w & pointTermParams
+            %~ ( (tmFutureLines %~ tail)
                     . (tmDisplayedLines .:~ displayTerminalLineString f w)
                )
-    Just (TerminalLineEffect _ eff) -> w
+    Just (TerminalLineEffect _ eff) ->
+        w
             & pointTermParams . tmFutureLines %~ tail
             & doTmWdWd eff tm
-    Just (TerminalLineTerminalEffect _ eff) -> w
+    Just (TerminalLineTerminalEffect _ eff) ->
+        w
             & pointTermParams . tmFutureLines %~ tail
             & pointTermParams %~ doTmTm eff
   where
     pointTermParams = cWorld . terminals . ix (_tmID tm)
 
 setOldPos :: Creature -> Creature
-setOldPos cr = cr
+setOldPos cr =
+    cr
         & crOldPos .~ _crPos cr
         & crOldDir .~ _crDir cr
 
@@ -199,18 +213,23 @@ setOldPos cr = cr
 
 doRewind :: World -> World
 doRewind w = case _maybeWorld (_cWorld w) of
-    Just' cw -> w & cWorld .~ (cw & timeFlow .~ RewindingLastFrame)
+    Just' cw ->
-    Nothing' -> w & cWorld . timeFlow .~ NormalTimeFlow
+        w & cWorld .~ cw
+            & timeFlow .~ RewindingLastFrame
+    Nothing' -> w & timeFlow .~ NormalTimeFlow
 
 zoneCreatures :: World -> World
-zoneCreatures w = w 
+zoneCreatures w =
+    w
         & cWorld . crZoning .~ mempty
         & cWorld . crZoning %~ \zn -> foldl' (flip zoneCreature) zn (_creatures (_cWorld w))
+
 --        foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
 --            zn (_creatures w)
 
 updateCreatureSoundPositions :: World -> World
-updateCreatureSoundPositions w = M.foldlWithKey' insertSound w 
+updateCreatureSoundPositions w =
+    M.foldlWithKey' insertSound w
         . M.mapMaybeWithKey updateSound
         $ _playingSounds w
   where
@@ -229,8 +248,9 @@ updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
 updateIMl' fim fup w = foldl' (flip fup) w (fim w)
 
 updateCreatureGroups :: World -> World
-updateCreatureGroups w = w & cWorld . creatureGroups %~ 
+updateCreatureGroups w =
-    IM.mapMaybe (\cgp -> doCrGroupUpdate (_crGroupUpdate cgp) w cgp)
+    w & cWorld . creatureGroups
+        %~ IM.mapMaybe (\cgp -> doCrGroupUpdate (_crGroupUpdate cgp) w cgp)
 
 updateDistortions :: World -> World
 updateDistortions = cWorld . distortions %~ mapMaybe updateDistortion
@@ -256,7 +276,6 @@ updateTractorBeams w = w' & cWorld . tractorBeams .~ catMaybes newtas
   where
     (w', newtas) = mapAccumR updateTractorBeam w $ _tractorBeams (_cWorld w)
 
-
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateBullets :: World -> World
 updateBullets w = updateInstantBullets $ set (cWorld . bullets) (catMaybes ps) w'
@@ -277,6 +296,7 @@ updateEnergyBalls :: World -> World
 updateEnergyBalls w = w' & cWorld . energyBalls .~ catMaybes newebs
   where
     (w', newebs) = mapAccumR moveEnergyBall w $ _energyBalls (_cWorld w)
+
 updateRadarSweeps :: World -> World
 updateRadarSweeps w = w' & cWorld . radarSweeps .~ catMaybes newradarSweeps
   where
@@ -286,19 +306,20 @@ updateSparks :: World -> World
 updateSparks w = w' & cWorld . sparks .~ catMaybes newsparks
   where
     (w', newsparks) = mapAccumR moveSpark w $ _sparks (_cWorld w)
+
 updatePosEvents :: World -> World
 updatePosEvents w = w' & cWorld . posEvents .~ catMaybes newposEvents
   where
     (w', newposEvents) = mapAccumR updatePosEvent w $ _posEvents (_cWorld w)
 
-
 {- Apply internal particle updates, delete 'Nothing's.  -}
 --updateParticles :: World -> World
 --updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
 --  where
 --    (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
 updateBeams :: World -> World
-updateBeams w = w
+updateBeams w =
+    w
         & cWorld . newBeams .~ WorldBeams [] [] [] []
         & cWorld . beams .~ thebeams
         & combineBeams thebeams
@@ -306,7 +327,8 @@ updateBeams w = w
     thebeams = _newBeams (_cWorld w)
 
 combineBeams :: WorldBeams -> World -> World
-combineBeams wbeams w = w'' 
+combineBeams wbeams w =
+    w''
         & cWorld . beams . positronBeams .~ pbeams
         & cWorld . beams . electronBeams .~ ebeams
   where
@@ -320,8 +342,10 @@ combineBeamBeams bms w bm = case intersectBeamBeams bm bms of
 
 -- intersect a beam with a list of beams.
 -- returns the (reversed) travel of the beam up to maybe an intersection point
-intersectBeamBeams :: Beam -> [Beam] 
+intersectBeamBeams ::
-    -> ([Point2], Maybe (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)))
+    Beam ->
+    [Beam] ->
+    ([Point2], Maybe (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)))
 intersectBeamBeams bm bms = f [] $ _bmPoints bm
   where
     f ps (x : y : ys) = case intersectSegBeams x y bms of
@@ -370,7 +394,8 @@ intersectSegSegs' _ _ _ = Nothing
 updateInstantBullets :: World -> World
 updateInstantBullets w = case _instantBullets (_cWorld w) of
     [] -> w
-    ps -> let (w',ps') = mapAccumR updateBullet (w & cWorld . instantBullets.~[]) ps
+    ps ->
+        let (w', ps') = mapAccumR updateBullet (w & cWorld . instantBullets .~ []) ps
          in updateInstantBullets $ w' & cWorld . bullets .++~ catMaybes ps'
 
 --updateInstantParticles :: World -> World
@@ -399,6 +424,7 @@ ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ _p
 
 updateSeenWalls :: World -> World
 updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
+
 --  where
 --    f w' !i -- = w' & walls . ix i . wlSeen .~ True
 --        = w' { _walls = IM.adjust mw i $ _walls w' }
@@ -412,7 +438,9 @@ markSeen wl = wl {_wlSeen = True}
 
 checkEndGame :: Universe -> Universe
 checkEndGame uv = case _deathDelay (_cWorld w) of
-    Just x | x < 0 -> uv & menuLayers .~ [gameOverMenu]
+    Just x
+        | x < 0 ->
+            uv & menuLayers .~ [gameOverMenu]
                 & uvWorld . cWorld . deathDelay .~ Nothing
     Just _ -> uv & uvWorld . cWorld . deathDelay . _Just -~ 1
     _ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . deathDelay ?~ 50
@@ -426,9 +454,12 @@ updateGusts w = w & cWorld . gusts %~ IM.mapMaybe (mvGust w)
 mvGust :: World -> Gust -> Maybe Gust
 mvGust _ gu
     | _guTime gu < 0 = Nothing
-    | otherwise      = Just $ gu
+    | otherwise =
+        Just $
+            gu
                 & guPos .+.+~ _guVel gu
                 & guTime -~ 1
+
 updateClouds :: World -> World
 updateClouds w = w' & cWorld . clouds .~ catMaybes mclouds
   where
@@ -443,7 +474,10 @@ cloudEffect cl = case _clType cl of
 updateCloud :: World -> Cloud -> (World, Maybe Cloud)
 updateCloud w c
     | _clTimer c < 1 = (w, Nothing)
-    | otherwise = (cloudEffect c w, Just $ c
+    | otherwise =
+        ( cloudEffect c w
+        , Just $
+            c
                 & clPos .~ finalPos
                 & clVel .~ finalVel
                 & clTimer -~ 1
@@ -485,8 +519,9 @@ crCrSpring c1 c2
     | id1 == id2 = id
     | vec == V2 0 0 = id
     | diff >= comRad = id
-    | otherwise = cWorld . creatures %~
+    | otherwise =
-        ( over (ix id1 . crPos) (+.+ overlap1)
+        cWorld . creatures
+            %~ ( over (ix id1 . crPos) (+.+ overlap1)
                     . over (ix id2 . crPos) (-.- overlap2)
                )
   where
@@ -500,7 +535,8 @@ crCrSpring c1 c2
     massT = _crMass c1 + _crMass c2
 
 updateDelayedEvents :: World -> World
-updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents (_cWorld w))
+updateDelayedEvents w =
+    let (neww, newde) = mapAccumR f w (_delayedEvents (_cWorld w))
      in neww & cWorld . delayedEvents .~ catMaybes newde
   where
     f w' (i, g)

src/Dodge/Update/UsingInput.hs

@@ -53,10 +53,10 @@ updatePressedButtons' :: M.Map MouseButton Bool -> World -> World
 updatePressedButtons' pkeys w 
     | isDown ButtonLeft && isDown ButtonRight && inTopInv 
         = useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown
-    | isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame)
+    | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
             && w ^?! hammers . ix DoubleMouseHam == HammerUp
         = useLeftItem (_yourID (_cWorld w)) w
-    | isDown ButtonLeft && (inTopInv || _timeFlow (_cWorld w) == RewindingLastFrame)
+    | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
         = w & hammers . ix DoubleMouseHam .~ HammerDown
     | isDown ButtonRight && inTopInv = w
     | isDown ButtonMiddle 

src/Dodge/WorldEffect.hs

@@ -1,43 +1,58 @@
 module Dodge.WorldEffect where
-import Dodge.Terminal
-import Dodge.SoundLogic
-import Dodge.WorldEvent.Cloud
-import Dodge.Data
-import Dodge.Inventory.Lock
-import Dodge.Default
-import LensHelp
 
-import Data.Maybe
 import Data.Foldable
 import qualified Data.Map.Strict as M
+import Data.Maybe
+import Dodge.Creature.Impulse.UseItem
+import Dodge.Data
+import Dodge.Default
+import Dodge.Inventory.Lock
+import Dodge.Item.Location
+import Dodge.SoundLogic
+import Dodge.Terminal
+import Dodge.WorldEvent.Cloud
 import qualified IntMapHelp as IM
-
+import LensHelp
 import System.Random
 
-doWorldEffect :: WdWd -> World -> World
+doWdWd :: WdWd -> World -> World
-doWorldEffect we = case we of
+doWdWd we = case we of
     NoWorldEffect -> id
     SetTrigger bool tid -> cWorld . triggers . ix tid .~ bool
     SetLSCol col lsid -> cWorld . lightSources . ix lsid . lsParam . lsCol .~ col
     AccessTerminal mtmid -> accessTerminal mtmid
-    WorldEffects wes -> \w -> foldr doWorldEffect w wes
+    WorldEffects wes -> \w -> foldr doWdWd w wes
     UnlockInv cid -> unlockInv cid
     MakeStartCloudAt p -> makeStartCloudAt p
     TorqueCr x cid -> torqueCr x cid
     SoundStart so p sid mi -> soundStart so p sid mi
     WdWdNegateTrig trid -> cWorld . triggers . ix trid %~ not
+    WdWdFromItixCrixWdWd itid crid f -> \w -> fromMaybe w $ do
+        cr <- w ^? cWorld . creatures . ix crid
+        it <- getItem itid w
+        return $ doItCrWdWd f it cr w
+    WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
+        cr <- w ^? cWorld . creatures . ix crid
+        return $ doItCrWdWd f it cr w
+
+doItCrWdWd :: ItCrWdWd -> Item -> Creature -> World -> World
+doItCrWdWd icww = case icww of
+    ItCrWdId -> \_ _ -> id
+    ItCrWdItemEffect -> flip itemEffect
 
 accessTerminal :: Maybe Int -> World -> World
 accessTerminal mtmid w = case mtmid of
     Nothing -> w
-    Just tmid -> w & cWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
+    Just tmid ->
+        w & cWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
             & cWorld . terminals . ix tmid . tmInput . tiFocus .~ True
             & cWorld . terminals . ix tmid %~ tryToBoot
       where
         tryToBoot tm = case _tmStatus tm of
             TerminalReady -> tm
             TerminalBusy -> tm
-            TerminalOff -> tm
+            TerminalOff ->
+                tm
                     & tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w
                     & tmStatus .~ TerminalBusy
 
@@ -48,9 +63,6 @@ torqueCr x cid w
   where
     (rot, g) = randomR (- x, x) $ _randGen w
 
-
-
-
 doCommandInstant :: String -> Terminal -> World -> World
 doCommandInstant arg tm w = doLineEffectsInstant tm w $ commandFutureLines arg tm w
 
@@ -62,9 +74,9 @@ doLineEffectsInstant tm = foldr f
         TerminalLineEffect _ eff -> doTmWdWd eff tm w
         _ -> w
 
-
 lineOutputTerminal :: [TerminalLine] -> Terminal
-lineOutputTerminal tls = defaultTerminal
+lineOutputTerminal tls =
+    defaultTerminal
         { _tmDisplayedLines = []
         , _tmFutureLines = []
         , _tmMaxLines = 14
@@ -77,10 +89,12 @@ lineOutputTerminal tls = defaultTerminal
         }
 
 doDeathTriggers :: Terminal -> World -> World
-doDeathTriggers tm w = w
+doDeathTriggers tm w =
+    w
         & cWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
   where
     xs = M.elems $ _tmToggles tm
+
 doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
 doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f
 
@@ -90,20 +104,17 @@ doBlBl bb = case bb of
     BlConst bl -> const bl
     BlId -> id
 
-
 doTerminalBootProgram :: TerminalBootProgram -> Terminal -> World -> [TerminalLine]
 doTerminalBootProgram tbp = case tbp of
     TerminalBootMempty -> \_ _ -> []
     TerminalBootLines ls -> \_ _ -> ls
 
-
-
 doTmWdWd :: TmWdWd -> Terminal -> World -> World
 doTmWdWd tmwdwd = case tmwdwd of
     TmWdId -> const id
     TmWdWdDisconnectTerminal -> disconnectTerminal
-    TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? cWorld . buttons . ix (_tmButtonID tm) . btPos
+    TmWdWdTermSound sid -> \tm w ->
+        let tpos = fromMaybe 0 $ w ^? cWorld . buttons . ix (_tmButtonID tm) . btPos
          in soundStart TerminalSound tpos sid Nothing w
     TmWdWdDoDeathTriggers -> doDeathTriggers
-    TmWdWdfromWdWd f -> \_ -> doWorldEffect f
+    TmWdWdfromWdWd f -> \_ -> doWdWd f
-