Add blurring of lightmap (and refactoring)

shader/blur.frag

@@ -0,0 +1,38 @@
+#version 430 core
+in vec2 vTexPos;
+out vec4 fColor;
+
+uniform vec2 winSize;
+uniform sampler2D screenTexture;
+
+const float hOff = 1.0 / winSize.x;
+const float vOff = 1.0 / winSize.y;
+//const float verOff = 1.0 / 600.0;
+
+//const float kernel[9] = float[](
+//    0.025,0.05,0.1, 0.2, 0.25, 0.2,0.1, 0.05, 0.025
+//   0.1,0.1,0.1,0.1,0.2,0.1,0.1,0.1,0.1
+//    );
+const float kernel[5] = float[](
+         0.175,
+    0.175,0.3,0.175,
+         0.175
+    );
+const float off[5] = float[](
+         vOff,
+    -hOff,0.0,hOff,
+         -vOff
+    );
+
+void main()
+{
+    vec4 sampleTex[5];
+    for(int i=0; i<5; i++)
+    {
+        sampleTex[i] = vec4(texture(screenTexture, vTexPos + off[i]));
+    }
+    vec4 col = vec4(0,0,0,0);
+    for (int i = 0; i < 5; i++)
+        col += sampleTex[i] * kernel[i];
+    fColor = col;
+}

shader/boxBlur.frag

@@ -0,0 +1,34 @@
+#version 430 core
+in vec2 vTexPos;
+out vec4 fColor;
+
+uniform vec2 winSize;
+uniform sampler2D screenTexture;
+
+const float hOff = 2.0 / 600;
+const float vOff = 2.0 / 600;
+const float frac = 1.0 / 9;
+const vec2 off[9] = vec2[](
+      vec2( vOff,hOff )
+    , vec2( vOff,0.0 )
+    , vec2( vOff,-hOff )
+    , vec2( 0.0,hOff )
+    , vec2( 0.0,0.0 )
+    , vec2( 0.0,-hOff )
+    , vec2( -vOff,hOff )
+    , vec2( -vOff,0.0 )
+    , vec2( -vOff,-hOff )
+    );
+
+void main()
+{
+    vec4 sampleTex[9];
+    for(int i=0; i<9; i++)
+    {
+        sampleTex[i] = vec4(texture(screenTexture, vTexPos + off[i]));
+    }
+    vec4 col = vec4(0,0,0,0);
+    for (int i = 0; i < 9; i++)
+        col += sampleTex[i] * frac;
+    fColor = col;
+}

shader/boxBlur.vert

@@ -0,0 +1,10 @@
+#version 430 core
+layout (location = 0) in vec2 pos;
+layout (location = 1) in vec2 texPos;
+out vec2 vTexPos;
+
+void main()
+{
+  gl_Position = vec4(pos,0,1);
+  vTexPos = texPos;
+}

shader/fullscreen.frag

@@ -6,11 +6,5 @@ uniform sampler2D screenTexture;
 
 void main()
 {
-//    vec4 col = vec4(0,0,0,0);
-//    for (int i = 0; i < 9; i++)
-//    {
-//        col += 
-//    }
     fColor = texture(screenTexture, vTexPos);
-//    fColor = vec4(1,1,1,0);
 }

shader/horizontalBlur.frag

@@ -0,0 +1,30 @@
+#version 430 core
+in vec2 vTexPos;
+out vec4 fColor;
+
+uniform vec2 winSize;
+uniform sampler2D screenTexture;
+
+const float horOff = 1.0 / winSize.x;
+//const float verOff = 1.0 / 600.0;
+
+//const float kernel[9] = float[](
+//    0.025,0.05,0.1, 0.2, 0.25, 0.2,0.1, 0.05, 0.025
+//   0.1,0.1,0.1,0.1,0.2,0.1,0.1,0.1,0.1
+//    );
+const float kernel[3] = float[](
+    0.25,0.5, 0.25
+    );
+
+void main()
+{
+    vec4 sampleTex[3];
+    for(int i=0; i<3; i++)
+    {
+        sampleTex[i] = vec4(texture(screenTexture, vTexPos + vec2((i-1)*horOff,0)));
+    }
+    vec4 col = vec4(0,0,0,0);
+    for (int i = 0; i < 3; i++)
+        col += sampleTex[i] * kernel[i];
+    fColor = col;
+}

src/Dodge/Base.hs

