spice-0.5.0.0: src/FRP/Spice/Internal/Graphics.hs
{-|
-}
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