Add explicit layer datatype

src/Dodge/Creature/Lamp.hs

@@ -37,11 +37,11 @@ lamp h = defaultInanimate
     }
 lampCrPic :: Float -> Picture
 lampCrPic h = pictures 
-    [ setLayer 1 (setDepth h . color white $ circleSolid 3)
+    [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
     , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
     ]
   where
-    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] (LayNum 0) polyNum
+    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
 
 initialiseLamp :: Float -> Creature -> World -> World
 initialiseLamp = initialiseColorLamp 0.75

src/Dodge/Creature/Picture.hs

@@ -13,7 +13,7 @@ module Dodge.Creature.Picture
 import Dodge.Data
 --import Dodge.Base
 import Dodge.Creature.Test
-import Dodge.Render.InfoBox
+--import Dodge.Render.InfoBox
 import Dodge.Render.List
 --import Dodge.Creature.AlertLevel.Data
 --import Dodge.Picture.Layer
@@ -87,7 +87,7 @@ crDisplayInfo cfig w cr = (_crPos cr,
     crOnScreen = pointOnScreen cfig w $ _crPos cr
 
 creatureDisplayText :: Configuration -> World -> Creature -> Picture
-creatureDisplayText cfig w cr = setLayer 4 . setDepth 50 
+creatureDisplayText cfig w cr = setLayer FixedCoordLayer . setDepth 50 
     $ color white $ renderListAt 0 0 cfig $ zip ["TEST","ME"] $ repeat white
     -- $ renderInfoListAt 0 0 cfig w
     -- $ crDisplayInfo cfig w cr
@@ -96,7 +96,7 @@ creatureDisplayText' :: Configuration -> World -> Creature -> Picture
 creatureDisplayText' cfig w cr 
   | not (_debug_cr_status cfig) = []
   | otherwise
-    = setLayer 4 
+    = setLayer TopLayer 
     . setDepth 50 
     . translate x y 
     . color white 

src/Dodge/Debug.hs

@@ -45,7 +45,7 @@ pjTimerF 0    i = props %~ IM.delete i
 pjTimerF time i = props . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
 
 drawDDA :: IM.IntMap IS.IntSet -> Picture
-drawDDA = setLayer 1 . color (withAlpha 0.5 green) . IM.foldlWithKey' f blank
+drawDDA = setLayer BloomLayer . color (withAlpha 0.5 green) . IM.foldlWithKey' f blank
   where
     f pic x' ys' = concatMapPic (\y -> polygon (rectNSEW (y+50) y (x+50) x)) ys `appendPic` pic
       where
@@ -53,7 +53,7 @@ drawDDA = setLayer 1 . color (withAlpha 0.5 green) . IM.foldlWithKey' f blank
         ys = map ((50 *) . fromIntegral) $ IS.toList ys'
 
 debugWallZoningPic :: World -> Picture
-debugWallZoningPic w = setLayer 1 $ zonesPic `appendPic` wallsPic
+debugWallZoningPic w = setLayer BloomLayer $ zonesPic `appendPic` wallsPic
   where
     wallsPic = setDepth 25 . color yellow . concatMapPic (drawTheWall . _wlLine) $ IM.elems theWalls
     drawTheWall (a,b) = thickLine 20 [a,b]

src/Dodge/Debug/LinkDecoration.hs

@@ -25,11 +25,11 @@ roomLinkDecorations :: Room -> Picture
 roomLinkDecorations rm = pictures . map (linkDecoration . lnkPosDir) $ _rmLinks rm
 
 linkDecoration :: (Point2,Float) -> Picture
-linkDecoration (p,a) = setLayer 1 . setDepth 50 . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)]
+linkDecoration (p,a) = setLayer TopLayer . setDepth 50 . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)]
 
 roomPolyDecorations :: Room -> Picture
 roomPolyDecorations rm = pictures . map polyWireFrame $ _rmPolys rm
 
 polyWireFrame :: [Point2] -> Picture
-polyWireFrame (x:xs) = setLayer 1 . setDepth 50 . color green $ line $ (x:xs) ++ [x]
+polyWireFrame (x:xs) = setLayer TopLayer . setDepth 50 . color green $ line $ (x:xs) ++ [x]
 polyWireFrame _ = undefined

src/Dodge/Default.hs

@@ -8,7 +8,6 @@ module Dodge.Default where
 import Dodge.Default.Weapon
 import Dodge.Data
 import Dodge.SoundLogic