@@ -1,27 +1,21 @@
 --{-# LANGUAGE Strict #-}
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Base where
--- imports {{{
 import Dodge.Data
 import Dodge.Config.Data
-
 import Geometry
 import Picture
 
 import Control.Lens
 import Control.Monad.State
-
 import Data.List
 import Data.Function
 import Data.Maybe
 import Data.Bifunctor
-
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import qualified Data.Set as S
 
--- }}}
---
 leftPad :: Int -> a -> [a] -> [a]
 leftPad i x xs = reverse $ take i $ reverse (take i xs) ++ repeat x
 
@@ -743,36 +737,6 @@ nearestCrInFront p dir x w
 crInPolygon :: Creature -> [Point2] -> Bool
 crInPolygon cr xs = errorPointInPolygon 3 (_crPos cr) xs
 
-{- | Uses a layer to set the depth.
- -}
-onLayer :: Layer -> Picture -> Picture
-onLayer l = setDepth $ 1 - fromIntegral (levLayer l) / 100
-
-{- | 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..]))
-
-{- | For depth testing, set layer values.
- -}
-levLayer :: Layer -> Int
-levLayer BgLayer            = 20
-levLayer PressPlateLayer    = 45
-levLayer CorpseLayer        = 50
-levLayer FlItLayer          = 55
-levLayer CrLayer            = 60
-levLayer WlLayer            = 74
-levLayer GloomLayer         = 67
-levLayer UPtLayer           = 70
-levLayer PtLayer            = 72
-levLayer HPtLayer           = 73
-levLayer ShadowLayer        = 75   
-levLayer LabelLayer         = 80
-levLayer InvLayer           = 85
-levLayer MenuDepth          = 90
-
 {- | Transform coordinates from world position to normalised screen coordinates.
  -}
 worldPosToScreen :: World -> Point2 -> Point2

src/Dodge/Config/Update.hs

@@ -38,7 +38,7 @@ applyWorldConfig
     -> PreloadData SoundOrigin 
     -> IO (PreloadData SoundOrigin)
 applyWorldConfig cfig pdata = do
-    setVol cfig pdata >>= resizeSpareFBO (x `div` divRes) (y `div` divRes)
+    setVol cfig pdata >>= resizeSpareFBO (x `div` divRes) (y `div` divRes) x y
   where
     x = round $ _windowX cfig
     y = round $ _windowY cfig

src/Dodge/Creature.hs

@@ -14,7 +14,7 @@ import Dodge.Creature.YourControl
 import Dodge.Creature.Inanimate
 import Dodge.Creature.State
 import Dodge.Item
-
+import Dodge.Picture.Layer
 import Picture
 import Geometry
 

src/Dodge/Creature/Inanimate.hs

@@ -5,6 +5,7 @@ module Dodge.Creature.Inanimate
   where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.Creature.State
 import Dodge.LightSources

src/Dodge/Data.hs

@@ -1,7 +1,7 @@
 {-
 Contains base datatypes that cannot be seperated into 
 different modules because they are interdependent;
-circular imports are scary.
+circular imports are probably not a good idea.
  -}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -17,6 +17,7 @@ module Dodge.Data
     , soundTime
     )
   where
+import Dodge.Picture.Layer.Data
 import Dodge.Creature.Data
 import Dodge.Creature.State.Data
 import Dodge.Data.Menu
@@ -107,21 +108,6 @@ data Corpse = Corpse
     , _cpRes :: Creature
     }
 
