Commit AFTER playing around with poking/vector sizing a little

ghcidOutput

@@ -1 +1,5 @@
-All good (604 modules, at 10:33:02)
+/home/justin/Haskell/loop/src/Shader/Parameters.hs:9:1-19: warning: [-Wunused-imports]
+    The import of ‘Picture.Data’ is redundant
+  |
+9 | import Picture.Data
+  | ^^^^^^^^^^^^^^^^^^^

src/Dodge/Creature/Impulse/Movement.hs

@@ -27,7 +27,7 @@ crMvAbsolute p' cr =
         & crPos %~ (+.+ p)
         & crMvDir .~ argV p
   where
-    p = strengthFactor (getCrStrength cr) *.* p'
+    p = strengthFactor (getCrMoveSpeed cr) *.* p'
 
 strengthFactor :: Int -> Float
 strengthFactor i

src/Dodge/Creature/Statistics.hs

@@ -1,5 +1,5 @@
 module Dodge.Creature.Statistics (
-    getCrStrength,
+    getCrMoveSpeed,
     getCrDexterity,
 ) where
 
@@ -13,8 +13,8 @@ import LensHelp
 getCrDexterity :: Creature -> Int
 getCrDexterity cr = _dexterity (_crStatistics cr)
 
-getCrStrength :: Creature -> Int
+getCrMoveSpeed :: Creature -> Int
-getCrStrength cr = strFromHeldItem cr + strFromEquipment cr + _strength (_crStatistics cr)
+getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + _strength (_crStatistics cr)
 
 strFromEquipment :: Creature -> Int
 strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment

src/Dodge/Data/Creature.hs

@@ -56,7 +56,6 @@ data Creature = Creature
     , _crInvLock :: Bool
     , _crInvEquipped :: IM.IntMap EquipPosition
     , _crEquipment :: M.Map EquipPosition Int
---    , _crLeftInvSel :: LeftInvSel
     , _crInvHotkeys :: IM.IntMap Hotkey
     , _crHotkeys :: M.Map Hotkey Int
     , _crState :: CreatureState

src/Dodge/HeldUse.hs

@@ -1,72 +1,60 @@
 {-# LANGUAGE TupleSections #-}
-module Dodge.HeldUse 
+
-    (heldEffect
+module Dodge.HeldUse (
-    , mcUseHeld
+    heldEffect,
-    )
+    mcUseHeld,
-    where
+) where
 
 import Color
-import Dodge.Base.Coordinate
+import Data.Maybe
 import Dodge.Base.Collide
-import Dodge.Inventory.Lock
+import Dodge.Base.Coordinate
---import Dodge.WorldEvent.Cloud
+import Dodge.Creature.HandPos
-import Dodge.LightSource
-import qualified SDL
---import Dodge.Base.You
-import Dodge.Data.MuzzleEffect
-import ListHelp
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
---import Color
+import Dodge.Data.MuzzleEffect
-import Data.Maybe
---import Data.Traversable
---import Dodge.Base.Coordinate
---import Dodge.Bullet
-import Dodge.Creature.HandPos
 import Dodge.Data.World
 import Dodge.Gas
---import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Inventory.Lock
---import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.Radar
 import Dodge.Item.Weapon.Shatter
 import Dodge.Item.Weapon.TriggerType
+import Dodge.LightSource
 import Dodge.Projectile.Create
 import Dodge.SoundLogic
 import Dodge.Tesla.Arc
---import Dodge.Wall.ForceField
---import Dodge.Wall.Move
 import Dodge.WorldEvent.Flash
 import Geometry
---import qualified IntMapHelp as IM
 import LensHelp
+import ListHelp
 import RandomHelp
---import Sound.Data
+import qualified SDL
---import Data.Foldable
 
 heldEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 heldEffect = hammerCheck $ useTimeCheck heldEffectMuzzles
 
 heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
-heldEffectMuzzles t cr w = uncurry (applyCME (_ldtValue t) cr) cmew
+heldEffectMuzzles t cr w =
+    uncurry (applyCME (_ldtValue t) cr) cmew
         & cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles
         & doWeaponRepetitions upitm cr
   where
     muzzles = t ^. ldtValue . itUse . heldAim . aimMuzzles
-    (upitm,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
+    (upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles
-    cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
+    cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False, w) $ zip [0 ..] loadedmuzzles
-    
 
 -- need to be careful about inventory lock or item ids here
 doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponRepeat of
-    Just (x:xs) -> cWorld . lWorld . delayedEvents .++~ ((x:xs) <&> (,WdWdFromItCrixWdWd upitm (_crID cr) ItCrWdItemEffect))
+    Just (x : xs) -> cWorld . lWorld . delayedEvents .++~ ((x : xs) <&> (,WdWdFromItCrixWdWd upitm (_crID cr) ItCrWdItemEffect))
     _ -> id
   where
-    upitm = itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
+    upitm =
-        & ldtValue . itUse . heldTriggerType .~ AutoTrigger
+        itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
+            & ldtValue . itUse . heldTriggerType .~ AutoTrigger
 
 applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
-applyCME itm cr cme 
+applyCME itm cr cme
     | _cmeSound cme = applyInvLock itm cr . applySoundCME itm cr . applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr
     | otherwise = failsound
   where
@@ -77,18 +65,20 @@ applyCME itm cr cme
 
 applyInvLock :: Item -> Creature -> World -> World
 applyInvLock itm cr = case itm ^? itUse . heldParams . weaponInvLock of
-    Just i | i > 0 -> (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
+    Just i
-                        . lockInv cid
+        | i > 0 ->
+            (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
+                . lockInv cid
     _ -> id
   where
     cid = _crID cr
 
 applySoundCME :: Item -> Creature -> World -> World
 applySoundCME itm cr = fromMaybe id $ do
-    (soundid,x) <- itm ^? itUse . heldParams . bulGunSound . _Just
+    (soundid, x) <- itm ^? itUse . heldParams . bulGunSound . _Just
-    if x > 0 
+    if x > 0
         then return $ soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just x)
-        else return $ soundMultiFrom [CrWeaponSound cid j | j <- [0..5]] (_crPos cr) soundid Nothing
+        else return $ soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing
   where
     cid = _crID cr
 
@@ -101,40 +91,45 @@ applyRecoil itm cr = over (cWorld . lWorld . creatures . ix cid) pushback
 
 applySidePush :: Float -> Creature -> World -> World
 applySidePush 0 _ w = w
-applySidePush maxSide cr w = w
+applySidePush maxSide cr w =
-            & cWorld . lWorld . creatures . ix cid %~ push
+    w
-            & randGen .~ g
+        & cWorld . lWorld . creatures . ix cid %~ push
+        & randGen .~ g
   where
     cid = _crID cr
     push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
     (pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w
 
 applyTorqueCME :: Item -> Creature -> World -> World
-applyTorqueCME itm cr w 
+applyTorqueCME itm cr w
-    | cid == 0 = w
+    | cid == 0 =
-        & wCam . camRot -~ rot
+        w
-        & cWorld . lWorld . creatures . ix cid . crDir +~ rot
+            & wCam . camRot -~ rot
-        & randGen .~ g
+            & cWorld . lWorld . creatures . ix cid . crDir +~ rot
-    | otherwise = w
+            & randGen .~ g
-        & cWorld . lWorld . creatures . ix cid . crDir +~ rot
+    | otherwise =
-        & randGen .~ g
+        w
+            & cWorld . lWorld . creatures . ix cid . crDir +~ rot
+            & randGen .~ g
   where
     cid = _crID cr
     (rot, g) = randomR (- torque, torque) $ _randGen w
     torque = fromMaybe 0 $ itm ^? itUse . heldParams . torqueAfter
 
 -- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
-loadMuzzle :: LabelDoubleTree ComposeLinkType Item 
+loadMuzzle ::
-    -> Muzzle 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> (LabelDoubleTree ComposeLinkType Item,Maybe (Muzzle, Int,LabelDoubleTree ComposeLinkType Item))
+    Muzzle ->
-loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,Nothing) $ do
+    (LabelDoubleTree ComposeLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item))
+loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
     let as = _mzAmmoSlot mz
         amamount = 1
-    (i,(_,mag)) <- findWithIx (isAmmoIntLink as . fst) l
+    (i, (_, mag)) <- findWithIx (isAmmoIntLink as . fst) l
     availableammo <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
     let usedammo = min amamount availableammo
     guard $ usedammo > 0
-    return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
+    return
+        ( t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
         , Just (mz, usedammo, mag)
         )
 
@@ -142,14 +137,18 @@ makeMuzzleFlare :: Muzzle -> LabelDoubleTree ComposeLinkType Item -> Creature ->
 makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
     DefaultFlareType -> id
     PistolFlare -> basicMuzFlare pos dir
-    MiniGunFlare -> makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
+    MiniGunFlare ->
-        . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
+        makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
+            . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
     HeavySmokeFlare -> basicMuzFlare pos dir
-    LasGunFlare -> flareCircleAt (getLaserColor itmtree) 0.8 (pos `v2z` 20)
+    LasGunFlare ->
-        . (cWorld . lWorld . tempLightSources .:~ 
+        flareCircleAt (getLaserColor itmtree) 0.8 (pos `v2z` 20)
-            tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10))
+            . ( cWorld . lWorld . tempLightSources
-    TeslaGunFlare -> cWorld . lWorld . tempLightSources .:~ 
+                    .:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10)
-            tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
+              )
+    TeslaGunFlare ->
+        cWorld . lWorld . tempLightSources
+            .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
   where
     itm = itmtree ^. ldtValue
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
@@ -165,47 +164,35 @@ getLaserColor :: LabelDoubleTree ComposeLinkType Item -> Color
 getLaserColor = const yellow
 
 basicMuzFlare :: Point2 -> Float -> World -> World
-basicMuzFlare pos dir = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
+basicMuzFlare pos dir =
+    makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
+        . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
-        . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir 
 
----- need to add these to muzzle flare?
---makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
---makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
---    DefaultFlareType -> w
---    PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps
---    MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w
---    HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps'
---    LasGunFlare -> w
---    TeslaGunFlare -> w
---  where
---    ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w
---    ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w
---    pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
-----        , withSmoke 1 black 20 200 5
 
 isAmmoIntLink :: Int -> ComposeLinkType -> Bool
 isAmmoIntLink i (AmmoInLink j _) = i == j
 isAmmoIntLink _ _ = False
 
-useLoadedAmmo :: LabelDoubleTree ComposeLinkType Item 
+useLoadedAmmo ::
-    -> Creature 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> (CumulativeMuzzleEffect,World) 
+    Creature ->
-    -> (Int,Maybe (Muzzle,Int,LabelDoubleTree ComposeLinkType Item)) 
+    (CumulativeMuzzleEffect, World) ->
-    -> (CumulativeMuzzleEffect,World)
+    (Int, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item)) ->
-useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
+    (CumulativeMuzzleEffect, World)
-useLoadedAmmo itmtree cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $ 
+useLoadedAmmo _ _ (cme, w) (_, Nothing) = (cme, w)
-        removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of
+useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cmeSound .~ True) $
-    MuzzleShootBullet -> shootBullet itmtree cr (mz,x,magtree) w
+    removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of
-    MuzzleLaser -> shootLaser itmtree cr mz w
+        MuzzleShootBullet -> shootBullet itmtree cr (mz, x, magtree) w
-    MuzzleTesla -> shootTeslaArc itm cr mz w
+        MuzzleLaser -> shootLaser itmtree cr mz w
-    MuzzleTractor -> shootTractorBeam cr w
+        MuzzleTesla -> shootTeslaArc itm cr mz w
-    MuzzleLauncher -> createProjectile magtree mz itmtree cr w 
+        MuzzleTractor -> shootTractorBeam cr w
-    MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
+        MuzzleLauncher -> createProjectile magtree mz itmtree cr w
-    MuzzleShatter -> shootShatter itm cr w
+        MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
-    MuzzleForceField -> useForceFieldGun itm cr w
+        MuzzleShatter -> shootShatter itm cr w
-    MuzzleDetector -> itemDetectorEffect itm cr w 
+        MuzzleForceField -> useForceFieldGun itm cr w
+        MuzzleDetector -> itemDetectorEffect itm cr w
   where
     mid = magtree ^? ldtValue . itLocation . ilInvID
     itm = itmtree ^. ldtValue
@@ -218,17 +205,24 @@ itemDetectorEffect itm cr w = fromMaybe w $ do
 walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
 walkNozzle mzid mz itm cr w = fromMaybe w $ do
     invid <- itm ^? itLocation . ilInvID
