diff --git a/src/LoadConfig.hs b/src/LoadConfig.hs new file mode 100644 index 000000000..d8582d888 --- /dev/null +++ b/src/LoadConfig.hs @@ -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) diff --git a/src/Preload/Data.hs b/src/Preload/Data.hs new file mode 100644 index 000000000..4c21fbbe7 --- /dev/null +++ b/src/Preload/Data.hs @@ -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 diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs new file mode 100644 index 000000000..6bd6332a9 --- /dev/null +++ b/src/Preload/Update.hs @@ -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 +