-data Layer 
-    = PtLayer 
-    | CrLayer 
-    | WlLayer 
-    | BgLayer 
-    | ShadowLayer 
-    | FlItLayer 
-    | LabelLayer 
-    | InvLayer 
-    | MenuDepth
-    | PressPlateLayer 
-    | CorpseLayer
-    | UPtLayer
-    | HPtLayer
-    | GloomLayer
 
 data Cloud = Cloud
     { _clID :: Int

src/Dodge/Debug.hs

@@ -3,13 +3,11 @@ module Dodge.Debug where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Picture
-
+import Dodge.Picture.Layer
 import Geometry.Data
 import Picture
 
 import Control.Lens
-
-
 import qualified Data.IntMap.Strict as IM
 
 drawCircleAtFor :: Point2 -> Int -> World -> World

src/Dodge/Default.hs

@@ -11,6 +11,7 @@ import Dodge.Data
 import Dodge.Data.Menu
 import Dodge.SoundLogic
 import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Geometry

src/Dodge/Event.hs

@@ -74,10 +74,12 @@ handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
 handleResizeEvent sev w = Just 
     . set (config . windowX) (fromIntegral x)
     . set (config . windowY) (fromIntegral y)
-    $ over sideEffects ( resizeSpareFBO (fromIntegral x `div` divRes) (fromIntegral y `div` divRes) : )
+    $ over sideEffects ( resizeSpareFBO (x `div` divRes) (y `div` divRes) x y : )
     w
   where 
-    V2 x y = windowSizeChangedEventSize sev
+    x = fromIntegral x'
+    y = fromIntegral y'
+    V2 x' y' = windowSizeChangedEventSize sev
     divRes = w ^. config . shadow_resolution
 
 handlePressedMouseButton :: MouseButton -> World -> Maybe World

src/Dodge/Event/Keyboard.hs

@@ -7,6 +7,7 @@ module Dodge.Event.Keyboard
     where
 import Dodge.Data
 import Dodge.Data.Menu
+import Dodge.Picture.Layer
 import Dodge.Base
 import Dodge.Creature.Action
 import Dodge.Config.KeyConfig

src/Dodge/Event/Menu.hs

@@ -73,9 +73,9 @@ handlePressedKeyInMenu mState scode w = case mState of
 
 updateFramebufferSize :: World -> World
 updateFramebufferSize w = w & sideEffects 
-    %~ (resizeSpareFBO (ceiling x `div` divRes) (ceiling y `div` divRes) : )
+    %~ (resizeSpareFBO (x `div` divRes) (y `div` divRes) x y : )
   where 
-    (x,y) = (getWindowX w, getWindowY w)
+    (x,y) = (round $ getWindowX w, round $ getWindowY w)
     divRes = w ^. config . shadow_resolution
 
 cycleResolution 1 = 2

src/Dodge/Item/Attachment.hs

@@ -2,6 +2,7 @@ module Dodge.Item.Attachment
     where
 import Dodge.Data
 import Dodge.Item.Attachment.Data
+import Dodge.Default
 
 import Control.Lens hiding ((|>),(<|))
 import Data.Sequence
@@ -40,3 +41,32 @@ charFiringStrat strats cid w =
                         . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment 
                         . _Just . itCharMode
     in fromJust (Prelude.lookup c strats) cid w
+
+increaseFuse 
+    :: Int  -- ^ Old fuse time
+    -> Int  -- ^ Inventory item reference (I believe)
+    -> World 
+    -> World
+increaseFuse fuse itID w = w 
+    & creatures . ix 0 . crInv . ix itID . itScrollUp .~ decreaseFuse newTime
+    & creatures . ix 0 . crInv . ix itID . itScrollDown .~ increaseFuse newTime
+    & creatures . ix 0 . crInv . ix itID . itAttachment ?~ ItFuse newTime
+    & creatures . ix 0 . crInv . ix itID . itZoom 
+          .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
+  where 
+    newTime = min (fuse + 5) 90
+    zm = 50 / fromIntegral newTime
+
+decreaseFuse 
+    :: Int  -- ^ Old fuse time
+    -> Int  -- ^ Inventory item reference (I believe)
+    -> World -> World
+decreaseFuse fuse itID w = w 
+    & creatures . ix 0 . crInv . ix itID . itScrollUp .~ decreaseFuse newTime
+    & creatures . ix 0 . crInv . ix itID . itScrollDown .~ increaseFuse newTime
+    & creatures . ix 0 . crInv . ix itID . itAttachment ?~ ItFuse newTime
+    & creatures . ix 0 . crInv . ix itID . itZoom 
+          .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
+  where 
+    newTime = max (fuse - 5) 20
+    zm = 50 / fromIntegral newTime

src/Dodge/Item/Consumable.hs

@@ -1,7 +1,7 @@
 module Dodge.Item.Consumable
     where
 import Dodge.Data
-import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.SoundLogic
 

src/Dodge/Item/Draw.hs

@@ -1,13 +1,18 @@
 module Dodge.Item.Draw
     where
 import Dodge.Data
-import Dodge.Base
+import Dodge.Picture.Layer
-
 import Picture
-
+{- |
-drawWeapon :: Picture -> Creature -> Int -> Picture
+Places an item picture onto a creature when the item is selected. -}
+drawWeapon 
+    :: Picture 
+    -> Creature 
+    -> Int  -- ^ Position of item in inventory
+    -> Picture
 drawWeapon p cr posInInv 
     | _crInvSel cr == posInInv = onLayer PtLayer drawnWep
     | otherwise                = blank
-        where drawnWep = uncurry translate (_crRad cr,0) p
+  where 
+    drawnWep = uncurry translate (_crRad cr,0) p
 

src/Dodge/Item/Weapon.hs

@@ -9,6 +9,7 @@ module Dodge.Item.Weapon
     where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.SoundLogic
 import Dodge.Creature.Action
 import Dodge.RandomHelp
@@ -22,6 +23,7 @@ import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Laser
+import Dodge.Item.Weapon.Grenade
 import Dodge.Item.Attachment.Data
 import Dodge.Item.Attachment
 import Geometry
@@ -761,33 +763,6 @@ aSelf = blinkAction
 reflect :: Float -> Float -> Float
 reflect a b = a + 2*(a-b)
 
-moveGrenade 
-    :: Int      -- ^ Timer
-    -> Float    -- ^ Direction
-    -> Int      -- ^ Projectile id
-    -> World -> World
-moveGrenade 0 dir pID w = over projectiles (IM.delete pID) 
-    $ explosion (_pjPos (_projectiles w IM.! pID)) 
-    w
-  where
-    pj = _projectiles w IM.! pID
-    explosion = _pjPayload pj
-moveGrenade time dir pID w = case hitWl of
-    Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
-    _      -> updatedWorld
-  where 
-    updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
-                            $ set (projectiles .ix pID.pjPict) 
-                    (onLayer PtLayer $ uncurry translate newPos 
-                                     $ rotate dir $ grenadePic time)
-                        $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w
-    pj     = _projectiles w IM.! pID
-    oldPos = _pjPos pj
-    newPos = _pjVel pj +.+ oldPos
-    hitWl  = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
-    finalPos = maybe newPos fst hitWl
-    setV v = set (projectiles .ix pID.pjVel) v
-    updateV = maybe id (setV . snd) hitWl
 
 pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
 pointToItem (OnFloor flid) = floorItems . ix flid . flIt
@@ -882,7 +857,7 @@ grenade = Throwable
     , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
     , _twMaxRange = 150
     , _twAccuracy = 30
-    , _twFire = useTimeCheck $ throwGrenade makeExplosionAt fuseTime
+    , _twFire = useTimeCheck $ throwGrenade makeExplosionAt
     , _itAimingSpeed = 1
     , _itAimingRange = 0
     , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
@@ -905,7 +880,7 @@ grenade = Throwable
 flameGrenade :: Item
 flameGrenade = grenade {
      _itName = "FLMGREN " ++ show fuseTime
-     , _twFire = throwGrenade makeFlameExplosionAt fuseTime
+     , _twFire = throwGrenade makeFlameExplosionAt
     }
   where 
     fuseTime = 50
@@ -914,45 +889,12 @@ flameGrenade = grenade {
 teslaGrenade :: Item
 teslaGrenade = grenade {
      _itName = "TLSGREN " ++ show fuseTime
-     , _twFire = throwGrenade makeTeslaExplosionAt fuseTime
+     , _twFire = throwGrenade makeTeslaExplosionAt
     }
   where 
     fuseTime = 50
     f x = 50 / fromIntegral x
 
-increaseFuse 
-    :: Int  -- ^ Old fuse time
-    -> Int  -- ^ Inventory item reference (I believe)
-    -> World 
-    -> World
-increaseFuse fuse i w = w 
-    & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
-    & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
-    & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
-    & creatures . ix 0 . crInv . ix itRef . itAttachment ?~ ItFuse newTime
-    & creatures . ix 0 . crInv . ix itRef . itZoom 
-          .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
-  where 
-    itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
-    newTime = min (fuse + 5) 90
-    zm = 50 / fromIntegral newTime
-
-decreaseFuse 
-    :: Int  -- ^ Old fuse time
-    -> Int  -- ^ Inventory item reference (I believe)
-    -> World -> World
-decreaseFuse fuse i w = w 
-    & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime
-    & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime
-    & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime
-    & creatures . ix 0 . crInv . ix itRef . itAttachment ?~ ItFuse newTime
-    & creatures . ix 0 . crInv . ix itRef . itZoom 
-          .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm})
-  where 
-    itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
-    newTime = max (fuse - 5) 20
-    zm = 50 / fromIntegral newTime
-
 defaultThrowable = grenade
 remoteBomb = defaultThrowable
     { _itName = "REMOTEBOMB"
@@ -967,56 +909,7 @@ remoteBomb = defaultThrowable
     , _itEquipPict = drawWeapon remoteBombUnarmedPic
     }
 
