Add modules for config file
This commit is contained in:
@@ -0,0 +1,24 @@
|
|||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
module LoadConfig
|
||||||
|
where
|
||||||
|
import Data.Aeson
|
||||||
|
import GHC.Generics
|
||||||
|
import Foreign.C.Types
|
||||||
|
|
||||||
|
data Configuration = Configuration
|
||||||
|
{ windowxsize :: Int
|
||||||
|
, windowysize :: Int
|
||||||
|
} deriving (Generic, Show)
|
||||||
|
|
||||||
|
instance ToJSON Configuration where
|
||||||
|
toEncoding = genericToEncoding defaultOptions
|
||||||
|
instance FromJSON Configuration
|
||||||
|
|
||||||
|
loadConfig :: IO (Int,Int)
|
||||||
|
loadConfig = do
|
||||||
|
mayConfig <- decodeFileStrict "config.json"
|
||||||
|
case mayConfig of
|
||||||
|
Just config -> return (windowxsize config,windowysize config)
|
||||||
|
Nothing -> do
|
||||||
|
putStrLn "invalid config.json, loading default config"
|
||||||
|
return (800,600)
|
||||||
@@ -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
|
||||||
@@ -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
|
||||||
|
|
||||||
Reference in New Issue
Block a user