-import Dodge.Picture.Layer
 import Dodge.Wall.Delete
 import Dodge.Creature.Damage
 import Geometry
@@ -44,7 +43,7 @@ defaultCreature = Creature
     , _crInvEquipped = mempty
     , _crLeftInvSel = Nothing
     , _crState  = defaultState
-    , _crCorpse = setLayer 0 $ setDepth 5 $ color (greyN 0.5) $ circleSolid 10
+    , _crCorpse = setLayer BottomLayer $ setDepth 5 $ color (greyN 0.5) $ circleSolid 10
     , _crApplyDamage = defaultApplyDamage
     , _crStance = Stance 
         {_carriage=Walking 0 WasLeftForward
@@ -264,7 +263,7 @@ defaultLS = LS
     , _lsPict = defLSPic 
     }
 defLSPic :: LightSource -> Picture
-defLSPic ls = setLayer 1 . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
+defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
   where
     col = V4 r g b 2
     V3 r g b = _lsCol $ _lsParam ls

src/Dodge/Item/Equipment.hs

@@ -4,7 +4,6 @@ import Dodge.Item.Draw
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Default
 import Dodge.Default.Wall
-import Dodge.Picture.Layer
 import Dodge.Creature.Test
 import Dodge.Wall
 import Dodge.Magnet

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -309,7 +309,7 @@ lasGunPic it =
            upperPrismPoly 4 (rectNESW 3    30   1  0)
         <> upperPrismPoly 4 (rectNESW (-1) 30 (-3) 0)
         <> upperPrismPoly 1 (rectNESW 3    30 (-3) 0)
-    , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
+    , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
     )
   where
     amFrac = fractionLoadedAmmo it
@@ -386,7 +386,7 @@ tractorGunPic it =
            upperPrismPoly 4 (rectNESW 3    30   1  0)
         <> upperPrismPoly 4 (rectNESW (-1) 30 (-3) 0)
         <> upperPrismPoly 1 (rectNESW 3    30 (-3) 0)
-    , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
+    , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
     )
   where
     amFrac = fractionLoadedAmmo it
@@ -508,7 +508,7 @@ shootDualLaser it cr w = w'
     dam = _lasDamage $ _itParams it
 
 drawBeam :: Beam -> Picture
-drawBeam bm = setLayer 1 $ pictures
+drawBeam bm = setLayer BloomNoZWrite $ pictures
     [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 ps
     , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  ps
     ]
@@ -591,7 +591,7 @@ mvLaser phasev pos dir w pt
     xp = pos +.+ 800 *.* unitVectorAtAngle dir
     (thHit, ps) = reflectLaserAlong phasev [] pos xp w
     col = _ptColor pt
-    pic = setLayer 1 $ pictures
+    pic = setLayer BloomNoZWrite $ pictures
         [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps)
         , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  (pos:ps)
         ]
@@ -661,7 +661,7 @@ tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
     p3 = p1 +.+ p4
 
 tractorSPic :: Prop -> SPic
-tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon 
+tractorSPic pj = (,) mempty $ setLayer BloomNoZWrite $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon 
     [ spos  -- not sure if this is anticlockwise...
     , spos +.+ size *.* (d +.+ n)
     , xpos +.+ size *.* n

src/Dodge/Item/Weapon/Booster.hs

@@ -7,7 +7,6 @@ import Dodge.Zone
 import Dodge.Default.Weapon
 import Geometry
 import qualified IntMapHelp as IM
-import Dodge.Picture.Layer
 import Picture
 import ShapePicture
 --import Shape
@@ -81,7 +80,7 @@ updateLinearShockwave pj w
     t = _pjTimer pj
 
 drawBoostShockwave :: Prop -> SPic
-drawBoostShockwave pj = (,) mempty $ setLayer 1 $ setDepth 20 $ pictures $
+drawBoostShockwave pj = (,) mempty $ setLayer BloomLayer $ setDepth 20 $ pictures $
     theArc ++
     [ lineCol $ zip (reverse lps) $ map (`withAlpha` white) [0,0.05..]
     , lineCol $ zip (reverse rps) $ map (`withAlpha` white) [0,0.05..]

src/Dodge/Item/Weapon/Decoration.hs

@@ -15,7 +15,7 @@ makeLaserScope
     -> Float    -- ^ Fraction of red/green
     -> Particle
 makeLaserScope p ep relFrac = Particle
-    {_ptDraw = const $ setLayer 1 $ setDepth 20 $ pictures
+    {_ptDraw = const $ setLayer BloomLayer $ setDepth 20 $ pictures
         [lineAlphaThick 0.5 0.5
         ,lineAlphaThick 0.2 1.5
         ,lineAlphaThick 0.1 2

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -75,7 +75,7 @@ targetCursor = defaultTargeting
 targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture
 targetSimpleDraw _ it _ w = fromMaybe mempty $ do
     mwp <- it ^? itTargeting . tgPos . _Just
-    return $ setLayer 4 $ color red $ setDepth 50 $ uncurryV translate mwp 
+    return $ setLayer TopLayer $ color red $ setDepth 50 $ uncurryV translate mwp 
         $ rotate (_cameraRot w)
         $ pictures
             [line [V2   x  x, V2 (-x) (-x)]
@@ -87,7 +87,7 @@ targetSimpleDraw _ it _ w = fromMaybe mempty $ do
 targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture
 targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
     mwp <- it ^? itTargeting . tgPos . _Just
-    return $ setLayer 5 $ color thecolor $ setDepth 50 $ uncurryV translate mwp 
+    return $ setLayer TopLayer $ color thecolor $ setDepth 50 $ uncurryV translate mwp 
         $ rotate (_cameraRot w)
         $ pictures
             [line [V2   x  x, V2 (-x) (-x)]
@@ -146,7 +146,7 @@ targetLaserUpdate it cr w t
     sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
     ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
     addLaserPic = instantParticles .:~ Particle
-        { _ptDraw = const $ setLayer 1 $ pictures
+        { _ptDraw = const $ setLayer BloomNoZWrite $ pictures
             [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
             , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  (sp:ps)
             ]

src/Dodge/Item/Weapon/Launcher.hs

@@ -231,7 +231,7 @@ shellShape = colorSH black $ upperPrismPoly 4 $ map toV2 [(-6,4),(-6,-4),(6,-4),
 
 remoteShellShape :: Color -> SPic
 remoteShellShape col = (shellShape
-    , setLayer 1 . setDepth 4.5 . color col $ circleSolid 3
+    , setLayer BloomNoZWrite . setDepth 4.5 . color col $ circleSolid 3
     )
 
 drawRemoteShell :: Prop -> SPic

src/Dodge/Item/Weapon/SonicGuns.hs

@@ -78,7 +78,7 @@ sonicWave pos dir cpos = ShockLine
     makePointDir p = (p, argV $ p -.- cpos)
 
 drawSonicWave :: Particle -> Picture
-drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer 1 . setDepth 20 
+drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
     . lineThick 20
     . map fst)
     $ _ptPointDirs pt

src/Dodge/Item/Weapon/UseEffect.hs

@@ -31,7 +31,7 @@ mvBlip p col maxt t w pt =
     , Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1)
         & ptDraw .~ ( const 
             . setDepth (-0.5)
-            . setLayer 1
+            . setLayer BloomLayer
             . uncurryV translate p 
             . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
             $ circleSolid 2 )
@@ -50,7 +50,7 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
                               }
                    )
   where 
-    pic = setDepth (-0.5) . setLayer 1 $ pictures crBlips
+    pic = setDepth (-0.5) . setLayer BloomLayer $ pictures crBlips
     crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
     crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100)
                   = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100))

src/Dodge/Particle/Bullet/Draw.hs

@@ -5,7 +5,7 @@ import Dodge.Data
 import Picture
 
 drawBul :: Particle -> Picture
-drawBul pt = setLayer 1
+drawBul pt = setLayer BloomNoZWrite
     . setDepth 20 
     . color (_ptColor pt) 
     $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)

src/Dodge/Particle/TeslaArc.hs

@@ -31,7 +31,7 @@ aTeslaArcAt col thearc = LinearParticle
     }
 
 drawTeslaArc :: Particle -> Picture
-drawTeslaArc pt = setLayer 1 $ pictures 
+drawTeslaArc pt = setLayer BloomNoZWrite $ pictures 
     [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine  3 ps
     , setDepth 20   $ color (V4 0 0 0 0.5)              $ thickLine 10 ps
     ]

src/Dodge/Picture/Layer.hs

@@ -6,7 +6,6 @@ module Dodge.Picture.Layer
 --    , levLayer
 --    , Layer (..)
     ) where
-import Dodge.Picture.Layer.Data
 import Picture
 {- | Uses a layer to set the depth.  -}
 --onLayer :: Layer -> Picture -> Picture