-throwGrenade :: (Point2 -> World -> World) -> Int -> Int -> World -> World
-throwGrenade explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w
-  where 
-    addG = IM.insert i $ Shell 
-        { _pjPos = p
-        , _pjStartPos = p
-        , _pjVel = v
-        , _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
-        , _pjID = i
-        , _pjUpdate = moveGrenade fuseTime dir i
-        , _pjPayload = explosion
-        }
-    j = _crInvSel $ _creatures w IM.! n
-    removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
-    i = newProjectileKey w
-    (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
-    (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
---    - v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w)
-    v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
-    v | magV v' > 6 = 6 *.* normalizeV v'
-      | otherwise   = v'
-    cr = _creatures w IM.! n
-    p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
-    p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
-      | otherwise             = p'
-    dir = argV v 
-    setWp :: World -> World
-    setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
 
-throwArmReset :: Int -> ItEffect
-throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
-  where 
-    f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
-    counterDown it 
-        | _itEffectCounter (_itEffect it) == 0 = it 
-            & itHammer .~ HammerUp 
-            & itEquipPict .~ drawWeapon (grenadePic 50)
-        | otherwise = it & itEffect . itEffectCounter -~ 1
-                                           
-(grenadeAccL, grenadeAccA) = (0.1, 0.1)
-
-grenadePic :: Int -> Picture
-grenadePic x = pictures 
-    [ color (dark $ dark green) $ circleSolid 5
-    , color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 ) 
-                        (degToRad $ 180 - (179 * fromIntegral x / 50) ) 
-                        5
-    , translate (-2) 2 $ rotate (pi*0.5) 
-        $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 
-    ]
 
 fireRemoteLauncher :: Int -> World -> World
 fireRemoteLauncher cid w = setLocation 

