Add modules for config file

This commit is contained in:
2021-03-22 22:42:07 +01:00
parent 54b28db249
commit e296e5d841
3 changed files with 81 additions and 0 deletions
+24
View File
@@ -0,0 +1,24 @@
{-# LANGUAGE TemplateHaskell #-}
module Preload.Data
where
import Control.Lens
import GHC.Word (Word32)
import Picture.Preload
import Sound.Preload
data PreloadData a = PreloadData
{ _renderData :: RenderData
, _soundData :: SoundData a
, _currentTime :: Word32
, _renderTime :: Word32
, _renderLighting :: Word32
, _renderPicture :: Word32
, _simTime :: Word32
, _mixerTime :: Word32
, _idleTime :: Word32
, _gcTime :: Word32
, _pokeTime :: Word32
}
makeLenses ''PreloadData
+33
View File
@@ -0,0 +1,33 @@
module Preload.Update
( resizeSpareFBO
)
where
import Preload.Data
import Graphics.Rendering.OpenGL
import Foreign
import Picture.Preload
resizeSpareFBO :: Int -> Int -> PreloadData a -> IO (PreloadData a)
resizeSpareFBO xsize ysize pdata = do
-- I am unsure how much of this needs to be bound...
let rdata = _renderData pdata
fboName = _spareFBO rdata
fboTO = _fboTexture rdata
fboRBO = _fboRenderbufferObject rdata
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
bindRenderbuffer Renderbuffer $= fboRBO
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO
fboStatus <- framebufferStatus Framebuffer
putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
return pdata