src/Dodge/Picture/SizeInvariant.hs

@@ -14,7 +14,7 @@ fixedSizePicAt
     -> World
     -> Picture
 fixedSizePicAt pic p w 
-    = setLayer 4 
+    = setLayer TopLayer 
     . setDepth 50 
     . translate x y 
     . scale theScale theScale 
@@ -34,7 +34,7 @@ fixedSizePicClamp
     -> World
     -> Picture
 fixedSizePicClamp xbord ybord pic p cfig w
-    = setLayer 4 
+    = setLayer TopLayer 
 --    . setDepth 50 
     . translate x y 
     . scale theScale theScale 
@@ -59,8 +59,8 @@ fixedSizePicClampArrow
     -> World
     -> Picture
 fixedSizePicClampArrow xbord ybord pic p cfig w = pictures 
-    [ setLayer 4 . translate x y . scale theScale theScale $ pic 
+    [ setLayer TopLayer . translate x y . scale theScale theScale $ pic 
-    , setLayer 4 . color white . setDepth 20 $ arrowPic
+    , setLayer TopLayer . color white . setDepth 20 $ arrowPic
     ]
   where
     winps = screenPolygon cfig w

src/Dodge/Render.hs

@@ -17,6 +17,7 @@ import Shader.Data
 import MatrixHelper
 import Shader.ExtraPrimitive
 import Shader.Parameters
+import Picture.Data
 
 import Foreign
 import Control.Lens
@@ -45,7 +46,7 @@ doDrawing pdata u = do
         lwShad = _lightingWallShadShader pdata
     -- bind as much data into vbos as feasible at this point
     -- count mutable vectors setup
-    layerCounts  <- UMV.replicate (6*6) 0
+    layerCounts  <- UMV.replicate (numLayers*6) 0
     shapeCounts  <- UMV.replicate 3 (0 :: Int)
     wlwiflCounts <- UMV.replicate 3 (0 :: Int)
     -- attempt to poke in parallel

src/Dodge/Render/ShapePicture.hs

@@ -106,7 +106,7 @@ drawPathing cfig w
 viewBoundaries :: Configuration -> World -> Picture
 viewBoundaries cfig w
     | _debug_view_boundaries cfig 
-        = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
+        = setLayer TopLayer $ color green (concatMap (polygonWire . _grBound) grs)
         <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
     | otherwise = []
   where
@@ -116,9 +116,9 @@ viewBoundaries cfig w
 viewClipBounds :: Configuration -> World -> Picture
 viewClipBounds cfig w
     | _debug_view_clip_bounds cfig == AllRoomClipBoundaries
-         = setLayer 5 $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w)
+         = setLayer TopLayer $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w)
     | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries
-        = setLayer 5 $ f (_roomClipping w)
+        = setLayer TopLayer $ f (_roomClipping w)
     | otherwise = []
   where
     f (x:xs) = g x xs <> f xs

src/Dodge/WorldEvent/Cloud.hs

@@ -46,7 +46,7 @@ smokeCloudAt
 smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col)
 
 drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
-drawCloudWith radMult fadet col cl = setLayer 2 
+drawCloudWith radMult fadet col cl = setLayer MidLayer 
     . setDepth 25
     $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
   where 

src/Dodge/WorldEvent/Flash.hs

@@ -28,7 +28,7 @@ muzFlareAt :: Color -> Point3 -> Float -> World -> World
 muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
   where
     theFlare = Particle
