diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index e5440b5a6..c5bbca09c 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections #-} +{-# LANGUAGE BangPatterns #-} module Shader.Poke ( pokeArrayOff , pokeVX @@ -54,10 +55,11 @@ pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int) pokeVerxs vbos vxs0 = go vxs0 (pure 0) where go [] count = return count - go (vx:vxs) count = pokeVerx vbos count vx >> go vxs (addCountVerx count vx) + go (!vx:vxs) count = pokeVerx vbos count vx >> go vxs (addCountVerx count vx) -- this is very brittle, but want to optimise speed if possible here pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO () +{-# INLINE pokeVerx #-} pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) (_psPoly offsets * 7 * floatSize)) thePos theCol PolyzV x -> poke34 thePtr thePos theCol @@ -85,6 +87,7 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case t EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) (_psEll offsets * 7 * floatSize)) thePos theCol poke34 :: Ptr Float -> Point3 -> Point4 -> IO () +{-# INLINE poke34 #-} poke34 ptr (a,b,c) (d,e,f,g) = do pokeElemOff ptr 0 a pokeElemOff ptr 1 b @@ -95,6 +98,7 @@ poke34 ptr (a,b,c) (d,e,f,g) = do pokeElemOff ptr 6 g addCountVerx :: PicShads Int -> Verx -> PicShads Int +{-# INLINE addCountVerx #-} addCountVerx ps@PicShads { _psPoly = sPoly , _psPolyz = sPolyz @@ -171,10 +175,11 @@ pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int)) pokeLayVerxs vbos vxs0 = go vxs0 (IM.fromList $ (, pure 0) <$> [0..5]) where go [] count = return count - go (vx:vxs) count = pokeLayVerx vbos count vx >> go vxs (addLayCountVerx count vx) + go (!vx:vxs) count = pokeLayVerx vbos count vx >> go vxs (addLayCountVerx count vx) -- this is very brittle, but want to optimise speed if possible here pokeLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO () +{-# INLINE pokeLayVerx #-} pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vxLayer = theLay} = case theType of PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) ((_psPoly offsets + layOff) * 7 * floatSize)) thePos theCol PolyzV x -> poke34 thePtr thePos theCol @@ -205,6 +210,7 @@ pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vx offsets = imoffsets IM.! theLay addLayCountVerx :: IM.IntMap (PicShads Int) -> Verx -> IM.IntMap (PicShads Int) +{-# INLINE addLayCountVerx #-} addLayCountVerx m vx = IM.adjust f (_vxLayer vx) m where f = flip addCountVerx vx