Put config/targeting pictures in sensible places, tweak main loop

src/Shader/Poke.hs

@@ -19,7 +19,7 @@ import qualified Data.Vector.Unboxed as UV
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
-import Data.Vector.Fusion.Util
+--import Data.Vector.Fusion.Util
 import Control.Monad.Primitive
 --import qualified Control.Monad.Parallel as MP
 
@@ -45,19 +45,18 @@ pokeWallsWindowsFloor
     :: Ptr Float
     -> Ptr Float
     -> Ptr Float
-    -> UMV.MVector (PrimState IO) Int
     -> [ ( (Point2,Point2) , Point4 ) ]
     -> [ ( (Point2,Point2) , Point4 ) ]
     -> [ ( Point3          , Point3 ) ]
-    -> IO ()
-pokeWallsWindowsFloor wlptr wiptr flptr counts wls wis fls = do
-    VS.mapM_ (pokeW wlptr counts 0) (VS.fromList wls)
-    VS.mapM_ (pokeW wiptr counts 1) (VS.fromList wis)
-    VS.mapM_ (pokeF flptr counts)   (VS.fromList fls)
+    -> IO (Int,Int,Int)
+pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do
+    wlcounts1 <- VS.foldM (pokeW wlptr) 0 (VS.fromList wls)
+    wlcounts2 <- VS.foldM (pokeW wiptr) 0 (VS.fromList wis)
+    flcounts  <- VS.foldM (pokeF flptr) 0 (VS.fromList fls)
+    return (wlcounts1,wlcounts2,flcounts)
 
-pokeF :: Ptr Float -> UMV.MVector (PrimState IO) Int -> (Point3,Point3) -> IO ()
-pokeF ptr counts (V3 a b c,V3 d e f) = do
-    i' <- UMV.unsafeRead counts 2
+pokeF :: Ptr Float -> Int -> (Point3,Point3) -> IO Int
+pokeF ptr i' (V3 a b c,V3 d e f) = do
     let i = i' * 6
     pokeElemOff ptr (i + 0) a
     pokeElemOff ptr (i + 1) b
@@ -65,11 +64,10 @@ pokeF ptr counts (V3 a b c,V3 d e f) = do
     pokeElemOff ptr (i + 3) d
     pokeElemOff ptr (i + 4) e
     pokeElemOff ptr (i + 5) f
-    UMV.unsafeModify counts (+1) 2
+    return $ i' + 1
 
-pokeW :: Ptr Float -> UMV.MVector (PrimState IO) Int -> Int -> ((Point2,Point2),Point4) -> IO ()
-pokeW ptr counts iv ((V2 a b,V2 c d),V4 e f g h) = do
-    i' <- UMV.unsafeRead counts iv
+pokeW :: Ptr Float -> Int -> ((Point2,Point2),Point4) -> IO Int
+pokeW ptr i' ((V2 a b,V2 c d),V4 e f g h) = do
     let i = i' * 8
     pokeElemOff ptr (i + 0) a
     pokeElemOff ptr (i + 1) b
@@ -79,12 +77,9 @@ pokeW ptr counts iv ((V2 a b,V2 c d),V4 e f g h) = do
     pokeElemOff ptr (i + 5) f
     pokeElemOff ptr (i + 6) g
     pokeElemOff ptr (i + 7) h
-    UMV.unsafeModify counts (+1) iv
+    return $ i' + 1
 
-pokeShape
-    :: Ptr Float 
-    -> Ptr GLushort 
-    -> Ptr GLushort 
+pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
     -> [ShapeObj] 
     -> IO (Int,Int,Int)
 pokeShape ptr iptr ieptr = VS.foldM (pokeShapeObj ptr iptr ieptr) (0,0,0) . VS.fromList
@@ -96,7 +91,7 @@ pokeShapeObj
     -> (Int,Int,Int)
     -> ShapeObj
     -> IO (Int,Int,Int)
-{-# INLINE pokeShapeObj #-}
+--{-# INLINE pokeShapeObj #-}
 pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
     TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts shVerts
 
@@ -105,7 +100,7 @@ pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
     -> (Int,Int,Int)
     -> VS.Stream IO ShapeV
     -> IO (Int,Int,Int)
-{-# INLINE pokeTopPrism #-}
+--{-# INLINE pokeTopPrism #-}
 pokeTopPrism size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
     nv' <- VS.foldM (pokeJustV ptr) nv svs
     nshapeindices' <- UV.foldM (pokeTopPrismIndex nv iptr) nshapeindices 
@@ -118,7 +113,7 @@ pokeTopPrismEdgeIndex :: Int -> Ptr GLushort
     -> Int
     -> Int 
     -> IO Int
-{-# INLINE pokeTopPrismEdgeIndex #-}
+--{-# INLINE pokeTopPrismEdgeIndex #-}
 pokeTopPrismEdgeIndex nv eiptr nedgeindices ioff = do
     pokeElemOff eiptr nedgeindices (fromIntegral $ nv + ioff)
     return $ nedgeindices + 1
@@ -127,7 +122,7 @@ pokeTopPrismIndex :: Int -> Ptr GLushort
     -> Int
     -> Int 
     -> IO Int
-{-# INLINE pokeTopPrismIndex #-}
+--{-# INLINE pokeTopPrismIndex #-}
 pokeTopPrismIndex nv iptr nshapeindices ioff = do
     pokeElemOff iptr nshapeindices (fromIntegral $ nv + ioff)
     return $ nshapeindices + 1
@@ -168,9 +163,9 @@ pokeJustV :: Ptr Float
     -> Int
     -> ShapeV 
     -> IO Int
-{-# INLINE pokeJustV #-}
+--{-# INLINE pokeJustV #-}
 pokeJustV ptr nv sh = do
-    let off i = nv*7 + i
+--    pokeArray (advancePtr ptr (off 0)) [a,b,c,d,e,f,g]
     pokeElemOff ptr (off 0) a
     pokeElemOff ptr (off 1) b
     pokeElemOff ptr (off 2) c
@@ -180,6 +175,7 @@ pokeJustV ptr nv sh = do
     pokeElemOff ptr (off 6) g
     return (nv + 1)
   where
+    off i = nv*7 + i
     V3 a b c    = _svPos sh
     V4 d e f g  = _svCol sh