src/Dodge/Item/Weapon/Decoration.hs

@@ -4,13 +4,12 @@ Particles and pictures that decorate weapons, such as laser scopes etc.
 module Dodge.Item.Weapon.Decoration
     where
 import Dodge.Data
-import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.Picture
 import Geometry.Data
 import Picture
 
 import Control.Lens
-
 makeLaserScope 
     :: Point2   -- ^ Start point
     -> Point2   -- ^ End point
@@ -18,13 +17,13 @@ makeLaserScope
     -> Particle
 makeLaserScope p ep relFrac = Particle
     {_ptDraw = const $ onLayer PtLayer $ pictures
-                                [color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green) 
+        [lineAlphaThick 0.5 0.5
-                                    $ lineOfThickness 0.5 [p,ep]
+        ,lineAlphaThick 0.2 1.5
-                                ,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green) 
+        ,lineAlphaThick 0.1 2
-                                    $ lineOfThickness 1.5 [p,ep]
-                                ,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green) 
-                                    $ lineOfThickness 2 [p,ep]
         ]
     ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
     }
+  where
+    lineAlphaThick a w = 
+        color (withAlpha a $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness w [p,ep]
 

src/Dodge/Item/Weapon/Grenade.hs

@@ -0,0 +1,101 @@
+module Dodge.Item.Weapon.Grenade
+    where
+import Dodge.Data
+import Dodge.Base
+import Dodge.Picture.Layer
+import Dodge.SoundLogic
+import Dodge.Item.Attachment.Data
+import Dodge.Item.Draw
+import Dodge.Default
+import Picture
+import Geometry
+
+import Control.Lens
+import Data.Maybe (fromJust)
+import qualified Data.IntMap.Strict as IM
+import System.Random
+
+moveGrenade 
+    :: Int      -- ^ Timer
+    -> Float    -- ^ Direction
+    -> Int      -- ^ Projectile id
+    -> World 
+    -> World
+moveGrenade 0 dir pID w = over projectiles (IM.delete pID) 
+    $ explosion (_pjPos (_projectiles w IM.! pID)) 
+    w
+  where
+    pj = _projectiles w IM.! pID
+    explosion = _pjPayload pj
+moveGrenade time dir pID w = case hitWl of
+    Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld
+    _      -> updatedWorld
+  where 
+    updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
+                            $ set (projectiles .ix pID.pjPict) 
+                    (onLayer PtLayer $ uncurry translate newPos 
+                                     $ rotate dir $ grenadePic time)
+                        $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w
+    pj     = _projectiles w IM.! pID
+    oldPos = _pjPos pj
+    newPos = _pjVel pj +.+ oldPos
+    hitWl  = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
+    finalPos = maybe newPos fst hitWl
+    setV v = set (projectiles .ix pID.pjVel) v
+    updateV = maybe id (setV . snd) hitWl
+
+
+grenadePic :: Int -> Picture
+grenadePic x = pictures 
+    [ color (dark $ dark green) $ circleSolid 5
+    , color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 ) 
+                        (degToRad $ 180 - (179 * fromIntegral x / 50) ) 
+                        5
+    , translate (-2) 2 $ rotate (pi*0.5) 
+        $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 
+    ]
+
+throwGrenade 
+    :: (Point2 -> World -> World)   -- ^ Payload
+    -> Int      -- ^ Creature id
+    -> World 
+    -> World
+throwGrenade explosion n w = setWp $ removePict $ over projectiles addG $ set randGen g w
+  where 
+    addG = IM.insert i $ Shell 
+        { _pjPos = p
+        , _pjStartPos = p
+        , _pjVel = v
+        , _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
+        , _pjID = i
+        , _pjUpdate = moveGrenade fuseTime dir i
+        , _pjPayload = explosion
+        }
+    cr = _creatures w IM.! n
+    j = _crInvSel cr
+    removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank
+    i = newProjectileKey w
+    (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w)
+    (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g
+    v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w)
+    v | magV v' > 6 = 6 *.* normalizeV v'
+      | otherwise   = v'
+    p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0)
+    p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0)
+      | otherwise             = p'
+    dir = argV v 
+    setWp :: World -> World
+    setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
+    fuseTime = _itFuseTime $ fromJust $ _itAttachment $ _crInv cr IM.! j
+
+throwArmReset :: Int -> ItEffect
+throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
+  where 
+    f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
+    counterDown it 
+        | _itEffectCounter (_itEffect it) == 0 = it 
+            & itHammer .~ HammerUp 
+            & itEquipPict .~ drawWeapon (grenadePic 50)
+        | otherwise = it & itEffect . itEffectCounter -~ 1
+                                           
+(grenadeAccL, grenadeAccA) = (0.1, 0.1)

