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
import Graphics.Rendering.OpenGL hiding (Color)
import Control.Monad
import FRP.Spice.Internal.Types
toGL :: Float -> GLfloat
toGL = realToFrac
bindColor :: Color -> Scene
bindColor (Color r g b a) = color $ Color4 (toGL r) (toGL g) (toGL b) (toGL a)
color4f :: Float -> Float -> Float -> Float -> Color
color4f = Color
color3f :: Float -> Float -> Float -> Color
color3f r g b = color4f r g b 1.0
color4i :: Int -> Int -> Int -> Int -> Color
color4i r g b a =
color4f (fromIntegral r / 255)
(fromIntegral g / 255)
(fromIntegral b / 255)
(fromIntegral a / 255)
color3i :: Int -> Int -> Int -> Color
color3i r g b = color4i r g b 255
black :: Color
black = color3i 0 0 0
white :: Color
white = color3i 255 255 255
grey :: Color
grey = color3i 255 255 255
gray :: Color
gray = grey
red :: Color
red = color3i 255 0 0
green :: Color
green = color3i 0 255 0
blue :: Color
blue = color3i 0 0 255
renderPrimitive' :: PrimitiveMode -> [Vector Float] -> Scene
renderPrimitive' pm l =
renderPrimitive pm $
forM_ l $ \(Vector x y) ->
vertex $ Vertex2 (toGL x) (toGL y)
renderPoint :: Vector Float -> Scene
renderPoint = renderPrimitive' Points . return
renderLine :: Vector Float -> Vector Float -> Scene
renderLine p1 p2 = renderPrimitive' Lines [p1, p2]
renderTriangle :: Vector Float -> Vector Float -> Vector Float -> Scene
renderTriangle p1 p2 p3 = renderPrimitive' Triangles [p1, p2, p3]
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)
]
renderSquare :: Vector Float -> Float -> Scene
renderSquare pos x = renderRectangle pos $ Vector x x
renderPolygon :: [Vector Float] -> Scene
renderPolygon l = renderPrimitive' Polygon l
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)
]
renderSpriteWithSize :: Sprite -> Vector Float -> Vector Float -> Scene
renderSpriteWithSize sprite pos size =
renderSprite (sprite { spriteSize = size }) pos