Fix ellipse shader coordinates

src/Dodge/Creature/Inanimate.hs

@@ -16,6 +16,7 @@ import Dodge.WorldEvent.Sound
 import Dodge.Creature.Update hiding (CRUpdate)
 import Picture
 import qualified IntMapHelp as IM
+import Geometry
 
 import Control.Lens
 
@@ -26,10 +27,21 @@ lamp :: Creature
 lamp = defaultInanimate
     { _crUpdate = initialiseLamp
     , _crHP = 100
-    , _crPict = picAtCrPos $ onLayer CrLayer $ color white $ circleSolid 3
+    , _crPict = picAtCrPos lampPic
     , _crRad = 3
     , _crMass = 3
     }
+lampPic :: Picture
+lampPic = pictures
+    [ setDepth 0 $ color white $ p
+    , setDepth (negate 0.1) $ color yellow $ p
+    , setDepth (negate 0.5) $ color green $ p
+    , setDepth (negate 0.7) $ color red $ p
+    , setDepth (negate 0.9) $ color blue $ p
+    , setDepth (negate 1) $ color white $ p
+    ]
+  where
+    p = pictures [circleSolid 3, polygon $ rectNSEW 5 0 5 0]
 
 initialiseLamp :: CRUpdate
 initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp i)

src/Dodge/Floor.hs

@@ -44,8 +44,6 @@ import System.Random
 {- | A test level tree. -}
 roomTreex :: RandomGen g => State g (Maybe [Room])
 roomTreex = do
-    --struct' <- aTreeStrut
---    let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
     let struct = treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] [EndRoom]
     let t' = padCorridors struct
         t = treeFromTrunk 
@@ -94,6 +92,5 @@ roomTreex = do
             t'
     shiftExpandTree . expandTreeBy id <$> mapM annoToRoomTree t
 
---swarmTestRoom :: 
 levx :: RandomGen g => State g [Room]
 levx = untilJust roomTreex

src/Dodge/Picture/Layer.hs

@@ -10,12 +10,12 @@ import Dodge.Picture.Layer.Data
 import Picture
 {- | Uses a layer to set the depth.  -}
 onLayer :: Layer -> Picture -> Picture
-onLayer l = setDepth $ (1 - fromIntegral (levLayer l) / 100) / 100
+onLayer l = setDepth $ (1 - fromIntegral (levLayer l) / 100) / 1000
 {- | Set a depth according to a list of numbers.
 Lists are lexicographically ordered if input values are always less than 100.
 Higher numbers will get placed on top of lower numbers.  -}
 onLayerL :: [Int] -> Picture -> Picture
-onLayerL is = setDepth (1 - sum (zipWith (/) (map fromIntegral is) $ map (100 **) [1..])) 
+onLayerL is = setDepth $ (1 - sum (zipWith (/) (map fromIntegral is) $ map (100 **) [1..])) / 1000
 {- | For depth testing, set layer values.  -}
 levLayer :: Layer -> Int
 levLayer BgLayer            = 20