src/Dodge/Item/Weapon/Laser.hs

@@ -2,6 +2,7 @@ module Dodge.Item.Weapon.Laser
     where
 import Dodge.Data
 import Dodge.Picture
+import Dodge.Picture.Layer
 import Dodge.Item.Attachment.Data
 import Dodge.Base
 import Dodge.SoundLogic

src/Dodge/Item/Weapon/UseEffect.hs

@@ -5,6 +5,7 @@ module Dodge.Item.Weapon.UseEffect
     where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.TriggerType
 import Dodge.WorldEvent.Flash

src/Dodge/LevelGen/Switch.hs

@@ -1,18 +1,17 @@
 module Dodge.LevelGen.Switch
     where
 import Dodge.Data
-import Dodge.Base
 import Dodge.SoundLogic
-
+import Dodge.Picture.Layer
 import Picture
 import Geometry
 
 import qualified Data.IntMap.Strict as IM
-
 import Control.Lens
-
+makeButton 
-
+    :: Color 
-makeButton :: Color -> (World -> World) -> Button
+    -> (World -> World) -- ^ Effect when pressed
+    -> Button
 makeButton c eff = Button
     { _btPict = onLayer WlLayer $ color c $ polygon $ rectNSEW 5 (-5) 10 (-10)
     , _btPos = (0,0)

src/Dodge/LightSources.hs

@@ -1,6 +1,7 @@
 module Dodge.LightSources where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Picture.Layer
 import Dodge.LevelGen.Data
 import Geometry
 import Picture
@@ -16,33 +17,34 @@ lightAt p i =
        }
 
 basicLS = PutLS ls dec
-    where ls = lightAt (0,0) 0
+  where 
+    ls = lightAt (0,0) 0
     dec = onLayer PtLayer $ color white $ circleSolid 8
 
 
 tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
