spice 0.4.0.0 → 0.5.0.0
raw patch · 31 files changed
+882/−1115 lines, 31 filesdep ~OpenGL
Dependency ranges changed: OpenGL
Files
- spice.cabal +9/−24
- src/FRP/Spice.hs +18/−15
- src/FRP/Spice/Assets.hs +0/−71
- src/FRP/Spice/Config.hs +0/−44
- src/FRP/Spice/Engine.hs +0/−90
- src/FRP/Spice/Engine/Driver.hs +0/−27
- src/FRP/Spice/Engine/Network.hs +0/−31
- src/FRP/Spice/Engine/RenderWrapper.hs +0/−31
- src/FRP/Spice/Engine/RunInput.hs +0/−31
- src/FRP/Spice/Game.hs +0/−29
- src/FRP/Spice/Graphics.hs +0/−17
- src/FRP/Spice/Graphics/Color.hs +0/−99
- src/FRP/Spice/Graphics/Geometry.hs +0/−76
- src/FRP/Spice/Graphics/Scene.hs +0/−13
- src/FRP/Spice/Graphics/Sprite.hs +0/−111
- src/FRP/Spice/Graphics/Utils.hs +0/−24
- src/FRP/Spice/Input.hs +0/−26
- src/FRP/Spice/Input/Backend.hs +0/−97
- src/FRP/Spice/Input/Keyboard.hs +0/−40
- src/FRP/Spice/Input/Mouse.hs +0/−52
- src/FRP/Spice/Input/MousePosition.hs +0/−31
- src/FRP/Spice/Internal/Assets.hs +81/−0
- src/FRP/Spice/Internal/Engine.hs +142/−0
- src/FRP/Spice/Internal/Graphics.hs +204/−0
- src/FRP/Spice/Internal/Input.hs +134/−0
- src/FRP/Spice/Internal/LoadAssets.hs +17/−0
- src/FRP/Spice/Internal/Math.hs +87/−0
- src/FRP/Spice/Internal/Types.hs +190/−0
- src/FRP/Spice/Math.hs +0/−9
- src/FRP/Spice/Math/Vector.hs +0/−64
- src/FRP/Spice/Utils/DoList.hs +0/−63
spice.cabal view
@@ -1,5 +1,5 @@ name: spice -version: 0.4.0.0 +version: 0.5.0.0 synopsis: An FRP-based game engine written in Haskell. description: An FRP-based game engine written in Haskell. - See the homepage for more information. homepage: http://github.com/crockeo/spice @@ -16,29 +16,14 @@ ghc-options: -Wall -fno-warn-unused-do-bind exposed-modules: FRP.Spice - FRP.Spice.Graphics - FRP.Spice.Math - other-modules: FRP.Spice.Assets - FRP.Spice.Config - FRP.Spice.Engine - FRP.Spice.Engine.Driver - FRP.Spice.Engine.Network - FRP.Spice.Engine.RenderWrapper - FRP.Spice.Engine.RunInput - FRP.Spice.Game - FRP.Spice.Graphics.Color - FRP.Spice.Graphics.Geometry - FRP.Spice.Graphics.Scene - FRP.Spice.Graphics.Sprite - FRP.Spice.Graphics.Utils - FRP.Spice.Input - FRP.Spice.Input.Backend - FRP.Spice.Input.Keyboard - FRP.Spice.Input.Mouse - FRP.Spice.Input.MousePosition - FRP.Spice.Math.Vector - FRP.Spice.Utils.DoList + other-modules: FRP.Spice.Internal.Assets + FRP.Spice.Internal.Engine + FRP.Spice.Internal.Graphics + FRP.Spice.Internal.Input + FRP.Spice.Internal.LoadAssets + FRP.Spice.Internal.Math + FRP.Spice.Internal.Types hs-source-dirs: src/ @@ -50,6 +35,6 @@ , bytestring == 0.10.* , JuicyPixels == 3.1.* , JuicyPixels-repa == 0.7.* - , OpenGL + , OpenGL >= 2.9.0.0 default-language: Haskell2010
src/FRP/Spice.hs view
@@ -1,24 +1,27 @@ {-| - This module re-exports some other modules in the spice library so that you - needn't import all of them explicitly. + This module re-exports the core elements of the library, along with all of + the types housed within the library. -} module FRP.Spice ( module Graphics.UI.GLFW , module Data.Map.Strict - , module FRP.Spice.Assets - , module FRP.Spice.Config - , module FRP.Spice.Engine - , module FRP.Spice.Input - , module FRP.Spice.Game + , module FRP.Spice.Internal.LoadAssets + , module FRP.Spice.Internal.Graphics + , module FRP.Spice.Internal.Engine + , module FRP.Spice.Internal.Types + , module FRP.Spice.Internal.Math ) where ------------------------ --- Rexported Imports -- -import Graphics.UI.GLFW (Key (..), SpecialKey (..), MouseButton (..)) +------------------------- +-- Re-exported Modules -- +import Graphics.UI.GLFW ( MouseButton (..) + , SpecialKey (..) + , Key (..) + ) import Data.Map.Strict ((!)) -import FRP.Spice.Assets -import FRP.Spice.Config -import FRP.Spice.Engine -import FRP.Spice.Input -import FRP.Spice.Game +import FRP.Spice.Internal.LoadAssets +import FRP.Spice.Internal.Graphics +import FRP.Spice.Internal.Engine +import FRP.Spice.Internal.Types +import FRP.Spice.Internal.Math
− src/FRP/Spice/Assets.hs
@@ -1,71 +0,0 @@-{-| - This module provides a clean way to load assets that will later be used in - the spice-based program. --} -module FRP.Spice.Assets where - --------------------- --- Global Imports -- -import qualified Data.Map.Strict as Map -import Control.Monad -import Data.Default - -------------------- --- Local Imports -- -import FRP.Spice.Graphics.Sprite -import FRP.Spice.Utils.DoList - ----------- --- Code -- - -{-| - A single call to load an asset. --} -data LoadAsset = LoadSprite FilePath - -{-| - A list of @'LoadAssets'@ that may be composed in do-notation. --} -type LoadAssets = DoList [LoadAsset] - -{-| - The data structure that contains the loaded assets. --} -data Assets = Assets { sprites :: Map.Map FilePath Sprite } - -{-| - The default state for the @'Assets'@ data type. Used as the initial state for - @'performAssetLoads'@. --} -defaultAssets :: Assets -defaultAssets = - Assets { sprites = Map.fromList [] } - -{-| - A synonym for @'defaultAssets'@ to fit within the data-default library. --} -instance Default Assets where - def = defaultAssets - -{-| - Appending a @'Sprite'@ to an @'Assets'@. --} -appendSprite :: Assets -> FilePath -> Sprite -> Assets -appendSprite assets path sprite = - assets { sprites = Map.insert path sprite $ sprites assets } - -{-| - Performing the actual loading upon a @'LoadAssets'@. --} -performAssetLoads :: LoadAssets -> IO Assets -performAssetLoads la = - performAssetLoads' (values la) defaultAssets - where performAssetLoads' :: [LoadAsset] -> Assets -> IO Assets - performAssetLoads' [] assets = return assets - performAssetLoads' (LoadSprite path:xs) assets = (liftM (appendSprite assets path) $ loadSprite path) >>= performAssetLoads' xs - -{-| - Loading a @'Sprite'@ asset. --} -loadSpriteAsset :: FilePath -> LoadAssets -loadSpriteAsset = fromValues . return . LoadSprite
− src/FRP/Spice/Config.hs
@@ -1,44 +0,0 @@-{-| - This module handles the configuration for the project. --} -module FRP.Spice.Config where - --------------------- --- Global Imports -- -import Data.Default - ----------- --- Code -- - -{-| - A datatype to configure the window settings when creating an OpenGL context - using @'FRP.Spice.Engine.startEngine'@ in the engine. --} -data WindowConfig = WindowConfig { getWindowWidth :: Int - , getWindowHeight :: Int - , getWindowFullscreen :: Bool - , getWindowTitle :: String - } - deriving (Eq, Show, Read) - -{-| - The default for @'WindowConfig'@ - - > getWindowWidth = 640 - > getWindowHeight = 480 - > getWindowFullscreen = False - > getWindowTitle = "Spice Application" --} -defaultWindowConfig :: WindowConfig -defaultWindowConfig = WindowConfig { getWindowWidth = 640 - , getWindowHeight = 480 - , getWindowFullscreen = False - , getWindowTitle = "Spice Application" - } - -{-| - A default instance for @'WindowConfig'@. Equivalent to calling - @'defaultWindowConfig'@. --} -instance Default WindowConfig where - def = defaultWindowConfig
− src/FRP/Spice/Engine.hs
@@ -1,90 +0,0 @@-{-| - This module handles starting the engine. This is done via the use of the - @'startEngine'@ function. --} -module FRP.Spice.Engine (startEngine) where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL -import Graphics.UI.GLFW as GLFW -import Data.IORef - -------------------- --- Local Imports -- -import FRP.Spice.Engine.RunInput -import FRP.Spice.Engine.Network -import FRP.Spice.Engine.Driver -import FRP.Spice.Input.Backend -import FRP.Spice.Assets -import FRP.Spice.Config -import FRP.Spice.Game -import FRP.Spice.Math - ----------- --- Code -- - --- Making the size from a WindowConfig -makeSize :: WindowConfig -> Size -makeSize wc = Size (fromIntegral $ getWindowWidth wc) (fromIntegral $ getWindowHeight wc) - --- Making the displaybits from a WindowConfig -makeDisplayBits :: [DisplayBits] -makeDisplayBits = [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] - --- Making the window mode from a WindowConfig -makeWindowMode :: WindowConfig -> WindowMode -makeWindowMode wc = - if getWindowFullscreen wc - then FullScreen - else Window - --- Resizing the window -resizeCallback :: IORef (Vector Int) -> WindowSizeCallback -resizeCallback wSize size@(Size w h) = do - writeIORef wSize $ Vector (fromIntegral w) (fromIntegral h) - viewport $= (Position 0 0, size) - -{-| - Starting the spice engine with the parameters prescribed in the - @'WindowConfig'@. It updates and renders the @'Game'@ automatically so all - you need to to is set up the @'WindowConfig'@ and make a datatype with an - instance of @'Game'@. --} -startEngine :: Game a => WindowConfig -> a -> IO () -startEngine wc game = do - -- Opening the window - initialize - openWindow (makeSize wc) makeDisplayBits (makeWindowMode wc) - windowTitle $= getWindowTitle wc - - -- Checking for the window being closed - closed <- newIORef False - windowCloseCallback $= do - writeIORef closed True - return True - - -- Function to run on window resize - wSizeRef <- newIORef $ Vector (getWindowWidth wc) (getWindowHeight wc) - windowSizeCallback $= resizeCallback wSizeRef - - -- Loading the assets - assets <- performAssetLoads $ loadAssets game - - -- Getting the input container - ic <- makeInputContainer - - -- Updating the input - mousePosCallback $= makeMousePositionCallback ic wSizeRef - keyCallback $= makeKeyboardCallback ic - mouseButtonCallback $= makeMouseCallback ic - - -- Creating the network - network <- makeNetwork (getInput ic) game - - -- Driving the network - GLFW.time $= 0 - driveNetwork assets network $ runInput closed - - -- Closing the window, after all is said and done - closeWindow
− src/FRP/Spice/Engine/Driver.hs
@@ -1,27 +0,0 @@-{-| - This module need not be used directly. Refer to @'FRP.Spice.Engine'@ instead. --} -module FRP.Spice.Engine.Driver where - --------------------- --- Global Imports -- -import FRP.Spice.Engine.RenderWrapper -import FRP.Spice.Assets -import FRP.Spice.Game - ----------- --- Code -- - -{-| - Driving a network created with the @'FRP.Spice.Engine.Network.makeNetwork'@ - function and a function such as @'FRP.Spice.Engine.RunInput.runInput'@. --} -driveNetwork :: Game a => Assets -> (Float -> IO a) -> IO (Maybe Float) -> IO () -driveNetwork assets network iomdriver = do - mdriver <- iomdriver - - case mdriver of - Just driver -> do state <- network driver - renderWrapper $ render assets state - driveNetwork assets network iomdriver - Nothing -> return ()
− src/FRP/Spice/Engine/Network.hs
@@ -1,31 +0,0 @@-{-| - This module need not be used directly. Refer to - @'FRP.Spice.Engine.startEngine'@ instead. --} -module FRP.Spice.Engine.Network where - --------------------- --- Global Imports -- -import FRP.Elerea.Param - -------------------- --- Local Imports -- -import FRP.Spice.Input -import FRP.Spice.Game - ----------- --- Code -- - -{-| - The raw update function that @'makeNetwork'@ calls. --} -updateFn :: Game a => Float -> Input -> a -> a -updateFn = update - -{-| - Creating a network to be used with the - @'FRP.Spice.Engine.Driver.driveNetwork'@ function. --} -makeNetwork :: Game a => Signal Input -> a -> IO (Float -> IO a) -makeNetwork inputSignal game = - start $ transfer game updateFn inputSignal
− src/FRP/Spice/Engine/RenderWrapper.hs
@@ -1,31 +0,0 @@-{-| - This module provides a wrapper to use with a given @'FRP.Spice.Game.Game'@'s - render function. --} -module FRP.Spice.Engine.RenderWrapper where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL -import Graphics.UI.GLFW - --------------------- --- Global Imports -- -import FRP.Spice.Graphics.Scene - ----------- --- Code -- - -{-| - A function to be ran on a @'FRP.Spice.Game.Game'@'s render function to - provide a bit of a framework around it. It runs @'clear'@ before the render - function, and @'flush'@ / @'swapBuffers'@ afterwards. --} -renderWrapper :: Scene -> IO () -renderWrapper scene = do - clear [ColorBuffer] - - scene - - flush - swapBuffers
− src/FRP/Spice/Engine/RunInput.hs
@@ -1,31 +0,0 @@-{-| - This module need not be used directly. Refer to @'FRP.Spice.Engine'@ instead. --} -module FRP.Spice.Engine.RunInput where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL -import Graphics.UI.GLFW as GLFW -import Data.IORef -import GHC.Float - ----------- --- Code -- - -{-| - Given an @'IORef'@ indicating whether or not the program should close, it - either returns the delta time since the last call, or a @'Nothing'@, - indicating that the program should close. --} -runInput :: IORef Bool -> IO (Maybe Float) -runInput closed = do - pollEvents - c <- readIORef closed - - if c - then return Nothing - else do - dt <- get GLFW.time - GLFW.time $= 0 - return $ Just $ double2Float dt
− src/FRP/Spice/Game.hs
@@ -1,29 +0,0 @@-{-| - This module provides the API which people must use to define a game within - the scope of Spice. --} -module FRP.Spice.Game where - -------------------- --- Local Imports -- -import FRP.Spice.Graphics.Scene -import FRP.Spice.Assets -import FRP.Spice.Input - ----------- --- Code -- - -{-| - A synonym to make the update function more self-documenting. --} -type DeltaTime = Float - -{-| - The class which is to be used in the @'FRP.Spice.Engine.startEngine'@ - function. @'update'@ provides the API to update on every tick (purely), an - @'render'@ provides the API to render every frame. --} -class Game a where - update :: DeltaTime -> Input -> a -> a - render :: Assets -> a -> Scene - loadAssets :: a -> LoadAssets
− src/FRP/Spice/Graphics.hs
@@ -1,17 +0,0 @@-{-| - This module re-exports a number of modules having to do with graphics. --} -module FRP.Spice.Graphics ( module FRP.Spice.Graphics.Geometry - , module FRP.Spice.Graphics.Sprite - , module FRP.Spice.Graphics.Color - , module FRP.Spice.Graphics.Scene - , module FRP.Spice.Graphics.Utils - ) where - ------------------------ --- Rexported Imports -- -import FRP.Spice.Graphics.Geometry -import FRP.Spice.Graphics.Sprite -import FRP.Spice.Graphics.Color -import FRP.Spice.Graphics.Scene -import FRP.Spice.Graphics.Utils
− src/FRP/Spice/Graphics/Color.hs
@@ -1,99 +0,0 @@-{-| - This module provides an abstraction over the default representations of color - in the Haskell OpenGL bindings. --} -module FRP.Spice.Graphics.Color where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL ( Color4 (..) - , color - ) - -------------------- --- Local Imports -- -import FRP.Spice.Graphics.Scene -import FRP.Spice.Graphics.Utils - ----------- --- Code -- - -{-| - Representing a Color using four @'Float'@ representing reg, green, blue, and - the alpha mask respectively. The @'Float'@s are in a range from 0-1, - representing @'Int'@s from 0-255. --} -data Color = Color { getRed :: Float - , getGreen :: Float - , getBlue :: Float - , getAlpha :: Float - } - deriving (Eq, Show, Read) - -{-| - Converting a color to an action in a @'Scene'@. --} -bindColor :: Color -> Scene -bindColor (Color r g b a) = - color $ Color4 (togl r) (togl g) (togl b) (togl a) - -{-| - A synonym for the @'Color'@ constructor. --} -color4f :: Float -> Float -> Float -> Float -> Color -color4f = Color - -{-| - Constructing a @'Color'@ from 3 @'Float'@s, defaulting the alpha mask to 1.0. --} -color3f :: Float -> Float -> Float -> Color -color3f r g b = color4f r g b 1.0 - -{-| - Creating a @'Color'@ from 4 @'Int'@s. The ints, similarly to @'color4f'@ - represent red, green, blue, and the alpha mask respectively. The ints should - be in the range of 0-255. (Note: @'color4i'@ is functionally equivalent (and - also equivalent in source code) to calling color4f with each of its arguments - divided by 255.) --} -color4i :: Int -> Int -> Int -> Int -> Color -color4i r g b a = color4f (fromIntegral r / 255) - (fromIntegral g / 255) - (fromIntegral b / 255) - (fromIntegral a / 255) - -{-| - Constructing a @'Color'@ from 3 @'Int'@s, defaulting the alpha mask to 255. --} -color3i :: Int -> Int -> Int -> Color -color3i r g b = color4i r g b 255 - -{-| - The color black. --} -black :: Color -black = color3i 0 0 0 - -{-| - The color white. --} -white :: Color -white = color3i 255 255 255 - -{-| - The color red. --} -red :: Color -red = color3i 255 0 0 - -{-| - The color green. --} -green :: Color -green = color3i 0 255 0 - -{-| - The color blue. --} -blue :: Color -blue = color3i 0 0 255
− src/FRP/Spice/Graphics/Geometry.hs
@@ -1,76 +0,0 @@-{-| - This module provides a cleaner API to render a number of shapes in the - current OpenGL context. --} -module FRP.Spice.Graphics.Geometry ( renderPoint - , renderLine - , renderRectangle - , renderSquare - , renderTriangle - , renderPolygon - ) where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL -import Control.Monad - -------------------- --- Local Imports -- -import FRP.Spice.Graphics.Scene -import FRP.Spice.Graphics.Utils -import FRP.Spice.Math.Vector - ----------- --- Code -- - -{-| - A version of @'renderPrimitive'@ where it takes a list of @'Vector'@ - @'Float'@s instead of performing @'vertex'@ calls. --} -renderPrimitive' :: PrimitiveMode -> [Vector Float] -> Scene -renderPrimitive' mode points = - renderPrimitive mode $ - forM_ points $ \(Vector x y) -> - vertex $ Vertex2 (togl x) (togl y) - -{-| - Rendering a point. --} -renderPoint :: Vector Float -> Scene -renderPoint pos = renderPrimitive' Points [pos] - -{-| - Rendering a line between two points. --} -renderLine :: Vector Float -> Vector Float -> Scene -renderLine p1 p2 = renderPrimitive' Lines [p1, p2] - -{-| - Rendering a rectangle. --} -renderRectangle :: Vector Float -> Vector Float -> Scene -renderRectangle (Vector x y) (Vector w h) = - renderPrimitive' Quads [ Vector (x ) (y ) - , Vector (x + w) (y ) - , Vector (x + w) (y + h) - , Vector (x ) (y + h) - ] - -{-| - Rendering a square. --} -renderSquare :: Vector Float -> Float -> Scene -renderSquare pos size = renderRectangle pos $ Vector size size - -{-| - Rendering a triangle. --} -renderTriangle :: Vector Float -> Vector Float -> Vector Float -> Scene -renderTriangle p1 p2 p3 = renderPrimitive' Triangles [p1, p2, p3] - -{-| - Rendering a polygon with 1-N vertecies. --} -renderPolygon :: [Vector Float] -> Scene -renderPolygon l = renderPrimitive' Polygon l
− src/FRP/Spice/Graphics/Scene.hs
@@ -1,13 +0,0 @@-{-| - This module provides an API to compose @'Scene'@s through do-notation. --} -module FRP.Spice.Graphics.Scene where - ----------- --- Code -- - -{-| - A type synonym for a single IO () call to suggest that users should be - *rendering* in render calls, and not performing other IO. --} -type Scene = IO ()
− src/FRP/Spice/Graphics/Sprite.hs
@@ -1,111 +0,0 @@-{-| - This module provides an API for loading and rendering textures in the form - of @'Sprite'@s. --} -module FRP.Spice.Graphics.Sprite ( Sprite (..) - , renderSprite - , loadSprite - ) where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL -import Data.ByteString.Unsafe -import Control.Applicative -import Codec.Picture.Repa -import Codec.Picture -import Control.Monad -import Foreign.Ptr - -------------------- --- Local Imports -- -import FRP.Spice.Graphics.Color -import FRP.Spice.Graphics.Scene -import FRP.Spice.Graphics.Utils -import FRP.Spice.Math - ----------- --- Code -- - -{-| - Getting the size from a @'DynamicImage'@. --} -getInfo :: DynamicImage -> (Int, Int, PixelInternalFormat) -getInfo (ImageRGB8 (Image w h _)) = (w, h, RGB8) -getInfo (ImageRGB16 (Image w h _)) = (w, h, RGB16) -getInfo (ImageRGBA8 (Image w h _)) = (w, h, RGBA8) -getInfo (ImageRGBA16 (Image w h _)) = (w, h, RGBA16) - -{-| - Loading a @'TextureObject'@ and @'Size'@ from any RGB8, RGB16, RGBA8, or - RGBA16 images. --} -loadTex :: FilePath -> IO (TextureObject, Size) -loadTex path = do - img <- either error id <$> readImageRGBA path - - let dynimg = imgToImage img - (w, h, format) = getInfo dynimg - glSize = TextureSize2D (fromIntegral w) (fromIntegral h) - bs = toByteString img - - ptr <- unsafeUseAsCString bs $ \cstr -> - return $ castPtr cstr - - [t] <- genObjectNames 1 - - textureBinding Texture2D $= Just t - texImage2D Texture2D NoProxy 0 format glSize 0 (PixelData ABGR UnsignedByte ptr) - - return (t, Size (fromIntegral w) (fromIntegral h)) - -{-| - A datatype to represent a @'TextureObject'@ through a reference to the - @'TextureObject'@ itself and its @'Size'@. --} -data Sprite = Sprite { spriteTex :: TextureObject - , spriteSize :: Vector Float - } - -{-| - Performing an OpenGL call to render the @'Sprite'@. --} -renderSprite :: Sprite -> Vector Float -> Scene -renderSprite sprite pos = do - textureWrapMode Texture2D S $= (Repeated, ClampToEdge) - textureWrapMode Texture2D T $= (Repeated, ClampToEdge) - textureFilter Texture2D $= ((Linear', Nothing), Linear') - textureFunction $= Replace - - texture Texture2D $= Enabled - textureBinding Texture2D $= (Just $ spriteTex sprite) - - renderPrimitive Quads $ - forM_ (generateCoords pos $ spriteSize sprite) $ \(Vector x y, Vector tx ty) -> do - texCoord $ TexCoord2 (togl tx) (togl ty) - vertex $ Vertex2 (togl x) (togl y) - - texture Texture2D $= Disabled - where generateCoords :: Vector Float -> Vector Float -> [(Vector Float, Vector Float)] - generateCoords (Vector x y) (Vector w h) = - [ (Vector (x ) (y ), Vector 0 0) - , (Vector (x + w) (y ), Vector 1 0) - , (Vector (x + w) (y + h), Vector 1 1) - , (Vector (x ) (y + h), Vector 0 1) - ] - -{-| - Creating a @'Sprite'@ from a @'TextureObject'@. --} -makeSprite :: (TextureObject, Size) -> Sprite -makeSprite (to, (Size w h)) = - Sprite { spriteTex = to - , spriteSize = size - } - where size = Vector ((fromIntegral w) / 640) ((fromIntegral h) / 480) - -{-| - Loading a @'Sprite'@ from a file. --} -loadSprite :: FilePath -> IO Sprite -loadSprite = liftM makeSprite . loadTex
− src/FRP/Spice/Graphics/Utils.hs
@@ -1,24 +0,0 @@-{-| - This module provides a set of utilities to ease the burden of writing OpenGL - rendering functions. --} -module FRP.Spice.Graphics.Utils where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL - ----------- --- Code -- - -{-| - Converting a @'Float'@ to a @'GLfloat'@ --} -togl :: Float -> GLfloat -togl = realToFrac - -{-| - Converting a @'GLfloat'@ to a @'Float'@. --} -fromgl :: GLfloat -> Float -fromgl = realToFrac
− src/FRP/Spice/Input.hs
@@ -1,26 +0,0 @@-{-| - This module provides everything relating to input in the scope of spice. --} -module FRP.Spice.Input where - --------------------- --- Global Imports -- -import Graphics.UI.GLFW -import Data.Map.Strict - -------------------- --- Local Imports -- -import FRP.Spice.Math - ----------- --- Code -- - -{-| - A container for all of the states themselves. It is used as a @'Signal'@ - @'Input'@ in the @'InputContainer'@ (which is necessary to use it within - Elerea's FRP network). --} -data Input = Input { mousePosition :: Vector Float - , keyboard :: Map Key Bool - , mouse :: Map MouseButton Bool - }
− src/FRP/Spice/Input/Backend.hs
@@ -1,97 +0,0 @@-{-| - The backend to be used with the input. --} -module FRP.Spice.Input.Backend where - --------------------- --- Global Imports -- -import Graphics.Rendering.OpenGL -import Graphics.UI.GLFW as GLFW -import FRP.Elerea.Param -import Data.Map.Strict -import Data.IORef - -------------------- --- Local Imports -- -import qualified FRP.Spice.Input.MousePosition as MousePosition -import qualified FRP.Spice.Input.Keyboard as Keyboard -import qualified FRP.Spice.Input.Mouse as Mouse -import FRP.Spice.Input -import FRP.Spice.Math - ----------- --- Code -- - -{-| - A wrapper around the sinks for the mouse position, the key states, and the - mouse button states. --} -data Sinks = Sinks { mousePositionSinks :: Vector Float -> IO () - , keyboardSinks :: Map Key (Bool -> IO ()) - , mouseSinks :: Map MouseButton (Bool -> IO ()) - } - - - -{-| - A container around @'Sinks'@ and @'Signal'@ @'Input'@ so that one needn't - pass around a tuple. --} -data InputContainer = InputContainer { getSinks :: Sinks - , getInput :: Signal Input - } - -{-| - Making an @'InputContainer'@ filled with all necessary externals. --} -makeInputContainer :: IO InputContainer -makeInputContainer = do - mousePositionExternals <- MousePosition.externals - keyboardExternals <- Keyboard.externals - mouseExternals <- Mouse.externals - - let sinks = Sinks { mousePositionSinks = MousePosition.sinks mousePositionExternals - , keyboardSinks = Keyboard.sinks keyboardExternals - , mouseSinks = Mouse.sinks mouseExternals - } - - let input = do mps <- fst mousePositionExternals - kbs <- Keyboard.signals keyboardExternals - ms <- Mouse.signals mouseExternals - - return Input { mousePosition = mps - , keyboard = kbs - , mouse = ms - } - - return InputContainer { getSinks = sinks - , getInput = input - } - -{-| - Creating a callback to update the mouse position's state. --} -makeMousePositionCallback :: InputContainer -> IORef (Vector Int) -> MousePosCallback -makeMousePositionCallback ic wSizeRef (Position x y) = do - (Vector w h) <- readIORef wSizeRef - mousePositionSinks (getSinks ic) $ - Vector ( fromIntegral x / ((fromIntegral $ w) / 2) - 1) - ((-fromIntegral y) / ((fromIntegral $ h) / 2) + 1) - -{-| - Creating a callback to update the keyboard's states. --} -makeKeyboardCallback :: InputContainer -> KeyCallback -makeKeyboardCallback ic key state = - keyboardSinks (getSinks ic) ! key $ case state of - Press -> True - Release -> False - -{-| - Creating a callback to update the mouse buttons' states. --} -makeMouseCallback :: InputContainer -> MouseButtonCallback -makeMouseCallback ic button state = - mouseSinks (getSinks ic) ! button $ case state of - Press -> True - Release -> False
− src/FRP/Spice/Input/Keyboard.hs
@@ -1,40 +0,0 @@-{-| - The keyboard specific section of input. --} -module FRP.Spice.Input.Keyboard where - --------------------- --- Global Imports -- -import qualified Data.Traversable as T -import Data.Map.Strict hiding (keys, map) -import Graphics.UI.GLFW as GLFW -import FRP.Elerea.Param -import Control.Monad - ----------- --- Code -- - -{-| - A list of all possible keys used in the GLFW API. --} -keys :: [Key] -keys = map toEnum [0 .. 318] - -{-| - A Map from @'Key'@ to the externals created for every single key. --} -externals :: IO (Map Key (Signal Bool, Bool -> IO ())) -externals = liftM fromList $ mapM (\k -> liftM ((,) k) $ external False) keys - -{-| - Creating the @'Signal'@ of a @'Map'@ from @'Key'@ to @'Bool'@ from a @'Map'@ - of @'externals'@. --} -signals :: Map Key (Signal Bool, Bool -> IO ()) -> Signal (Map Key Bool) -signals = T.sequence . fmap fst - -{-| - Making a @'Map'@ from @'Key'@ to sink from a @'Map'@ of @'externals'@. --} -sinks :: Map Key (Signal Bool, Bool -> IO ()) -> Map Key (Bool -> IO ()) -sinks = fmap snd
− src/FRP/Spice/Input/Mouse.hs
@@ -1,52 +0,0 @@-{-| - The mouse (button) specific section of input. --} -module FRP.Spice.Input.Mouse where - --------------------- --- Global Imports -- -import qualified Data.Traversable as T (sequence) -import Data.Map.Strict hiding (keys, map) -import Graphics.UI.GLFW as GLFW -import FRP.Elerea.Param -import Control.Monad - ----------- --- Code -- - -{-| - Adding an instance of Ord to MouseButton so it can be used with the map. --} -instance Ord MouseButton where - mb1 <= mb2 = fromEnum mb1 < fromEnum mb2 - -{-| - A list of all mouse buttons available via the GLFW api. --} -buttons :: [MouseButton] -buttons = [ ButtonLeft - , ButtonRight - , ButtonMiddle - ] - ++ - map ButtonNo [0 .. 7] - -{-| - A map from @'MouseButton'@ to externals created for every button. --} -externals :: IO (Map MouseButton (Signal Bool, Bool -> IO ())) -externals = liftM fromList $ mapM (\b -> liftM ((,) b) $ external False) buttons - -{-| - Creating the @'Signal'@ of a @'Map'@ from @'MouseButton'@ to @'Bool'@ from a - @'Map'@ of @'externals'@. --} -signals :: Map MouseButton (Signal Bool, Bool -> IO ()) -> Signal (Map MouseButton Bool) -signals = T.sequence . fmap fst - -{-| - Making a @'Map'@ from @'MouseButton'@ to sink from a @'Map'@ of - @'externals'@. --} -sinks :: Map MouseButton (Signal Bool, Bool -> IO ()) -> Map MouseButton (Bool -> IO ()) -sinks = fmap snd
− src/FRP/Spice/Input/MousePosition.hs
@@ -1,31 +0,0 @@-{-| - The mouse (position) specific section of input. --} -module FRP.Spice.Input.MousePosition where - --------------------- --- Global Imports -- -import FRP.Elerea.Param -import Data.Default - -------------------- --- Local Imports -- -import FRP.Spice.Math.Vector - -{-| - Creating the external for the mouse position. --} -externals :: IO (Signal (Vector Float), Vector Float -> IO ()) -externals = external def - -{-| - Getting the signal from the mouse position external. --} -signals :: (Signal (Vector Float), Vector Float -> IO ()) -> Signal (Vector Float) -signals = fst - -{-| - Getting the sink from the mouse position external. --} -sinks :: (Signal (Vector Float), Vector Float -> IO ()) -> Vector Float -> IO () -sinks = snd
+ src/FRP/Spice/Internal/Assets.hs view
@@ -0,0 +1,81 @@+{-| + This module provides functions to load and manage the loading of assets. +-} +module FRP.Spice.Internal.Assets (performAssetLoads) where + +-------------------- +-- Global Imports -- +import qualified Data.Map.Strict as Map +import Graphics.Rendering.OpenGL +import Graphics.UI.GLFW as GLFW +import Data.ByteString.Unsafe +import Control.Applicative +import Codec.Picture.Repa +import Codec.Picture +import Control.Monad +import Data.Default +import Foreign.Ptr + +------------------- +-- Local Imports -- +import FRP.Spice.Internal.Types + +---------- +-- Code -- + +{-| + Loading a @'Sprite'@ from the file system from the @'FilePath'@ specified. +-} +loadSprite :: FilePath -> IO Sprite +loadSprite path = do + wsize <- get windowSize + liftM (makeSprite wsize) $ loadTexture path + where getInfo :: DynamicImage -> Either String (Int, Int, PixelInternalFormat) + getInfo (ImageRGB8 (Image w h _)) = Right (w, h, RGB8) + getInfo (ImageRGB16 (Image w h _)) = Right (w, h, RGB16) + getInfo (ImageRGBA8 (Image w h _)) = Right (w, h, RGBA8) + getInfo (ImageRGBA16 (Image w h _)) = Right (w, h, RGBA16) + getInfo _ = Left "Unsupported image type." + + loadTexture :: FilePath -> IO (TextureObject, Size) + loadTexture path = do + img <- either error id <$> readImageRGBA path + + let dynimg = imgToImage img + (w, h, format) = either error id $ getInfo dynimg + glSize = TextureSize2D (fromIntegral w) (fromIntegral h) + bs = toByteString img + + ptr <- unsafeUseAsCString bs $ \cstr -> + return $ castPtr cstr + + [t] <- genObjectNames 1 + + textureBinding Texture2D $= Just t + texImage2D Texture2D NoProxy 0 format glSize 0 (PixelData ABGR UnsignedByte ptr) + + return (t, Size (fromIntegral w) (fromIntegral h)) + + makeSprite :: Size -> (TextureObject, Size) -> Sprite + makeSprite (Size ww wh) (to, (Size w h)) = + Sprite { spriteTex = to + , spriteSize = Vector ((fromIntegral w) / (fromIntegral ww)) + ((fromIntegral h) / (fromIntegral wh)) + } + +{-| + Appending a @'Sprite'@ to an @'Assets'@. +-} +appendSprite :: Assets -> FilePath -> Sprite -> Assets +appendSprite assets path sprite = + assets { sprites = Map.insert path sprite $ sprites assets } + +{-| + Performing all of the @'LoadAsset'@ commands contained in a @'LoadAssets'@. +-} +performAssetLoads :: LoadAssets -> IO Assets +performAssetLoads (DoListT las _) = + performAssetLoads' las def + where performAssetLoads' :: [LoadAsset] -> Assets -> IO Assets + performAssetLoads' [] assets = return assets + performAssetLoads' ((LoadSprite path):xs) assets = (liftM (appendSprite assets path) $ loadSprite path) >>= performAssetLoads' xs
+ src/FRP/Spice/Internal/Engine.hs view
@@ -0,0 +1,142 @@+{-| + This module contains all of the functions to create and start the engine. The + only exposed function is @'startEngine'@ seeing as every other function is to + be used solely internally within the module. +-} +module FRP.Spice.Internal.Engine ( startEngine + , startEngineDefault + ) where + +-------------------- +-- Global Imports -- +import Graphics.Rendering.OpenGL +import Graphics.UI.GLFW as GLFW +import FRP.Elerea.Param +import Data.Default +import Data.IORef + +------------------- +-- Local Imports -- +import FRP.Spice.Internal.Assets +import FRP.Spice.Internal.Input +import FRP.Spice.Internal.Types + +---------- +-- Code -- + +{-| + The callback for the window closing. +-} +closeCallback :: IORef Bool -> WindowCloseCallback +closeCallback closedRef = do + writeIORef closedRef True + return True + +{-| + The callback for the window resizing. +-} +resizeCallback :: WindowSizeCallback +resizeCallback size@(Size w' h') = do + let (Vector w h) = Vector (fromIntegral w' / 640) (fromIntegral h' / 480) + + matrixMode $= Projection + loadIdentity + + ortho (-w) ( w) + (-h) ( h) + (-1) ( 1) + + matrixMode $= Modelview 0 + viewport $= (Position 0 0, size) + +{-| + Creating the elerea network to be used in @'driveNetwork'@. +-} +makeNetwork :: Game a => a -> Signal Input -> IO (Float -> IO a) +makeNetwork game inputSignal = start $ transfer game update inputSignal + +{-| + Either sending back a 'should close window' (in the form of a Nothing) signal + or the @'DeltaTime'@ (type synonym for @'Float'@) since the last update. +-} +runInput :: IORef Bool -> IO (Maybe DeltaTime) +runInput closedRef = do + pollEvents + closed <- readIORef closedRef + + t <- get time + time $= 0 + + return $ if closed + then Nothing + else Just $ realToFrac t + +{-| + Driving the network created from @'makeNetwork'@ with the input created from + @'runInput'@ to run the game loop. +-} +driveNetwork :: Game a => Assets -> (Float -> IO a) -> IO (Maybe Float) -> IO () +driveNetwork assets network iomdriver = do + mdriver <- iomdriver + + case mdriver of + Nothing -> return () + Just driver -> do + game <- network driver + renderWrapper $ render assets game + driveNetwork assets network iomdriver + where renderWrapper :: Scene -> IO () + renderWrapper scene = do + clear [ColorBuffer] + scene + swapBuffers + +{-| + Starting the engine with window parameters described within the provided + @'WindowConfig'@. +-} +startEngine :: Game a => WindowConfig -> a -> IO () +startEngine wc game = do + -- Opening the window + initialize + openWindow (Size (fromIntegral $ getWindowWidth wc) + (fromIntegral $ getWindowHeight wc)) + [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] + (case getWindowFullscreen wc of + True -> FullScreen + False -> Window) + + -- An IORef to keep track of when the window is closed + closedRef <- newIORef False + + -- Setting window parameters + windowTitle $= getWindowTitle wc + windowCloseCallback $= closeCallback closedRef + windowSizeCallback $= resizeCallback + + -- Loading the assets + assets <- performAssetLoads $ loadAssets game + + -- Creating the input container + ic <- makeInputContainer + + -- Setting the input callbacks + mousePosCallback $= makeMousePosCallback ic + mouseButtonCallback $= makeMouseButtonCallback ic + keyCallback $= makeKeyCallback ic + + -- Creating the network + network <- makeNetwork game $ getInput ic + + -- Starting the network + time $= 0 + driveNetwork assets network $ runInput closedRef + + -- Closing the window, after all is said and done + closeWindow + +{-| + Starting the engine with default window parameter. +-} +startEngineDefault :: Game a => a -> IO () +startEngineDefault = startEngine def
+ src/FRP/Spice/Internal/Graphics.hs view
@@ -0,0 +1,204 @@+{-| + +-} +module FRP.Spice.Internal.Graphics ( bindColor + , color4f + , color3f + , color4i + , color3i + , black + , white + , grey + , gray + , red + , green + , blue + , renderPoint + , renderLine + , renderTriangle + , renderRectangle + , renderSquare + , renderPolygon + , renderSprite + , renderSpriteWithSize + ) where + +-------------------- +-- Global Imports -- +import Graphics.Rendering.OpenGL hiding (Color) +import Control.Monad + +------------------- +-- Local Imports -- +import FRP.Spice.Internal.Types + +---------- +-- Code -- + +{-| + Converting a @'Float'@ to a @'GLfloat'@. +-} +toGL :: Float -> GLfloat +toGL = realToFrac + +{-| + Binding a color to change the current OpenGL color. +-} +bindColor :: Color -> Scene +bindColor (Color r g b a) = color $ Color4 (toGL r) (toGL g) (toGL b) (toGL a) + +{-| + Constructing a color from 4 @'Float'@s. +-} +color4f :: Float -> Float -> Float -> Float -> Color +color4f = Color + +{-| + Constructing a color from 3 @'Float'@s, with the alpha channel defaulting to + its maximum (of 1.0). +-} +color3f :: Float -> Float -> Float -> Color +color3f r g b = color4f r g b 1.0 + +{-| + Constructing a color from 4 @'Int'@s. +-} +color4i :: Int -> Int -> Int -> Int -> Color +color4i r g b a = + color4f (fromIntegral r / 255) + (fromIntegral g / 255) + (fromIntegral b / 255) + (fromIntegral a / 255) + +{-| + Constructing a color from 3 @'Int'@s, with the alpha channel defaulting to + its maximum (of 255). +-} +color3i :: Int -> Int -> Int -> Color +color3i r g b = color4i r g b 255 + +{-| + The color black. +-} +black :: Color +black = color3i 0 0 0 + +{-| + The color white. +-} +white :: Color +white = color3i 255 255 255 + +{-| + The color gray. +-} +grey :: Color +grey = color3i 255 255 255 + +{-| + A synonym for the color grey. +-} +gray :: Color +gray = grey + +{-| + The color red. +-} +red :: Color +red = color3i 255 0 0 + +{-| + The color green. +-} +green :: Color +green = color3i 0 255 0 + +{-| + The color blue. +-} +blue :: Color +blue = color3i 0 0 255 + +{-| + Rendering a primitive. +-} +renderPrimitive' :: PrimitiveMode -> [Vector Float] -> Scene +renderPrimitive' pm l = + renderPrimitive pm $ + forM_ l $ \(Vector x y) -> + vertex $ Vertex2 (toGL x) (toGL y) + +{-| + Rendering a position. +-} +renderPoint :: Vector Float -> Scene +renderPoint = renderPrimitive' Points . return + +{-| + Rendering a line. +-} +renderLine :: Vector Float -> Vector Float -> Scene +renderLine p1 p2 = renderPrimitive' Lines [p1, p2] + +{-| + Rendering a triangle. +-} +renderTriangle :: Vector Float -> Vector Float -> Vector Float -> Scene +renderTriangle p1 p2 p3 = renderPrimitive' Triangles [p1, p2, p3] + +{-| + Rendering a rectangle. +-} +renderRectangle :: Vector Float -> Vector Float -> Scene +renderRectangle (Vector x y) (Vector w h) = + renderPrimitive' Quads [ Vector (x ) (y ) + , Vector (x + w) (y ) + , Vector (x + w) (y + h) + , Vector (x ) (y + h) + ] + +{-| + Rendering a square. +-} +renderSquare :: Vector Float -> Float -> Scene +renderSquare pos x = renderRectangle pos $ Vector x x + +{-| + Rendering a polygon of any n sides. +-} +renderPolygon :: [Vector Float] -> Scene +renderPolygon l = renderPrimitive' Polygon l + +{-| + Rendering a @'Sprite'@ at the position specified. +-} +renderSprite :: Sprite -> Vector Float -> Scene +renderSprite sprite pos = do + textureWrapMode Texture2D S $= (Repeated, ClampToEdge) + textureWrapMode Texture2D T $= (Repeated, ClampToEdge) + textureFilter Texture2D $= ((Linear', Nothing), Linear') + textureFunction $= Replace + + texture Texture2D $= Enabled + textureBinding Texture2D $= (Just $ spriteTex sprite) + + renderPrimitive Quads $ + forM_ (generateCoords pos $ spriteSize sprite) $ \(Vector x y, Vector tx ty) -> do + texCoord $ TexCoord2 (toGL tx) (toGL ty) + vertex $ Vertex2 (toGL x) (toGL y) + + texture Texture2D $= Disabled + where generateCoords :: Vector Float -> Vector Float -> [(Vector Float, Vector Float)] + generateCoords (Vector x y) (Vector w h) = + [ (Vector (x ) (y ), Vector 0 0) + , (Vector (x + w) (y ), Vector 1 0) + , (Vector (x + w) (y + h), Vector 1 1) + , (Vector (x ) (y + h), Vector 0 1) + ] + +{-| + Rendering a @'Sprite'@ at the position specified with the size specified. +-} +renderSpriteWithSize :: Sprite -> Vector Float -> Vector Float -> Scene +renderSpriteWithSize sprite pos size = + renderSprite (sprite { spriteSize = size }) pos
+ src/FRP/Spice/Internal/Input.hs view
@@ -0,0 +1,134 @@+{-| + This module provides functions having to do with the creating and handling of + input. +-} +module FRP.Spice.Internal.Input ( makeInputContainer + , makeMousePosCallback + , makeMouseButtonCallback + , makeKeyCallback + ) where + +-------------------- +-- Global Imports -- +import qualified Data.Map.Strict as Map +import qualified Data.Traversable as T +import Graphics.Rendering.OpenGL +import Graphics.UI.GLFW as GLFW +import Data.Map.Strict ((!)) +import FRP.Elerea.Param +import Control.Monad + +------------------- +-- Local Imports -- +import FRP.Spice.Internal.Types +---------- +-- Code -- + +{-| + An intentionally orphan instance of @'Ord'@ for @'MouseButton'@ so that it + may be used in a Map. +-} +instance Ord MouseButton where + mb1 <= mb2 = + fromEnum mb1 <= fromEnum mb2 + +{-| + Making a list of externals from a given list. +-} +makeExternals :: Ord a => [a] -> IO (Map.Map a (Signal Bool, Bool -> IO ())) +makeExternals l = liftM Map.fromList $ mapM (\k -> liftM ((,) k) $ external False) l + +{-| + The external for mouse position. +-} +mousePosExternal :: IO (Signal (Vector Float), Vector Float -> IO ()) +mousePosExternal = external $ Vector 0 0 + +{-| + A list of all mouse buttons in the GLFW API. +-} +mouseButtons :: [MouseButton] +mouseButtons = [ ButtonLeft + , ButtonRight + , ButtonMiddle + ] + ++ + map ButtonNo [0 .. 7] + +{-| + A @'Map.Map'@ of @'MouseButton'@ to externals created from the @'mouseButton'@. +-} +mouseButtonExternal :: IO (Map.Map MouseButton (Signal Bool, Bool -> IO ())) +mouseButtonExternal = makeExternals mouseButtons + +{-| + A list of all keys in the GLFW API. +-} +keys :: [Key] +keys = map toEnum [0 .. 318] + +{-| + A @'Map.Map'@ of @'Key'@ to externals created from the @'key'@. +-} +keyExternal :: IO (Map.Map Key (Signal Bool, Bool -> IO ())) +keyExternal = makeExternals keys + +{-| + Making a given @'InputContainer'@. +-} +makeInputContainer :: IO InputContainer +makeInputContainer = do + (mpSing, mpSink) <- mousePosExternal + + mouseButtonEx <- mouseButtonExternal + keyEx <- keyExternal + + let mbSing = Map.map fst mouseButtonEx + mbSink = Map.map snd mouseButtonEx + kSing = Map.map fst keyEx + kSink = Map.map snd keyEx + + sing = do + a <- mpSing + b <- T.sequence mbSing + c <- T.sequence kSing + + return $ Input a b c + + sink = Sinks { mousePosSink = mpSink + , mouseButtonSink = mbSink + , keySink = kSink + } + + return $ InputContainer sink sing + + +{-| + Making the mousePosCallback function. +-} +makeMousePosCallback :: InputContainer -> MousePosCallback +makeMousePosCallback ic (Position x y) = do + (Size w h) <- get windowSize + (mousePosSink $ getSinks ic) $ + Vector ( fromIntegral x / 320 - ((fromIntegral w) / 640)) + ((-fromIntegral y) / 240 + ((fromIntegral h) / 480)) + +{-| + Making the mouseButtonCallback function. +-} +makeMouseButtonCallback :: InputContainer -> MouseButtonCallback +makeMouseButtonCallback ic inputMouseButton state = + (mouseButtonSink $ getSinks ic) ! inputMouseButton $ + case state of + Press -> True + Release -> False + +{-| + Making the keyCallback function. +-} +makeKeyCallback :: InputContainer -> KeyCallback +makeKeyCallback ic inputKey state = + (keySink $ getSinks ic) ! inputKey $ + case state of + Press -> True + Release -> False
+ src/FRP/Spice/Internal/LoadAssets.hs view
@@ -0,0 +1,17 @@+{-| + This module provides functions to cleanly assemble @'LoadAssets'@ objects. +-} +module FRP.Spice.Internal.LoadAssets where + +------------------- +-- Local Imports -- +import FRP.Spice.Internal.Types + +---------- +-- Code -- + +{-| + Creating a @'LoadAsset'@ call to load a @'Sprite'@. +-} +loadSpriteAsset :: FilePath -> LoadAssets +loadSpriteAsset path = DoListT [LoadSprite path] ()
+ src/FRP/Spice/Internal/Math.hs view
@@ -0,0 +1,87 @@+{-| + This module provides a number of functions having to do with mathematical + calculation in the context of the Spice library. +-} +module FRP.Spice.Internal.Math where + +-------------------- +-- Global Imports -- +import Control.Applicative + +------------------- +-- Local Imports -- +import FRP.Spice.Internal.Types + +---------- +-- Code -- + +{-| + The cardinal directions. +-} +up, down, left, right :: Num a => Vector a +up = Vector ( 0) ( 1) +down = Vector ( 0) (-1) +left = Vector (-1) ( 0) +right = Vector ( 1) ( 0) + + +{-| + Adding two @'Vector'@s. +-} +infixl 6 ^+ +(^+) :: Num a => Vector a -> Vector a -> Vector a +(^+) v1 v2 = pure (+) <*> v1 <*> v2 + +{-| + Subtracting a @'Vector'@ from another @'Vector'@. +-} +infixl 6 ^- +(^-) :: Num a => Vector a -> Vector a -> Vector a +(^-) v1 v2 = pure (-) <*> v1 <*> v2 + +{-| + Multiplying two @'Vector'@s (not a dot product, but rather multiplying the + first value in the first vector by the second value in the second vector, + and the same with with the second value.) +-} +infixl 7 ^* +(^*) :: Num a => Vector a -> Vector a -> Vector a +(^*) v1 v2 = pure (*) <*> v1 <*> v2 + +{-| + The dot product of two @'Vector'@s. +-} +infixl 7 ^. +(^.) :: Num a => Vector a -> Vector a -> a +(^.) (Vector x1 y1) (Vector x2 y2) = x1 * x2 + y1 * y2 + +{-| + Adding a @'Vector'@ and a given number. Effectively the same as calling (^+) + on a @'Vector'@ and a @'Vector'@ n n. +-} +infixl 6 ^+> +(^+>) :: Num a => Vector a -> a -> Vector a +(^+>) v n = pure (+) <*> v <*> pure n + +{-| + Subtracting a number from a @'Vector'@. Effectively the same as calling (^-) + on a @'Vector'@ and a @'Vector'@ n n. +-} +infixl 6 ^-> +(^->) :: Num a => Vector a -> a -> Vector a +(^->) v n = pure (-) <*> v <*> pure n + +{-| + Multiplying a @'Vector'@ by a given number. Effecitvely the same as calling + (^*) on a @'Vector'@ and a @'Vector'@ n n. +-} +infixl 7 ^*> +(^*>) :: Num a => Vector a -> a -> Vector a +(^*>) v n = pure (*) <*> v <*> pure n + +{-| + The dot product of two @'Vector'@s. +-} +infixl 7 ^.> +(^.>) :: Num a => Vector a -> a -> a +(^.>) (Vector x1 y1) n = x1 * n + y1 * n
+ src/FRP/Spice/Internal/Types.hs view
@@ -0,0 +1,190 @@+{-| + This module provides every single type defined within the spice framework. + This allows people to write functions on data structures without being + concerned about recursive imports (and thereby being unable to compile) due + to the fact that this file does not and WILL NEVER import any other local libraries. +-} +module FRP.Spice.Internal.Types where + +-------------------- +-- Global Imports -- +import qualified Data.Map.Strict as Map +import Graphics.Rendering.OpenGL +import Graphics.UI.GLFW as GLFW +import Control.Applicative +import FRP.Elerea.Param +import Data.Default +import Data.Monoid + +---------- +-- Code -- + +{-| + A data type that can be composed (so long as the data stored is a Monoid) in + do-notation. +-} +data DoListT a b = DoListT a b + +{-| + A type synonym for the @'DoListT'@ that should be used. +-} +type DoList a = DoListT a () + +{-| + A Functor instance to satisfy the Applicative's requirements. +-} +instance Functor (DoListT a) where + fmap fn (DoListT a b) = DoListT a $ fn b + +{-| + An Applicative instance to satisfy the Monad's requirements in the future. +-} +instance Monoid a => Applicative (DoListT a) where + pure b = DoListT mempty b + (DoListT a' bfn) <*> (DoListT a b) = + DoListT (a `mappend` a') $ bfn b + +{-| + The Monad instance to allow the DoList to compose through do-notation. +-} +instance Monoid a => Monad (DoListT a) where + return = pure + (DoListT a b) >>= fn = + let (DoListT a' b') = fn b in + DoListT (mappend a a') b' + +{-| + The config that is used to define the GLFW window's properties. +-} +data WindowConfig = WindowConfig { getWindowWidth :: Int + , getWindowHeight :: Int + , getWindowFullscreen :: Bool + , getWindowTitle :: String + } + +{-| + The default state for a @'WindowConfig'@. +-} +instance Default WindowConfig where + def = WindowConfig { getWindowWidth = 640 + , getWindowHeight = 480 + , getWindowFullscreen = False + , getWindowTitle = "Spice Application" + } + +{-| + A data type representing a color as 4 floats (r, g, b, a) representing red, + green, blue, and the alpha channel respectively. The floats should range from + 0 to 1, representing 0 to 255 in more classical representations. +-} +data Color = Color { colorRed :: Float + , colorGreen :: Float + , colorBlue :: Float + , colorAlpha :: Float + } + +{-| + A data type that stores two values. It can be used to perform basic vector + logic. It should be noted that the @'Vector'@ logic provided in this library + is not linear-algebra style vector logic. +-} +data Vector a = Vector a a + +{-| + The default state for a @'Vector'@. +-} +instance Default a => Default (Vector a) where + def = Vector def def + +{-| + A functor instance to apply a function onto both values stored in a + @'Vector'@. +-} +instance Functor Vector where + fmap fn (Vector x y) = Vector (fn x) (fn y) + +{-| + An applicative instance to allow one to write functions on @'Vector'@s that + have separate functions for both values. +-} +instance Applicative Vector where + pure a = Vector a a + (Vector fnx fny) <*> (Vector x y) = + Vector (fnx x) (fny y) + +{-| + A wrapper around the sinks for the mouse position, mouse buttons, and + keyboard keys. +-} +data Sinks = Sinks { mousePosSink :: Vector Float -> IO () + , mouseButtonSink :: Map.Map MouseButton (Bool -> IO ()) + , keySink :: Map.Map Key (Bool -> IO ()) + } + +{-| + A data structure that represents the current state of the input. Used in the + @'InputContainer'@ along with the @'Sink'@ to handle all input -- updating + and referencing. +-} +data Input = Input { mousePos :: Vector Float + , mouseButton :: Map.Map MouseButton Bool + , key :: Map.Map Key Bool + } + +{-| + The container for both @'Sink'@ and @'Input'@. The @'Input'@ is stored within + a @'Signal'@ so it may be used within the FRP/Elerea part of the framework. +-} +data InputContainer = InputContainer { getSinks :: Sinks + , getInput :: Signal Input + } + +{-| + Containing all of the necessary information for rendering an image on screen + (aside from the position where the sprite should be rendered.) +-} +data Sprite = Sprite { spriteTex :: TextureObject + , spriteSize :: Vector Float + } + +{-| + Representing the loading of an asset into the game framework. +-} +data LoadAsset = LoadSprite FilePath + +{-| + A @'DoList'@ synonym for @'LoadAsset'@. +-} +type LoadAssets = DoList [LoadAsset] + +{-| + Storing the loaded assets in a single data structure. +-} +data Assets = Assets { sprites :: Map.Map FilePath Sprite } + +{-| + The default state for an @'Assets'@. +-} +instance Default Assets where + def = Assets { sprites = Map.fromList [] } + +{-| + A type synonym to imply that functions performed in this function should + solely render. +-} +type Scene = IO () + +{-| + A type synonym to make the delta time (in the @'Game'@ definition) more self + documenting. +-} +type DeltaTime = Float + +{-| + The requirements for a given data structure to be used as a game within the + framework. +-} +class Game a where + update :: DeltaTime -> Input -> a -> a + render :: Assets -> a -> Scene + loadAssets :: a -> LoadAssets
− src/FRP/Spice/Math.hs
@@ -1,9 +0,0 @@-{-| - This module re-exports a number of modules having to do with math. --} -module FRP.Spice.Math ( module FRP.Spice.Math.Vector - ) where - ------------------------ --- Rexported Imports -- -import FRP.Spice.Math.Vector
− src/FRP/Spice/Math/Vector.hs
@@ -1,64 +0,0 @@-{-| - This module provides a @'Vector'@ datatype as described below. --} -module FRP.Spice.Math.Vector where - --------------------- --- Global Imports -- -import Control.Applicative -import Data.Default -import Data.Monoid - ----------- --- Code -- - -{-| - A datatype that houses two values of a given type. It is provided with a - @'Num'@ instance so that, when used with number types it can function - similarly (though not exactly) to a mathematical vector. --} -data Vector a = Vector a a - -{-| - The default for the @'Vector'@. --} -instance Default a => Default (Vector a) where - def = Vector def def - -{-| - Displaying the @'Vector'@. --} -instance Show a => Show (Vector a) where - show (Vector x y) = mconcat ["Vector ", show x, " ", show y] - -{-| - Performs operations on the matching fields of the other @'Vector'@. --} -instance Num a => Num (Vector a) where - (Vector x1 y1) + (Vector x2 y2) = Vector (x1 + x2) (y1 + y2) - (Vector x1 y1) * (Vector x2 y2) = Vector (x1 * x2) (y1 * y2) - - fromInteger n = Vector (fromInteger n) (fromInteger n) - - abs (Vector x y) = Vector (abs x) (abs y) - signum (Vector x y) = Vector (signum x) (signum y) - negate (Vector x y) = Vector (negate x) (negate y) - -{-| - Maps over both values in the @'Vector'@. --} -instance Functor Vector where - fmap fn (Vector x y) = Vector (fn x) (fn y) - -{-| - Applicative instance for @'Vector'@. --} -instance Applicative Vector where - pure a = Vector a a - (Vector fn _) <*> (Vector x y) = Vector (fn x) (fn y) - -{-| - Multiplying @'Vector'@ by a scalar value. --} -scalar :: Num a => Vector a -> a -> Vector a -scalar (Vector x y) n = Vector (x * n) (y * n)
− src/FRP/Spice/Utils/DoList.hs
@@ -1,63 +0,0 @@-{-| - This module provides a list that can be composed and concatenated through - do-notation. - - --} -module FRP.Spice.Utils.DoList where - --------------------- --- Global Imports -- -import Control.Applicative -import Data.Monoid - ----------- --- Code -- - -{-| - The datastructure itself. Almost equivalent to a tuple of length 2 without - and more context. --} -data DoListT a b = DoListT a b - -{-| - A more commonly used synonym for DoListT --} -type DoList a = DoListT a () - -{-| - Getting the elements from a @'DoListT'@. --} -values :: DoListT a b -> a -values (DoListT a _) = a - -{-| - Constructing a do-list from a @'Monoid'@. --} -fromValues :: Monoid a => a -> DoListT a () -fromValues a = DoListT a () - -{-| - A functor instance to satisfy @'Applicative'@'s requirements. --} -instance Functor (DoListT a) where - fmap fn (DoListT a b) = - DoListT a $ fn b - -{-| - An applicative instance to satisfy @'Monad'@'s requirements. --} -instance Monoid a => Applicative (DoListT a) where - pure b = DoListT mempty b - (DoListT _ fn) <*> dl = fmap fn dl - -{-| - A monad instance to perform the actual composition of the list. List is a - loose word seeing as the monad instance simply needs an instance of - @'Monoid'@. --} -instance Monoid a => Monad (DoListT a) where - return = pure - (DoListT a b) >>= fn = - let (DoListT a' b') = fn b in - DoListT (mappend a a') b'