-- | Contains the central drawing functions for the dodge loop.
module Dodge.Render (
    doDrawing,
    getWindowSize,
) where

import Shape.Parameters
import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
--import Data.List (sortOn)
import qualified Data.Map.Strict as M
import Data.Preload.Render
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Universe
import Dodge.Render.Lights
import Dodge.Render.ShapePicture
import Dodge.Render.Walls
import Dodge.Shadows
import Dodge.WindowSize
import Foreign
import GLHelp
import Geometry
import Graphics.GL.Core45
import MatrixHelper
import Render
import qualified SDL
import Shader
import Shader.Bind
import Shader.Data
import Shader.Poke
import Shader.Poke.Cloud

doDrawing :: SDL.Window -> Universe -> IO ()
doDrawing window u
    | SDL.ScancodeY `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
    | otherwise = doDrawing' window rdata u
  where
    rdata = u ^. preloadData . renderData

doTestDrawing :: RenderData -> Universe -> IO ()
doTestDrawing _ _ = do
    return ()

doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
doDrawing' win pdata u = do
    --sTicks <- SDL.ticks
    checkGLError "during drawing"
    let w = _uvWorld u
        cfig = _uvConfig u
        (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
        lightPoints = lightsToRender cfig (w ^. wCam) (w ^. cWorld . lWorld)
        shadV = _pictureShaders pdata
        nFls = w ^. cWorld . numberFloorVerxs
        nchs = w ^. cWorld . numberChasmVerxs
    -- bind as much data into vbos as feasible at this point
    -- count mutable vectors setup
    pokeCounts <- UMV.replicate (numLayers * numShads) 0
    -- attempt to poke in parallel
    let wswp = wallSPics <> worldSPic cfig u
        ws = wswp ^. _1
        wp = wswp ^. _2
    ((nWins, trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
        MP.liftM3
            (\_ a b -> (a, b))
            ( pokeLayVerxs
                shadV
                pokeCounts
                wp
            )
            ( pokeWallsWindows
                (pdata ^. winVBO . vboPtr)
                (pdata ^. wallVBO . vboPtr)
                windowPoints
                wallsToPoke
            )
            ( pokeShape
                (drawShadowsByImportance $ cfig ^. gr_shadow_size)
                (_vboPtr $ _vboShapes pdata)
                (_uiboPtr $ _shapeEBO pdata)
                (_uiboPtr $ _silhouetteEBO pdata)
                (0, 0, 0)
                ws
            )
    (nCloudVs', nCloudIs') <-
        -- Might want to sort the clouds based on z depth, not sure
        V.foldM'
            (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
            (0, 0)
            (V.fromList $ w ^. cWorld . lWorld . clouds)
    (nCloudVs, nCloudIs) <-
        V.foldM'
            (pokeDust (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
            (nCloudVs', nCloudIs')
            (V.fromList $ w ^. cWorld . lWorld . dusts)
    -- bind wall points, silhouette data, surface geometry
    bufferShaderLayers shadV pokeCounts
    mapM_
        (uncurry bufferPokedVBO)
        [ (_vboShapes pdata, nShapeVs)
        , (pdata ^. cloudVBO, nCloudVs)
        ]
    mapM_
        (uncurry bufferEBO)
        [ (_cloudEBO pdata, nCloudIs)
        , (_shapeEBO pdata, nIndices)
        ]
    -- set the coordinate uniform ready for drawing elements using world coordinates
    bufferPerspectiveMatrixUBO cfig (w ^. wCam) (pdata ^. matUBO)
    glNamedBufferSubData (pdata ^. winVBO . vboName) 0 
        (fromIntegral $ nWins * sizeOf (0::Float) * 8)
        (pdata ^. winVBO . vboPtr)
    -- bufferFloatBO function
    glNamedBufferSubData (pdata ^. wallVBO . vboName) 0 
        (fromIntegral $ trueNWalls * sizeOf (0::Float) * 8)
        (pdata ^. wallVBO . vboPtr)
    glNamedBufferSubData (pdata ^. vboShapes . vboName) 0
        (fromIntegral $ nShapeVs * shapeVerxSize)
        (pdata ^. vboShapes . vboPtr)
    glNamedBufferSubData (pdata ^. shapeEBO . uiboName) 0
        (fromIntegral $ nIndices * (sizeOf (0::GLuint)))
        (pdata ^. shapeEBO . uiboPtr)
    bufferEBO (pdata ^. silhouetteEBO) nSilIndices
    setViewport _gr_world_res cfig
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
    glDepthMask GL_TRUE
    glDisable GL_BLEND
    glDepthFunc GL_LESS
    -- clear depth and stencil buffers
    glStencilMask 255 -- to alter the entire stencil
    glClearNamedFramebufferfi
            (pdata ^. fboBase . _1 . unFBO)
            GL_DEPTH_STENCIL
            0
            1 
            0
    -- draw wall occlusions from the camera's point of view
    glStencilFunc GL_NOTEQUAL 128 255
    glStencilOp GL_KEEP GL_KEEP GL_REPLACE
    glEnable GL_CULL_FACE
    glCullFace GL_BACK
    unless (debugOn Remove_LOS cfig) $ do
        glUseProgram (pdata ^. ceilingStencilShader . shaderUINT)
--        glBindVertexArray $ pdata ^. ceilingStencilShader . shaderVAO . vaoName
        glBindVertexArray $ pdata ^. dummyVAO . vaoName
        glEnable GL_DEPTH_CLAMP
        glDrawArrays
            (_unPrimitiveMode $ pdata ^. ceilingStencilShader . shaderPrimitive)
            0
            (fromIntegral (trueNWalls * 6))
        glDisable GL_DEPTH_CLAMP
    glStencilMask 127 -- to alter last seven bits
    glStencilOp GL_KEEP GL_KEEP GL_KEEP
    -- clear color and normals
    withArray [0, 0, 0, 1] $
        glClearNamedFramebufferfv (pdata ^. fboBase . _1 . unFBO) GL_COLOR 0
    withArray [0, 0, 0, 0] $
        glClearNamedFramebufferfv (pdata ^. fboBase . _1 . unFBO) GL_COLOR 2
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
        glNamedFramebufferDrawBuffers (pdata ^. fboBase . _1 . unFBO) 3
    --draw walls onto base buffer
    glEnable GL_CULL_FACE
    glCullFace GL_BACK
--    glUseProgram (pdata ^. wallShader . shaderUINT)
--    glBindVertexArray $ pdata ^. wallShader . shaderVAO . vaoName
--    glDrawArrays
--        (_unPrimitiveMode $ pdata ^. wallShader . shaderPrimitive)
--        0
--        (fromIntegral trueNWalls)
    glUseProgram (pdata ^. pullWallShader . shaderUINT)
    glBindVertexArray $ pdata ^. dummyVAO . vaoName
    glDrawArrays
        GL_TRIANGLES
        0
        (fromIntegral trueNWalls * 6)
    --draw object shapes onto base buffer
    let fs = _shapeShader pdata
    glUseProgram (_shaderUINT fs)
    glDrawArrays GL_TRIANGLES 0 (fromIntegral nIndices)
    -- draw chasm shader blocking floor
    glUseProgram (pdata ^. chasmShader . shaderUINT)
    glBindVertexArray $ pdata ^. chasmShader . shaderVAO . vaoName
    glDepthMask GL_FALSE
    glDrawBuffer GL_NONE
    glStencilOp GL_KEEP GL_KEEP GL_INCR
    with 0 $
        glClearNamedFramebufferiv
            (pdata ^. fboBase . _1 . unFBO)
            GL_STENCIL
            0
    glDrawArrays
        (_unPrimitiveMode $ pdata ^. chasmShader . shaderPrimitive)
        0
        (fromIntegral nchs)
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
        glNamedFramebufferDrawBuffers (pdata ^. fboBase . _1 . unFBO) 3
    glDepthMask GL_TRUE
    --draw floor onto base buffer
    glUseProgram (pdata ^. floorShader . shaderUINT)
    glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
    glStencilFunc GL_EQUAL 0 255
    glDrawArrays
        (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
        0
        (fromIntegral nFls)
    --glDisable GL_STENCIL_TEST
    glDisable GL_CULL_FACE
    glEnable GL_BLEND
    --draw lightmap into its own buffer
    createLightMap
        cfig
        (fromIntegral trueNWalls)
        nSilIndices
        nIndices
        (pdata ^. fboBase . _2 . _2)
        (pdata ^. fboBase . _2 . _3)
        lightPoints
        pdata
    glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
    --apply lightmap to base buffer
    glDisable GL_CULL_FACE
    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
    glBindTextureUnit 0 (pdata ^. fboLighting . _2 . unTO)
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    drawShader (_fullscreenShader pdata) 4
    with GL_COLOR_ATTACHMENT0 $
        glInvalidateNamedFramebufferData (pdata ^. fboLighting . _1 . unFBO) 1
    --draw bloom onto bloom buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
    withArray [0, 0, 0, 0] $
        glClearNamedFramebufferfv (pdata ^. fboBloom . _1 . unFBO) GL_COLOR 0
    glDepthFunc GL_LESS
    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    --glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA
    glBlendFunc GL_ONE GL_ONE
    glDepthMask GL_FALSE
    renderLayer BloomNoZWrite shadV pokeCounts
    glDepthMask GL_TRUE
    renderLayer BloomLayer shadV pokeCounts
    -- draw clouds to block bloom particles, transparency blocks some alpha
    glDepthMask GL_FALSE
    glBlendColor 0 0 0 0.1 -- using this and GL_CONSTANT_ALPHA below
    -- can allow for some bloom to bleed through underneath the clouds
    -- note that BloomNoZWrite will always be under the clouds, this should be
    -- rethought, either do another pass and write just the depth or even remove
    -- the layer entirely
    glBlendFuncSeparate GL_ZERO GL_ONE GL_CONSTANT_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glUseProgram (pdata ^. cloudShader . shaderUINT)
    glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
    glDrawElements
        (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
        (fromIntegral nCloudIs)
        GL_UNSIGNED_INT
        nullPtr
    glDepthMask GL_TRUE

    --setup downscale viewport for blurring bloom
    --setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
    setViewport _gr_downsize_res cfig
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
    glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO)
    glDisable GL_BLEND
    -- this all needs more tuning + more thought
    -- a fade effect would be cool, so not to fully reset last frames bloom
    -- buffers...
--    withArray [0, 0, 0, 0] $
--        glClearNamedFramebufferfv (pdata ^. fboHalf1 . _1 . unFBO) GL_COLOR 0
--    withArray [0, 0, 0, 0] $
--        glClearNamedFramebufferfv (pdata ^. fboHalf2 . _1 . unFBO) GL_COLOR 0
--    glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA
    drawShader (_bloomBlurShader pdata) 4
    when (cfig ^. gr_bloom) $ do
        replicateM_ 2 $ pingPongBetween 
            (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
        glEnable GL_BLEND
    setViewport _gr_world_res cfig
    --draw clouds onto cloud buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboCloud . _1 . unFBO)
    glDepthFunc GL_LEQUAL
    glDepthMask GL_FALSE
    glBlendFuncSeparatei 0 GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
    --glBlendFunci 0 GL_ONE GL_ONE_MINUS_SRC_ALPHA
    --withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
        glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 2
    withArray [0.5, 0.5, 0.5, 0] $
        glClearNamedFramebufferfv
            (pdata ^. fboCloud . _1 . unFBO)
            GL_COLOR
            0
    glUseProgram (pdata ^. cloudShader . shaderUINT)
    glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
    glDrawElements
        (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
        (fromIntegral nCloudIs)
        GL_UNSIGNED_INT
        nullPtr
--    glEnable GL_CULL_FACE
--    glEnable GL_DEPTH_CLAMP
--    glCullFace GL_BACK
----    drawShader (_windowShader pdata) nWins
--    glDisable GL_DEPTH_CLAMP
--    glDisable GL_CULL_FACE
    when (_gr_cloud_shadows cfig) $ do
        ----render transparency depths
--        glDepthMask GL_TRUE
        glDepthFunc GL_ALWAYS
        glDisable GL_BLEND
        withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
            glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 3
        withArray [0, 0, 0, 0] $
            glClearNamedFramebufferfv (pdata ^. fboCloud . _1 . unFBO) GL_COLOR 1
        withArray [0, 0, 0, 0] $
            glClearNamedFramebufferfv (pdata ^. fboCloud . _1 . unFBO) GL_COLOR 2
        glEnable GL_BLEND
        -- we sum the positions weighted by alpha, and sum the alpha
        glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
        --glBlendFuncSeparatei 1 GL_ONE GL_ZERO GL_ONE GL_ZERO
        -- and sum the normals weighted by alpha
        --glBlendFunci 2 GL_SRC_ALPHA GL_ONE
        glBlendFunci 2 GL_SRC_ALPHA GL_ONE
        glUseProgram (pdata ^. cloudShader . shaderUINT)
        glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
--        glDepthMask GL_TRUE
        glDrawElements
            (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
            (fromIntegral nCloudIs)
            GL_UNSIGNED_INT
            nullPtr
        ---
--        glEnable GL_CULL_FACE
--        glEnable GL_DEPTH_CLAMP
--        glCullFace GL_BACK
----        drawShader (_windowShader pdata) nWins
--        glDisable GL_DEPTH_CLAMP
--        glDisable GL_CULL_FACE
        --        drawShader (_windowShader pdata) nWins
        glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
        withArray [0, 0, 0, 0] $ \ptr ->
            glClearNamedFramebufferfv
                (pdata ^. fboPos . _1 . unFBO)
                GL_COLOR
                0
                ptr
        glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
        glDepthMask GL_FALSE
        drawShader (pdata ^. alphaDivideShader) 4
        ----draw lightmap for cloud buffer
        glDepthMask GL_TRUE
        glDepthFunc GL_LESS
        glEnable GL_BLEND
        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        createLightMap
            cfig
            (fromIntegral trueNWalls)
            nSilIndices
            nIndices
            (pdata ^. fboPos . _2)
            (pdata ^. fboCloud . _2 . _3)
            lightPoints
            pdata
    --draw windows onto window buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboWindow . _1 . unFBO)
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
        glNamedFramebufferDrawBuffers (pdata ^. fboWindow . _1 . unFBO) 2
    withArray [0, 0, 0, 0] $
        glClearNamedFramebufferfv (pdata ^. fboWindow . _1 . unFBO) GL_COLOR 0
    withArray [0, 0, 0, 0] $
        glClearNamedFramebufferfv (pdata ^. fboWindow . _1 . unFBO) GL_COLOR 1
    glEnable GL_CULL_FACE
    glEnable GL_DEPTH_CLAMP
    glDepthFunc GL_LEQUAL
    glCullFace GL_BACK
    glDisable GL_BLEND
--    glDepthFunc GL_ALWAYS
--    glDisable GL_CULL_FACE
    glUseProgram $ pdata ^. windowPullShader . shaderUINT
    glBindVertexArray $ pdata ^. dummyVAO . vaoName
    glDrawArrays GL_TRIANGLES 0 (fromIntegral nWins * 6)
    --drawShader (_windowShader pdata) nWins
    glDisable GL_DEPTH_CLAMP
    glDisable GL_CULL_FACE
    glInvalidateBufferData (pdata ^. vboShapes . vboName)
    --apply lightmap to cloud buffer
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthMask GL_FALSE
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $
        glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 2
    --        $ \ptr -> glDrawBuffers 2 ptr
    glDepthFunc GL_ALWAYS
    glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
    glEnable GL_BLEND
    glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA


    -- bind base buffer for drawing clouds and bloom
    --glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)

--    --draw shadowed clouds onto base buffer
--    glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
--    drawShader (_fullscreenShader pdata) 4

    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--    --draw windows onto base buffer
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glBindTextureUnit 0 (pdata ^. fboWindow . _2 . _1 . unTO)
    glBindTextureUnit 1 (pdata ^. fboWindow . _2 . _2 . unTO)
    glBindTextureUnit 2 (pdata ^. fboCloud . _2 . _1 . unTO)
    --glBindTextureUnit 3 (pdata ^. fboCloud . _2 . _2 . unTO)
    glBindTextureUnit 3 (pdata ^. fboPos . _2 . unTO)
    drawShader (_transparencyCompShader pdata) 4

    --Draw blurred bloom onto base buffer
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE
    --glBlendFunc GL_ONE GL_ONE
    glBindTextureUnit 0 (_unTO . snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
--    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA


    --set viewport for radial distortion
    --setViewportSize (round winx) (round winy)
    setViewport (const FullRes) cfig
    glDepthFunc GL_ALWAYS
    glBlendFunc GL_ONE GL_ZERO
    -- perform any radial distortion
    -- this is hideous
    case (getDistortions cfig w, cfig ^. gr_distortions) of
        (rds, x) | null rds || not x -> do
            glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
            glBindFramebuffer GL_FRAMEBUFFER 0
            drawShader (_fullscreenShader pdata) 4
        (rds, _) -> do
            let bindDrawDist :: Distortion -> IO ()
                bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
                    pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g]
                    bufferPokedVBO (snd $ _barrelShader pdata) 1
                    drawShader (fst $ _barrelShader pdata) 1
                fboList =
                    take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
                        ++ [FBO 0]
                toList = (pdata ^. fboBase . _2 . _1) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
                bindings = zipWith (>>) (map bindFBO fboList) (map (glBindTextureUnit 1 . _unTO) toList)
            zipWithM_ (>>) bindings $ map bindDrawDist rds
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    -- draw the overlay
    --glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO)
    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA -- assume premultiplied alpha
    renderLayer DebugLayer shadV pokeCounts
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
    withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig)) $
        glNamedBufferSubData (pdata ^. matUBO) 0 64
    glDepthFunc GL_GEQUAL
    glDepthMask GL_TRUE
    with (-1) $ glClearNamedFramebufferfv 0 GL_DEPTH 0
    renderLayer FixedCoordLayer shadV pokeCounts
    SDL.glSwapWindow win

bufferPerspectiveMatrixUBO :: Config -> Camera -> GLuint -> IO ()
bufferPerspectiveMatrixUBO cfig cam uboid = withArray
    (perspectiveMatrixb (cam ^. camRot) (cam ^. camZoom) (cam ^. camCenter)
        (V2 (windowXFloat cfig) (windowYFloat cfig)) (cam ^. camViewFrom))
      $ glNamedBufferSubData uboid 0 64

getDistortions :: Config -> World -> [Distortion]
getDistortions cfig w
    | cfig ^. gr_distortions = w ^. cWorld . lWorld . distortions
    | otherwise = []

setViewport :: (Config -> ResFactor) -> Config -> IO ()
setViewport f = uncurry (glViewport 0 0) . getWindowSize f