-tLightFade 0 rmax intensityF p =
+tLightFade 0 rmax intensityF p = TLS 
-    TLS { _tlsPos = p
+    { _tlsPos = p
     , _tlsRad = rmax
     , _tlsIntensity = intensityF 0
     , _tlsUpdate = \w _ -> (w, Nothing)
     }
-tLightFade i rmax intensityF p =
+tLightFade i rmax intensityF p = TLS 
-    TLS { _tlsPos = p
+    { _tlsPos = p
     , _tlsRad = rmax
     , _tlsIntensity = intensityF i
     , _tlsUpdate = \w _ -> (w, Just $ tLightFade (i-1) rmax intensityF p)
     }
 
 tLightRad :: Int -> Float -> Float -> Point2 -> TempLightSource
-tLightRad 0 rmax rmin p =
+tLightRad 0 rmax rmin p = TLS 
-    TLS { _tlsPos = p
+    { _tlsPos = p
     , _tlsRad = rmax
     , _tlsIntensity = 0.5
     , _tlsUpdate = \w _ -> (w, Nothing)
     }
-tLightRad i rmax rmin p =
+tLightRad i rmax rmin p = TLS 
-    TLS { _tlsPos = p
+    { _tlsPos = p
     , _tlsRad = rmax
     , _tlsIntensity = 0.5
     , _tlsUpdate = \w _ -> (w, Just $ tLightRad (i-1) rmax rmin p)

src/Dodge/Picture/Layer.hs

@@ -0,0 +1,40 @@
+{- |
+Uniform management of layers and depths on which pictures are drawn. -}
+module Dodge.Picture.Layer
+    ( onLayer
+    , onLayerL
+    , levLayer
+    , Layer (..)
+    ) where
+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
+
+{- | 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..]))
+
+{- | For depth testing, set layer values.
+ -}
+levLayer :: Layer -> Int
+levLayer BgLayer            = 20
+levLayer PressPlateLayer    = 45
+levLayer CorpseLayer        = 50
+levLayer FlItLayer          = 55
+levLayer CrLayer            = 60
+levLayer WlLayer            = 74
+levLayer GloomLayer         = 67
+levLayer UPtLayer           = 70
+levLayer PtLayer            = 72
+levLayer HPtLayer           = 73
+levLayer ShadowLayer        = 75   
+levLayer LabelLayer         = 80
+levLayer InvLayer           = 85
+levLayer MenuDepth          = 90

src/Dodge/Picture/Layer/Data.hs

@@ -0,0 +1,18 @@
+module Dodge.Picture.Layer.Data
+  where
+
+data Layer 
+    = PtLayer 
+    | CrLayer 
+    | WlLayer 
+    | BgLayer 
+    | ShadowLayer 
+    | FlItLayer 
+    | LabelLayer 
+    | InvLayer 
+    | MenuDepth
+    | PressPlateLayer 
+    | CorpseLayer
+    | UPtLayer
+    | HPtLayer
+    | GloomLayer

src/Dodge/Render/Picture.hs

@@ -3,6 +3,7 @@ module Dodge.Render.Picture
 import Dodge.Data
 import Dodge.Base
 import Dodge.Picture
+import Dodge.Picture.Layer
 import Dodge.Render.HUD
 import Dodge.Render.MenuScreen
 import Geometry

src/Dodge/WorldEvent/Shockwave.hs

@@ -5,6 +5,7 @@ module Dodge.WorldEvent.Shockwave
   where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Picture.Layer
 import Geometry
 import Picture
 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -6,6 +6,7 @@ module Dodge.WorldEvent.SpawnParticle
 import Dodge.Data
 import Dodge.Base
 import Dodge.Picture
+import Dodge.Picture.Layer
 import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud

src/Picture/Preload.hs

@@ -25,10 +25,13 @@ data RenderData = RenderData
     , _wallTextureShader        :: FullShader ((Point2,Point2),Point4)
     , _backgroundShader         :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader         :: FullShader ()
+    , _boxBlurShader            :: FullShader ()
     , _pictureShaders           :: [FullShader RenderType]
     , _spareFBO                 :: FramebufferObject
     , _fboTexture               :: TextureObject
     , _fboRenderbufferObject    :: RenderbufferObject
+    , _fbo2                     :: (FramebufferObject, TextureObject)
+    , _fbo3                     :: (FramebufferObject, TextureObject)
     }
 
 makeLenses ''RenderData
@@ -56,14 +59,21 @@ preloadRender = do
                   >>= addTexture "data/texture/charMap.png"
 
 -- fullscreen shader
-    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip 
+    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
-                                (const [[[-1, 1],[0,1]]
+        [[[-1, 1],[0,1]]
         ,[[ 1, 1],[1,1]]
         ,[[-1,-1],[0,0]]
         ,[[ 1,-1],[1,0]]
         ]
-                                 )
+    _ <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
-    n <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
+-- box blur shader
+    boxBlurShad <- makeShader "boxBlur" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
+        [[[-1, 1],[0,1]]
+        ,[[ 1, 1],[1,1]]
+        ,[[-1,-1],[0,0]]
+        ,[[ 1,-1],[1,0]]
+        ]
+    _ <- F.foldM (pokeShader boxBlurShad) [()] -- fix fullscreen vertex positions now
 
 -- background shader
     bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
@@ -79,7 +89,10 @@ preloadRender = do
                 >>= addUniforms ["perpMat"]
 
 -- framebuffer for lighting
-    (fbo,fboTO,fboRBO) <- setupFramebuffer
+    (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
+
+    framebuf2 <- setupFramebuffer
+    framebuf3 <- setupFramebuffer
 
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
@@ -93,9 +106,12 @@ preloadRender = do
         , _wallTextureShader        = wlTexture
         , _backgroundShader         = bgShad
         , _fullscreenShader         = fsShad
+        , _boxBlurShader            = boxBlurShad
         , _spareFBO                 = fbo
         , _fboTexture               = fboTO
         , _fboRenderbufferObject    = fboRBO
+        , _fbo2                     = framebuf2
+        , _fbo3                     = framebuf3
         }
 
 -- potential drawing setup
@@ -111,15 +127,14 @@ preloadRender = do
 
 --------------------end preloadRender
 
-setupFramebuffer :: IO (FramebufferObject, TextureObject,RenderbufferObject)
+setupFramebufferWithStencil :: IO (FramebufferObject, TextureObject,RenderbufferObject)
-setupFramebuffer = do
+setupFramebufferWithStencil = do
     fboName <- genObjectName
     bindFramebuffer Framebuffer $= fboName
 
     fboTO <- genObjectName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
-    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
@@ -134,6 +149,23 @@ setupFramebuffer = do
 
     return (fboName, fboTO, fboRBO)
 
+setupFramebuffer :: IO (FramebufferObject, TextureObject)
+setupFramebuffer = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+
+    fboTO <- genObjectName
+    textureBinding Texture2D $= Just fboTO
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 600 600) 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
+
+    fboStatus <- framebufferStatus Framebuffer
+    print fboStatus
+
+    return (fboName, fboTO)
+
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload pd = do
     mapM_ freeShaderPointers $ _pictureShaders pd

src/Picture/Render.hs

@@ -61,13 +61,14 @@ createLightMap
     -> (Float,Float)        -- View from position
     -> GLmatrix GLfloat 
     -> IO ()
-createLightMap pdata resDiv wallPoints lightPoints
+createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat = do
-                    (viewFromx,viewFromy) pmat = do
 
     (vppos,vpsize) <- get viewport
+-- set the viewport size to that of the render buffer
     viewport $= (vppos, divideSize resDiv vpsize)
 
     bindFramebuffer Framebuffer $= _spareFBO pdata
+
 -- store wall and light positions into buffer
     nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) wallPoints
     bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
@@ -84,7 +85,6 @@ createLightMap pdata resDiv wallPoints lightPoints
     depthFunc $= Just Less
 -- draw walls from your point of view in order to set z buffer
     colorMask $= Color4 Disabled Disabled Disabled Disabled
---    let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
     uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
@@ -136,20 +136,51 @@ createLightMap pdata resDiv wallPoints lightPoints
     cullFace $= Nothing
     stencilTest $= Disabled
     blend $= Disabled
+
+-- set the viewport size to that of the window
     viewport $= (vppos, vpsize)
-    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
     colorMask $= Color4 Disabled Disabled Disabled Enabled
-    bindShaderBuffers [_fullscreenShader pdata] [4]
+    bindShaderBuffers [_boxBlurShader pdata] [4]
+    textureBinding Texture2D $= Just (_fboTexture pdata)
 -- by upscaling the shadowmap texture and using Linear' magnification
 -- interpolation, we get a poor mans blur
-    textureBinding Texture2D $= Just (_fboTexture pdata)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
--- not sure about the perforamnce implications ^^^
     generateMipmap' Texture2D
-    drawShader (_fullscreenShader pdata) 4
+-- not sure about the performance implications ^^^
+    drawShader (_boxBlurShader pdata) 4
+
+    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
+    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
+    replicateM_ 2 $ pingPongBlur pdata
+
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     blend $= Enabled
 
+pingPongBlur :: RenderData -> IO ()
+pingPongBlur pdata = do
+    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
+    textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
+    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
+    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
 renderBackground 
     :: RenderData 
     -> Float            -- Rotation

src/Preload/Update.hs

@@ -8,11 +8,13 @@ import Foreign
 import Picture.Preload
 
 resizeSpareFBO 
-    :: Int  -- ^ Width
+    :: Int  -- ^ Lightmap width
-    -> Int  -- ^ Height
+    -> Int  -- ^ Lightmap height
+    -> Int  -- ^ Full width
+    -> Int  -- ^ Full height
     -> PreloadData a 
     -> IO (PreloadData a)
-resizeSpareFBO xsize ysize pdata = do
+resizeSpareFBO xsize ysize xfull yfull pdata = do
 -- I am unsure how much of this needs to be bound...
     let rdata   = _renderData pdata
         fboName = _spareFBO rdata
@@ -33,5 +35,25 @@ resizeSpareFBO xsize ysize pdata = do
 
     fboStatus <- framebufferStatus Framebuffer
     putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
+
+    resizeTextureFBO (_fbo2 rdata) xfull yfull
+    resizeTextureFBO (_fbo3 rdata) xfull yfull
+    
     return pdata
 
+resizeTextureFBO 
+    :: (FramebufferObject , TextureObject)
+    -> Int
+    -> Int
+    -> IO ()
+resizeTextureFBO (fboName,fboTO) xsize ysize = do
+    let xsize' = fromIntegral xsize
+        ysize' = fromIntegral ysize
+    bindFramebuffer Framebuffer $= fboName
+    textureBinding Texture2D $= Just fboTO
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
+    fboStatus <- framebufferStatus Framebuffer
+    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus