Work on distortion shader

src/Dodge/Creature/Action/Blink.hs

@@ -43,13 +43,14 @@ blinkActionMousePos cr w =
     pushIntoMaybe (x,my) = (x,) <$> my
 
 blinkDistortions :: Point2 -> Point2 -> World -> World
-blinkDistortions sp ep = cWorld . lWorld . distortions .++~ distortionBulge
-  where
-    distR = 120
-    distortionBulge =
-        [ RadialDistortion ep (ep +.+ V2 distR 0) (ep +.+ V2 0 distR) 0.1
-        , RadialDistortion sp (sp +.+ V2 distR 0) (sp +.+ V2 0 distR) 1.9
-        ]
+blinkDistortions _ _ = id
+--blinkDistortions sp ep = cWorld . lWorld . distortions .++~ distortionBulge
+--  where
+--    distR = 120
+--    distortionBulge =
+--        [ RadialDistortion ep (ep +.+ V2 distR 0) (ep +.+ V2 0 distR) 0.1
+--        , RadialDistortion sp (sp +.+ V2 distR 0) (sp +.+ V2 0 distR) 1.9
+--        ]
 
 {- | Teleport a creature to the mouse position.
 Can go through walls, if ending up in wall does big damage.
@@ -87,12 +88,12 @@ blinkActionFail :: Creature -> World -> World
 blinkActionFail cr w =
     w
         & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
-        & cWorld . lWorld . distortions .:~ distortionBulge
+--        & cWorld . lWorld . distortions .:~ distortionBulge
         & cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
         & inverseShockwaveAt (cpos `v2z` 20) 40 2 2
   where
-    distR = 120
-    distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+--    distR = 120
+--    distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
     cid = _crID cr
     p1 = w ^. cWorld . lWorld . lAimPos
     cpos = cr ^. crPos . _xy

src/Dodge/Data/Distortion.hs

@@ -7,7 +7,7 @@ import Geometry
 import Data.Aeson
 import Data.Aeson.TH
 
-data Distortion = RadialDistortion Point2 Point2 Point2 Float
+data Distortion = RadialDistortion Point2 Point2 Point2 Point2 Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 deriveJSON defaultOptions ''Distortion

src/Dodge/Distortion.hs

@@ -5,7 +5,6 @@ import Dodge.Data.Distortion
 
 updateDistortion :: Distortion -> Maybe Distortion
 updateDistortion = \case
-    RadialDistortion a b c v
-        | v > 1 -> Just $ RadialDistortion a b c $ max 1 (v - 0.05)
-        | v < 1 -> Just $ RadialDistortion a b c $ min 1 (v + 0.05)
+    RadialDistortion a b c d t
+        | t > 0 -> Just $ RadialDistortion a b c d $ t-1
         | otherwise -> Nothing

src/Dodge/Event/Test.hs

@@ -10,5 +10,6 @@ testEvent :: World -> World
 testEvent w = fromMaybe w $ do
     cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy
     let distR = 50
-        distortionBulge = RadialDistortion cpos (V2 distR 0) (cpos + V2 0 distR) 1.9
+        distortionBulge = RadialDistortion cpos (V2 (0.5*distR) (-0.5*distR)) (V2 0 distR) 
+            (V2 (0.5* distR) 0) 20
     return $ w & cWorld . lWorld . distortions .~ [distortionBulge]

src/Dodge/Render.hs

@@ -366,9 +366,9 @@ doDrawing' win pdata u = do
             glBindFramebuffer GL_FRAMEBUFFER 0
             glUseProgram (pdata ^. fullscreenShader)
             glDrawArrays GL_TRIANGLES 0 6
-        (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g:_) -> do
+        (RadialDistortion (V2 a b) (V2 c d) (V2 e f) (V2 g h) _:_) -> do
             glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fbo2 . _1 . unFBO)
-            pokeArray (pdata ^. barrelShader . _2 . vboPtr) [a, b, c, d, e, f]
+            pokeArray (pdata ^. barrelShader . _2 . vboPtr) [a, b, c, d, e, f, g, h]
             withArray [a, b, c, d, e, f, g] $ 
                 glNamedBufferSubData (pdata ^. barrelShader . _2 . vboName) 0 
                     (6 * fromIntegral (sizeOf (0 :: Float)))

src/Dodge/TestString.hs

@@ -32,7 +32,8 @@ import Data.Foldable
 import Data.Monoid
 
 testStringInit :: Universe -> [String]
-testStringInit u =  [ show $ fmap (
+testStringInit u =  [ show (u ^. uvWorld . wCam . camRot)
+    ,show $ fmap (
      worldPosToScreen (u ^. uvWorld . wCam) )
     $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos . _xy
  ]

src/Dodge/Update/Camera.hs

@@ -39,27 +39,29 @@ updateFloatingCamera cfig w =
         & updateBounds cfig
         & wCam %~ setViewDistance cfig
         & wCam %~ translateFloatingCamera theinput
+        & rotateCamera cfig
         & wCam %~ translateFloatingCameraKeys theinput
         & wCam %~ zoomFloatingCamera theinput
   where
     theinput = w ^. input
 
 translateFloatingCamera :: Input -> Camera -> Camera
-translateFloatingCamera theinput cam = fromMaybe cam $ do
-    lpresstime <- theinput ^. mouseButtons . at ButtonLeft
-    rpresstime <- theinput ^. mouseButtons . at ButtonRight
-    if lpresstime > rpresstime
-        then do
-            hpos <- theinput ^? heldPos . ix ButtonLeft
-            let thetran =
-                    screenToWorldPos cam hpos
-                        -.- screenToWorldPos cam (theinput ^. mousePos)
-            return $
-                cam & camCenter +~ thetran
-                    & camViewFrom +~ thetran
-        else do
-            a <- theinput ^. heldPos . at SDL.ButtonRight
-            return $ cam & camRot -~ angleBetween (theinput ^. mousePos) a
+translateFloatingCamera _ cam = cam -- fromMaybe cam $ do
+----    lpresstime <- theinput ^. mouseButtons . at ButtonLeft
+--    _ <- theinput ^. mouseButtons . at ButtonRight
+----    guard (theinput ^. mouseButtons . at ButtonRight == Nothing)
+----    if lpresstime > rpresstime
+----        then do
+--    hpos <- theinput ^? heldPos . ix ButtonRight
+--    let thetran =
+--            screenToWorldPos cam hpos
+--                -.- screenToWorldPos cam (theinput ^. mousePos)
+--    return $
+--        cam & camCenter +~ thetran
+--            & camViewFrom +~ thetran
+----        else do
+----            a <- theinput ^. heldPos . at SDL.ButtonRight
+----            return $ cam & camRot -~ angleBetween (theinput ^. mousePos) a
 
 translateFloatingCameraKeys :: Input -> Camera -> Camera
 translateFloatingCameraKeys theinput cam =

src/Preload/Render.hs

@@ -129,11 +129,11 @@ preloadRender = do
     lightingTextureShad <- makeSourcedShader "lighting/texture" [vert, frag]
 
     distbo <- mglCreate glCreateBuffers
-    let distbosize = sizeOf (0 :: Float) * 6 * 1024
+    let distbosize = sizeOf (0 :: Float) * 8 * 1024
     glNamedBufferStorage distbo (fromIntegral distbosize) nullPtr GL_DYNAMIC_STORAGE_BIT
     glBindBufferBase GL_SHADER_STORAGE_BUFFER 9 distbo
     distptr <- mallocBytes distbosize
-    let distvbo = VBO distbo distptr (sizeOf (0::Float) * 6)
+    let distvbo = VBO distbo distptr (sizeOf (0::Float) * 8)
     barrelShad <- makeSourcedShader "texture/barrel" [vert,frag]
 
     putStrLn "Setup floor VBO, shader"