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,53 +1,41 @@
 {-# 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
@@ -55,14 +43,14 @@ heldEffectMuzzles t cr w = uncurry (applyCME (_ldtValue t) cr) cmew
     (upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles
     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))
     _ -> id
   where
-    upitm = itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
+    upitm =
+        itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
             & ldtValue . itUse . heldTriggerType .~ AutoTrigger
 
 applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
@@ -77,7 +65,9 @@ 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
+        | i > 0 ->
+            (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
                 . lockInv cid
     _ -> id
   where
@@ -101,7 +91,8 @@ 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 =
+    w
         & cWorld . lWorld . creatures . ix cid %~ push
         & randGen .~ g
   where
@@ -111,11 +102,13 @@ applySidePush maxSide cr w = w
 
 applyTorqueCME :: Item -> Creature -> World -> World
 applyTorqueCME itm cr w
-    | cid == 0 = w
+    | cid == 0 =
+        w
             & wCam . camRot -~ rot
             & cWorld . lWorld . creatures . ix cid . crDir +~ rot
             & randGen .~ g
-    | otherwise = w
+    | otherwise =
+        w
             & cWorld . lWorld . creatures . ix cid . crDir +~ rot
             & randGen .~ g
   where
@@ -124,9 +117,10 @@ applyTorqueCME itm cr 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 ->
+    (LabelDoubleTree ComposeLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item))
 loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
     let as = _mzAmmoSlot mz
         amamount = 1
@@ -134,7 +128,8 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,Nothing) $ do
     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 ->
+        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,35 +164,23 @@ 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
 
----- 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)) ->
+    (CumulativeMuzzleEffect, World)
 useLoadedAmmo _ _ (cme, w) (_, Nothing) = (cme, w)
 useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cmeSound .~ True) $
     removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of
@@ -218,9 +205,17 @@ 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 $
+        w
             & cWorld . lWorld . creatures . ix (_crID cr) . crInv
-            . ix invid . itUse . heldAim . aimMuzzles . ix mzid . mzEffect . nzCurrentWalkAngle .~ wa
+                . ix invid
+                . itUse
+                . heldAim
+                . aimMuzzles
+                . ix mzid
+                . mzEffect
+                . nzCurrentWalkAngle
+                .~ wa
             & randGen .~ g
   where
     nz = _mzEffect mz
@@ -229,7 +224,6 @@ walkNozzle mzid mz itm cr w = fromMaybe w $ do
     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
   where
@@ -252,7 +246,8 @@ tractorBeamAt pos outpos dir power =
     d = unitVectorAtAngle dir * power
 
 shootLaser :: LabelDoubleTree ComposeLinkType Item -> Creature -> Muzzle -> World -> World
-shootLaser itmtree cr mz w = w 
+shootLaser itmtree cr mz w =
+    w
         & randGen .~ g
         & cWorld . lWorld . lasers
             .:~ LaserStart
@@ -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
+getBulletType itmtree magtree mz cr w =
+    magtree ^? ldtValue . itUse . amagParams . ampBullet
         <&> 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
@@ -322,20 +325,17 @@ getBulletTrajectory mz itm bt tp cr w = case bt of
         Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
         _ -> 0
 
-
+shootBullet ::
-shootBullet :: LabelDoubleTree ComposeLinkType Item 
+    LabelDoubleTree ComposeLinkType Item ->
-    -> Creature 
+    Creature ->
-    -> (Muzzle,Int,LabelDoubleTree ComposeLinkType Item ) 
+    (Muzzle, Int, LabelDoubleTree ComposeLinkType Item) ->
-    -> World 
+    World ->
-    -> World
+    World
 shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
-    -- should be able to pass the magazine in from elsewhere?
     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
@@ -382,7 +382,9 @@ useGasParams mmagid mz itm cr w =
         pos
         dir
         cr
-        w & randGen .~ g'
+        w
+        & randGen
+        .~ g'
   where
     (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
     gastype = fromMaybe (error "cannot find gas ammo") $ do
@@ -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,9 +463,10 @@ 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)
     Nothing -> fromMaybe NoHoming $ do
@@ -470,17 +474,20 @@ determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magt
         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 $
+        createShell homing aparams muz cr
             . startthesound
   where
     -- the sound should be moved to the projectile firing
@@ -488,3 +495,18 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
     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 #-}