-    return $ w
+    return $
-        & cWorld . lWorld . creatures . ix (_crID cr) . crInv 
+        w
-            . ix invid . itUse . heldAim . aimMuzzles . ix mzid . mzEffect . nzCurrentWalkAngle .~ wa
+            & cWorld . lWorld . creatures . ix (_crID cr) . crInv
-        & randGen .~ g
+                . ix invid
+                . itUse
+                . heldAim
+                . aimMuzzles
+                . ix mzid
+                . mzEffect
+                . nzCurrentWalkAngle
+                .~ wa
+            & randGen .~ g
   where
     nz = _mzEffect mz
     (walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
     aspeed = _nzWalkSpeed nz
     maxa = _nzMaxWalkAngle nz
     wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
-    
 
 shootTractorBeam :: Creature -> World -> World
 shootTractorBeam cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
@@ -251,21 +245,22 @@ tractorBeamAt pos outpos dir power =
   where
     d = unitVectorAtAngle dir * power
 
-shootLaser :: LabelDoubleTree ComposeLinkType Item  -> Creature -> Muzzle -> World -> World
+shootLaser :: LabelDoubleTree ComposeLinkType Item -> Creature -> Muzzle -> World -> World
-shootLaser itmtree cr mz w = w 
+shootLaser itmtree cr mz w =
-    & randGen .~ g
+    w
-    & cWorld . lWorld . lasers
+        & randGen .~ g
-        .:~ LaserStart
+        & cWorld . lWorld . lasers
-            { _lpType = getLaserDamage itmtree
+            .:~ LaserStart
-            , _lpPhaseV = getLaserPhaseV itmtree
+                { _lpType = getLaserDamage itmtree
-            , _lpPos = pos
+                , _lpPhaseV = getLaserPhaseV itmtree
-            , _lpDir = dir
+                , _lpPos = pos
-            , _lpColor = getLaserColor itmtree
+                , _lpDir = dir
-            }
+                , _lpColor = getLaserColor itmtree
+                }
   where
     itm = itmtree ^. ldtValue
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
-    (a,g) = randomR (-inacc,inacc) $ _randGen w
+    (a, g) = randomR (- inacc, inacc) $ _randGen w
     inacc = _mzInaccuracy mz
     dir = _crDir cr + _mzRot mz + a
 
@@ -282,22 +277,24 @@ lasRayAt col dam phasev pos dir =
 removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
 removeAmmoFromMag x mid cr = fromMaybe id $ do
     magid <- mid
-    return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
+    return $ cWorld . lWorld . creatures 
+        . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
 
-getBulletType :: LabelDoubleTree ComposeLinkType Item 
+getBulletType ::
-    -> LabelDoubleTree ComposeLinkType Item 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> Muzzle
+    LabelDoubleTree ComposeLinkType Item ->
-    -> Creature
+    Muzzle ->
-    -> World
+    Creature ->
-    -> Maybe Bullet
+    World ->
-getBulletType itmtree magtree mz cr w = magtree ^? ldtValue . itUse . amagParams . ampBullet
+    Maybe Bullet
-    <&> buTrajectory .~ btraj
+getBulletType itmtree magtree mz cr w =
-    <&> buPayload .~ bpayload
+    magtree ^? ldtValue . itUse . amagParams . ampBullet
-    <&> buEffect .~ beffect
+        <&> buTrajectory .~ btraj
+        <&> buPayload .~ bpayload
+        <&> buEffect .~ beffect
   where
-    -- consider modifying other parameters here too
     btraj = fromMaybe BasicBulletTrajectory $ do
-        targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
+        targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these?
         tp <- targetingtree ^? ldtValue . itUse . tgPos . _Just
         attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
         bt <- attree ^? ldtValue . itUse . buMod . bmTrajectory
@@ -309,8 +306,14 @@ getBulletType itmtree magtree mz cr w = magtree ^? ldtValue . itUse . amagParams
         attree <- lookup AmmoEffectLink (magtree ^. ldtLeft)
         attree ^? ldtValue . itUse . buMod . bmEffect
 
-getBulletTrajectory :: Muzzle -> Item 
+getBulletTrajectory ::
-    -> BulletTrajectoryType -> Point2 -> Creature -> World -> BulletTrajectory
+    Muzzle ->
+    Item ->
+    BulletTrajectoryType ->
+    Point2 ->
+    Creature ->
+    World ->
+    BulletTrajectory
 getBulletTrajectory mz itm bt tp cr w = case bt of
     BasicBulletTrajectoryType -> BasicBulletTrajectory
     FlechetteTrajectoryType -> FlechetteTrajectory tp
@@ -319,48 +322,45 @@ getBulletTrajectory mz itm bt tp cr w = case bt of
   where
     bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
     offset = case itm ^? itUse . heldParams . randomOffset of
-        Just x | x /= 0 -> fst . randomR (-x,x) $ _randGen w
+        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
         _ -> 0
-    
 
-shootBullet :: LabelDoubleTree ComposeLinkType Item 
+shootBullet ::
-    -> Creature 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> (Muzzle,Int,LabelDoubleTree ComposeLinkType Item ) 
+    Creature ->
-    -> World 
+    (Muzzle, Int, LabelDoubleTree ComposeLinkType Item) ->
-    -> World
+    World ->
-shootBullet itmtree cr (mz,x,magtree) w = fromMaybe w $ do
+    World
-    -- should be able to pass the magazine in from elsewhere?
+shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
     thebullet <- getBulletType itmtree magtree mz cr w
     return $ flip (foldl' (&)) (replicate x (makeBullet thebullet (itmtree ^. ldtValue) cr mz)) w
---            & makeMuzzleFlare mz itm cr
+
 --            & makeMuzzleSmoke mz itm cr
---  where
---    cid = _crID cr
 
 -- the random generator is not updated here, not sure if that is a problem
 makeBullet :: Bullet -> Item -> Creature -> Muzzle -> World -> World
 makeBullet thebullet itm cr mz w =
-        w & randGen .~ g
+    w & randGen .~ g
-            & cWorld . lWorld . instantBullets
+        & cWorld . lWorld . instantBullets
-                .:~ (thebullet
+            .:~ ( thebullet
-                & buPos .~ bulpos
+                    & buPos .~ bulpos
---                & buTrajectory .~ BasicBulletTrajectory
+                    --                & buTrajectory .~ BasicBulletTrajectory
-                & buVel %~ (rotateV dir . (muzvel *.*))
+                    & buVel %~ (rotateV dir . (muzvel *.*))
-                & buDrag *~ drag
+                    & buDrag *~ drag
-            )
+                )
   where
     bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
-    (a,g'') = randomR (-inacc,inacc) $ _randGen w
+    (a, g'') = randomR (- inacc, inacc) $ _randGen w
     inacc = _mzInaccuracy mz
-    (drag,g') = case _rifling (_heldParams $ _itUse itm) of
+    (drag, g') = case _rifling (_heldParams $ _itUse itm) of
-        ConstFloat x -> (x,g'')
+        ConstFloat x -> (x, g'')
-        UniRandFloat x y -> randomR (x,y) g''
+        UniRandFloat x y -> randomR (x, y) g''
-    (muzvel,g) = case _muzVel $ _heldParams $ _itUse itm of
+    (muzvel, g) = case _muzVel $ _heldParams $ _itUse itm of
-        ConstFloat x -> (x,g')
+        ConstFloat x -> (x, g')
-        UniRandFloat x y -> randomR (x,y) g'
+        UniRandFloat x y -> randomR (x, y) g'
     dir = _crDir cr + _mzRot mz + a
     offset = case itm ^? itUse . heldParams . randomOffset of
-        Just x | x /= 0 -> fst . randomR (-x,x) $ _randGen w
+        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
         _ -> 0
 
 mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
@@ -382,16 +382,18 @@ useGasParams mmagid mz itm cr w =
         pos
         dir
         cr
-        w & randGen .~ g'
+        w
+        & randGen
+        .~ g'
   where
-    (pressure,g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
+    (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
     gastype = fromMaybe (error "cannot find gas ammo") $ do
         magid <- mmagid
         fueltype <- cr ^? crInv . ix magid . itUse . amagParams . ampCreateGas
         gc <- itm ^? itUse . heldParams . gasCreation
         return $ gasCreate fueltype gc
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
-    (a,g') = randomR (-inacc,inacc) g
+    (a, g') = randomR (- inacc, inacc) g
     inacc = _mzInaccuracy mz
     dir = _crDir cr + _mzRot mz + a + _nzCurrentWalkAngle (_mzEffect mz)
 
@@ -399,8 +401,8 @@ gasCreate :: GasFuel -> GasCreate -> GasCreate
 gasCreate = const id
 
 doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
-doGenFloat (ConstFloat x) g = (x,g)
+doGenFloat (ConstFloat x) g = (x, g)
-doGenFloat (UniRandFloat x y) g = randomR (x,y) g
+doGenFloat (UniRandFloat x y) g = randomR (x, y) g
 
 --caneStickSoundChoice :: Item -> SoundID
 --caneStickSoundChoice _ = tap3S
@@ -447,6 +449,7 @@ shootTeslaArc itm cr mz w =
 -- TODO investigate more and fix
 useForceFieldGun :: Item -> Creature -> World -> World
 useForceFieldGun _ _ = id
+
 --useForceFieldGun itm cr w = fromMaybe w $ do
 --    a <- cr ^? crTargeting . ctPos . _Just
 --    let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
@@ -460,31 +463,50 @@ useForceFieldGun _ _ = id
 --  where
 --    i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
 
-determineProjectileTracking :: LabelDoubleTree ComposeLinkType Item 
+determineProjectileTracking ::
-    -> LabelDoubleTree ComposeLinkType Item
+    LabelDoubleTree ComposeLinkType Item ->
-    -> ProjectileHoming
+    LabelDoubleTree ComposeLinkType Item ->
+    ProjectileHoming
 determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magtree ^. ldtLeft) of
-    Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID) 
+    Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID)
     Nothing -> fromMaybe NoHoming $ do
         _ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- should not have to give a direction
         targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
         return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
 
-createProjectile 
+createProjectile ::
-    :: LabelDoubleTree ComposeLinkType Item 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> Muzzle 
+    Muzzle ->
-    -> LabelDoubleTree ComposeLinkType Item 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> Creature -> World -> World
+    Creature ->
+    World ->
+    World
 createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
     magid <- magtree ^? ldtValue . itLocation . ilInvID
     ammoitem <- cr ^? crInv . ix magid
     let homing = determineProjectileTracking magtree itmtree
     aparams <- ammoitem ^? itUse . amagParams . ampPayload
-    return $ createShell homing aparams muz cr 
+    return $
-        . startthesound
+        createShell homing aparams muz cr
+            . startthesound
   where
     -- the sound should be moved to the projectile firing
-    startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0..3]] (_crPos cr) tap4S Nothing 
+    startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0 .. 3]] (_crPos cr) tap4S Nothing
     failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
         Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
         _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
+
+---- need to add these to muzzle flare?
+--makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
+--makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
+--    DefaultFlareType -> w
+--    PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps
+--    MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w
+--    HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps'
+--    LasGunFlare -> w
+--    TeslaGunFlare -> w
+--  where
+--    ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w
+--    ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w
+--    pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
+----        , withSmoke 1 black 20 200 5

src/Dodge/Render.hs

@@ -59,7 +59,7 @@ doDrawing' win pdata u = do
         shadV = _pictureShaders pdata
         nFls = w ^. cWorld . numberFloorVerxs
     -- bind as much data into vbos as feasible at this point
-    -- count mutable vectors setup
+    -- count mutable vectors setup (what is the 6 here?)
     layerCounts <- UMV.replicate (numLayers * 6) 0
     -- attempt to poke in parallel
     let wswp = wallSPics <> worldSPic cfig u

src/Picture/Data.hs

@@ -29,6 +29,7 @@ data Layer
     deriving (Eq, Ord, Enum, Bounded, Show, Read) --Generic, Flat)
 
 numLayers :: Int
+{-# INLINE numLayers #-}
 numLayers = length [minBound :: Layer .. maxBound]
 
 data ShadNum
@@ -39,6 +40,7 @@ data ShadNum
     deriving (Eq, Ord, Enum, Bounded, Show, Read) --Generic, Flat)
 
 numShads :: Int
+{-# INLINE numShads #-}
 numShads = length [minBound :: ShadNum .. maxBound]
 
 type Picture = [Verx]

src/Preload/Render.hs

@@ -83,6 +83,15 @@ preloadRender = do
     eslist <- makeShaderVBO "dualTwoD/ellipse" [vert, geom, frag] (toFloatVAs [3, 4]) pmTriangles
     cslist <-
         makeShaderVBO "picture/charArray" [vert, frag] (toFloatVAs [3, 4, 4]) pmTriangles
+    shadV <- MV.new 4
+    zipWithM_
+        (MV.write shadV)
+        [0 .. 3]
+        [ bslist -- note the ordering is very important
+        , cslist
+        , aslist
+        , eslist
+        ]
     --    initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR
     --initTexture2DArray 50 "data/texture/charMapVert16Block.png" 2 16 32 95 GL_NEAREST GL_NEAREST
     initTexture2DArray 50 "data/charMaps/charMapVert16Tall.png" 2 16 32 95 GL_NEAREST GL_NEAREST
@@ -136,15 +145,6 @@ preloadRender = do
     -- reset to default framebuffer, ready for drawing direct to screen
     glBindFramebuffer GL_FRAMEBUFFER 0
 
-    shadV <- MV.new 4
-    zipWithM_
-        (MV.write shadV)
-        [0 .. 3]
-        [ bslist -- note the ordering is very important
-        , cslist
-        , aslist
-        , eslist
-        ]
 
     initializeGLState
     putStrLn "Return preload"

src/Render.hs

@@ -236,7 +236,7 @@ renderLayer ::
     UMV.MVector (PrimState IO) Int ->
     IO ()
 renderLayer layer shads counts = do
-    let layerCounts = UMV.slice (ln * numLayers) 6 counts
+    let layerCounts = UMV.slice (ln * numLayers) numShads counts
     MV.imapM_ (drawShaderLay ln layerCounts) shads
   where
     ln = fromEnum layer

src/Shader/Compile.hs

@@ -92,11 +92,12 @@ makeShaderUsingVBO s shaderlist sizes pm vbo = do
 setupVBO :: Int -> IO VBO
 setupVBO vertexsize = do
     vboname <- mglCreate glCreateBuffers
-    thePtr <- mallocBytes (vertexsize * numDrawableElements)
+    thePtr <- mallocBytes (vertexsize * numDrawableVertices)
     -- Allocate space
     glNamedBufferData
         vboname
-        (fromIntegral $ numDrawableElements * vertexsize)
+        (fromIntegral $ floatSize * numDrawableVertices * vertexsize)
+--        (fromIntegral $ numDrawableVertices * vertexsize)
         nullPtr
         GL_STREAM_DRAW
     return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = vertexsize}
@@ -125,11 +126,11 @@ setupStaticVBOVAO vas vdata = withArrayLen vdata $ \i ptr -> do
 setupVBOStatic :: Int -> IO VBO
 setupVBOStatic vertexsize = do
     vboname <- mglCreate glCreateBuffers
-    thePtr <- mallocArray (vertexsize * numDrawableElements)
+    thePtr <- mallocArray (vertexsize * numDrawableVertices)
     -- Allocate space
     glNamedBufferData
         vboname
-        (fromIntegral $ floatSize * numDrawableElements * vertexsize)
+        (fromIntegral $ floatSize * numDrawableVertices * vertexsize)
         nullPtr
         GL_STATIC_DRAW
     return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = floatSize * vertexsize}

src/Shader/Parameters.hs

@@ -1,11 +1,12 @@
 module Shader.Parameters
     ( floatSize
     , ubyteSize
-    , numDrawableElements
+    , numDrawableVertices
     , numSubElements
     , glushortSize
     , numGLushort
     ) where
+import Picture.Data
 import Graphics.GL.Core45
 import Foreign
 
@@ -29,9 +30,9 @@ numGLushort :: Int
 numGLushort = fromIntegral (maxBound :: GLushort) + 1
 {-# INLINE numGLushort #-}
 
-numDrawableElements :: Int
+numDrawableVertices :: Int
-{-# INLINE numDrawableElements #-}
+{-# INLINE numDrawableVertices #-}
-numDrawableElements = 6 * numSubElements
+numDrawableVertices = 6 * numSubElements
 
 numSubElements :: Int
 {-# INLINE numSubElements #-}