-        { _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape
+        { _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape
         , _ptUpdate = ptSimpleTime 2
         }
     theShape = rotate dir . color col $ polygon
@@ -40,7 +40,7 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
 
 flareCircleAt :: Color -> Float -> Point3 -> World -> World
 flareCircleAt col alphax tranv = instantParticles .:~ Particle
-    { _ptDraw = const . setLayer 1 . translate3 tranv
+    { _ptDraw = const . setLayer BloomNoZWrite . translate3 tranv
                         $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
     , _ptUpdate = ptSimpleTime 1
     }

src/Dodge/WorldEvent/Shockwave.hs

@@ -8,7 +8,6 @@ import Dodge.Data
 import Dodge.Wall.Damage
 import Dodge.Base
 import Dodge.Zone
-import Dodge.Picture.Layer
 import Geometry
 import Picture
 import LensHelp
@@ -38,7 +37,7 @@ makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
 {- Shockwave picture.  -}
 drawShockwave :: Particle -> Picture
 drawShockwave pt = setDepth 20 
-    . setLayer 1
+    . setLayer BloomLayer
     . uncurryV translate (_ptPos pt) 
     . color (_ptColor pt) 
     $ thickCircle rad thickness
@@ -115,7 +114,7 @@ moveInverseShockwave w pt
 
 drawInverseShockwave :: Particle -> Picture
 drawInverseShockwave  pt 
-    = setLayer 1 $ setDepth 20 $ uncurryV translate p 
+    = setLayer BloomLayer $ setDepth 20 $ uncurryV translate p 
                           $ color cyan $ thickCircle rad thickness
   where
     p = _ptPos pt

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -51,13 +51,13 @@ drawFlame
     -> Picture
 drawFlame rotd pt = pictures
     [ glow 
-    , aPic 3 prot2 25 (V2 (scaleChange + 1)   2  ) $ V4 2 (-1) (-1) 0.5
+    , aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1)   2  ) $ V4 2 (-1) (-1) 0.5
-    , aPic 3 prot  22 (V2 (scaleChange + 0.5) 1  ) $ V4 1 0.5    0  2
+    , aPic BloomNoZWrite prot  22 (V2 (scaleChange + 0.5) 1  ) $ V4 1 0.5    0  2
-    , aPic 1 prot3 20 (V2  scaleChange        0.5) $ V4 1 1      1  1
+    , aPic BloomLayer prot3 20 (V2  scaleChange        0.5) $ V4 1 1      1  1
     ]
   where
     ep = _ptPos pt
-    aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
+    aPic :: Layer -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
     aPic lay offset depth (V2 scalex scaley) col
         = setLayer lay 
         . setDepth depth 
@@ -66,7 +66,7 @@ drawFlame rotd pt = pictures
         . scale scalex scaley
         . color col                 
         $ circleSolid 5
-    glow = setLayer 1 $ setDepth 0.3 $ uncurryV translate ep
+    glow = setLayer BloomNoZWrite $ setDepth 0.3 $ uncurryV translate ep
         $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
     time = _ptTimer pt
     scaleChange 
@@ -202,7 +202,7 @@ makeFlamelet (V2 x y) z vel maycid size time w = w
 drawStaticBall
     :: Particle
     -> Picture
-drawStaticBall pt = setLayer 1 
+drawStaticBall pt = setLayer BloomNoZWrite
     . setDepth (_ptZ pt + 20) 
     . uncurryV translate (_ptPos pt)
     $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5)
@@ -212,9 +212,9 @@ drawFlameletZ
     -> Particle
     -> Picture
 drawFlameletZ rot pt = pictures 
-    [ setLayer 1 pic 
+    [ setLayer BloomLayer pic 
-    , setLayer 3 piu 
+    , setLayer BloomNoZWrite piu 
-    , setLayer 3 pi2 
+    , setLayer BloomNoZWrite pi2 
     ]
   where
     z = _ptZ pt
@@ -292,7 +292,7 @@ makeGasCloud pos vel w = w
     theCloud = Cloud 
         {  _clPos = addZ 20 pos
         , _clVel = addZ 0 vel
-        , _clPict = \_ -> setLayer 2 . setDepth 30 $ color (withAlpha 0.05 col) 
+        , _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
                                           $ circleSolid 20
         , _clRad = 10
         , _clAlt = 25

src/Picture.hs

@@ -57,19 +57,19 @@ polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
 polygon = map f . polyToTris
   where
-    f (V2 x y) = Verx (V3 x y 0) black [] (LayNum 0) polyNum
+    f (V2 x y) = Verx (V3 x y 0) black [] BottomLayer polyNum
 
 polygonZ :: [Point2] -> Float -> Picture
 {-# INLINE polygonZ #-}
 polygonZ ps z = map (f . zeroZ) $ polyToTris ps
   where
-    f pos = Verx pos black [z] (LayNum 0) polyzNum
+    f pos = Verx pos black [z] BottomLayer polyzNum
 
 polygonCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE polygonCol #-}
 polygonCol = polyToTris . map f
   where
-    f (V2 x y,col) = Verx (V3 x y 0) col [] (LayNum 0) polyNum
+    f (V2 x y,col) = Verx (V3 x y 0) col [] BottomLayer polyNum
 
 poly3 :: [Point3] -> Picture
 {-# INLINE poly3 #-}
@@ -79,7 +79,7 @@ poly3Col :: [(Point3,RGBA)] -> Picture
 {-# INLINE poly3Col #-}
 poly3Col = map f . polyToTris
   where
-    f (pos,col) = Verx pos col [] (LayNum 0) polyNum
+    f (pos,col) = Verx pos col [] BottomLayer polyNum
 
 -- note that much of work computing the width of the bezier curve is done here
 bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
@@ -118,7 +118,7 @@ bezierQuad cola colc ra rc a b c
 bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
 bzhelp = map f
   where
-    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] (LayNum 0) bezNum
+    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] BottomLayer bezNum
 
 -- given a one and two zeros of a linear function over x and y,
 -- determine the function
@@ -166,11 +166,11 @@ addDepth :: Float -> Picture -> Picture
 addDepth d = map $ overPos (\(V3 x y z) -> V3 x y (z+d))
 
 -- TODO change the Int here to a dedicated type
-setLayer :: Int -> Picture -> Picture
+setLayer :: Layer -> Picture -> Picture
 {-# INLINE setLayer #-}
 setLayer i = map f
   where
-    f v = v {_vxLayer = LayNum i}
+    f v = v {_vxLayer = i}
 
 scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
@@ -215,7 +215,7 @@ circleSolidCol colC colE r = map f
     ,(V3   r  (-r) 0, black)
     ]
   where
-    f (pos,col) = Verx pos col [] (LayNum 0) ellNum
+    f (pos,col) = Verx pos col [] BottomLayer ellNum
 
 circle :: Float -> Picture
 {-# INLINE circle #-}
@@ -233,7 +233,7 @@ text :: String -> Picture
 {-# INLINE text #-}
 text = map f . stringToList
   where
-    f (pos,col,V2 a b) = Verx pos col [a,b] (LayNum 0) textNum
+    f (pos,col,V2 a b) = Verx pos col [a,b] BottomLayer textNum
 
 line :: [Point2] -> Picture
 {-# INLINE line #-}
@@ -326,7 +326,7 @@ thickArcHelp startA endA rad wdth = map f
     (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
     --(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * 2) 0)
     (V2 xc yc) = rotateV endA (V2 rad 0)
-    f (pos,col,V3 a b c) = Verx pos col [a,b,c] (LayNum 0) arcNum
+    f (pos,col,V3 a b c) = Verx pos col [a,b,c] BottomLayer arcNum
 
 
 -- Currently the lens version is much slower

src/Picture/Data.hs

@@ -10,10 +10,10 @@ data Verx = Verx
     { _vxPos    :: !Point3
     , _vxCol    :: !Point4
     , _vxExt    :: [Float]
-    , _vxLayer  :: !LayNum
+    , _vxLayer  :: !Layer
     , _vxShadNum  :: !ShadNum
     }
-newtype LayNum  = LayNum  { _unLayNum :: Int }
+--newtype LayNum  = LayNum  { _unLayNum :: Int }
 
 data Layer
     = BottomLayer
@@ -23,6 +23,15 @@ data Layer
     | TopLayer
     | FixedCoordLayer
 
+layerNum :: Layer -> Int
+layerNum lay = case lay of
+    BottomLayer     -> 0
+    MidLayer        -> 1
+    BloomLayer      -> 2
+    BloomNoZWrite   -> 3
+    TopLayer        -> 4
+    FixedCoordLayer -> 5
+
 numLayers :: Int
 numLayers = 6
 --TODO use synonyms for layer numbers

src/Polyhedra.hs

@@ -121,7 +121,7 @@ polyToPics = map helpPoly3D . _pyFaces
 helpPoly3D :: [(Point3, Point4)] -> Picture
 helpPoly3D = map f . polyToTris
   where
-    f (pos,col) = Verx pos col [] (LayNum 0) polyNum
+    f (pos,col) = Verx pos col [] BottomLayer polyNum
 
 polysToPic :: [Polyhedra] -> Picture
 polysToPic = pictures . concatMap polyToPics

src/Shader/Poke.hs

@@ -196,8 +196,8 @@ pokeLayVerx vbos counts vx = do
     UMV.unsafeModify counts (+ 1) vecPos
   where
     sn = _unShadNum (_vxShadNum vx)
-    vecPos = theLayer * 6 + sn
+    vecPos = theLayer * numLayers + sn
-    theLayer = _unLayNum $ _vxLayer vx
+    theLayer = layerNum $ _vxLayer vx
     thePos = _vxPos vx
     theCol = _vxCol vx
     layOff = theLayer * numSubElements