{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module SDL.Primitive
(
Pos
, Color
, pixel
, line
, Length
, horizontalLine
, verticalLine
, smoothLine
, Width
, thickLine
, triangle
, smoothTriangle
, fillTriangle
, rectangle
, Radius
, roundRectangle
, fillRectangle
, fillRoundRectangle
, Start
, End
, arc
, circle
, smoothCircle
, fillCircle
, ellipse
, smoothEllipse
, fillEllipse
, pie
, fillPie
, Steps
, bezier
, polygon
, smoothPolygon
, fillPolygon
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Int (Int16)
import Data.Vector.Storable (Vector, unsafeWith, length)
import Data.Word (Word8)
import Foreign.C.Types (CInt)
import Linear (V4(..), V2(..))
import Prelude hiding (length)
import SDL.ExceptionHelper (throwIfNeg_)
import SDL.Internal.Types (Renderer(..))
import qualified SDL.Raw.Primitive
type Pos = V2 CInt
type Color = V4 Word8
cint :: CInt -> Int16
cint = fromIntegral
pixel :: MonadIO m => Renderer -> Pos -> Color -> m ()
pixel (Renderer p) (V2 x y) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.pixel" "pixelRGBA" $
SDL.Raw.Primitive.pixel
p (cint x) (cint y) r g b a
line :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()
line (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.line" "lineRGBA" $
SDL.Raw.Primitive.line
p (cint x) (cint y) (cint u) (cint v) r g b a
type Width = CInt
thickLine :: MonadIO m => Renderer -> Pos -> Pos -> Width -> Color -> m ()
thickLine (Renderer p) (V2 x y) (V2 u v) w (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.thickLine" "thickLineRGBA" $
SDL.Raw.Primitive.thickLine
p (cint x) (cint y) (cint u) (cint v) (cint w) r g b a
smoothLine :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()
smoothLine (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.smoothLine" "aalineRGBA" $
SDL.Raw.Primitive.aaLine
p (cint x) (cint y) (cint u) (cint v) r g b a
type Length = CInt
horizontalLine :: MonadIO m => Renderer -> Pos -> Length -> Color -> m ()
horizontalLine (Renderer p) (V2 x y) w (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.horizontalLine" "hlineRGBA" $
SDL.Raw.Primitive.hline
p (cint x) (cint $ x + w) (cint y) r g b a
verticalLine :: MonadIO m => Renderer -> Pos -> Length -> Color -> m ()
verticalLine (Renderer p) (V2 x y) h (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.verticalLine" "vlineRGBA" $
SDL.Raw.Primitive.vline
p (cint x) (cint y) (cint $ y + h) r g b a
rectangle :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()
rectangle (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.rectangle" "rectangleRGBA" $
SDL.Raw.Primitive.rectangle
p (cint x) (cint y) (cint u) (cint v) r g b a
type Radius = CInt
roundRectangle :: MonadIO m => Renderer -> Pos -> Pos -> Radius -> Color -> m ()
roundRectangle (Renderer p) (V2 x y) (V2 u v) rad (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.roundRectangle" "roundedRectangleRGBA" $
SDL.Raw.Primitive.roundedRectangle
p (cint x) (cint y) (cint u) (cint v) (cint rad) r g b a
fillRectangle :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()
fillRectangle (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.fillRectangle" "boxRGBA" $
SDL.Raw.Primitive.box
p (cint x) (cint y) (cint u) (cint v) r g b a
fillRoundRectangle :: MonadIO m => Renderer -> Pos -> Pos -> Radius -> Color -> m ()
fillRoundRectangle (Renderer p) (V2 x y) (V2 u v) rad (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.fillRoundRectangle" "roundedBoxRGBA" $
SDL.Raw.Primitive.roundedBox
p (cint x) (cint y) (cint u) (cint v) (cint rad) r g b a
type Start = CInt
type End = CInt
arc :: MonadIO m => Renderer -> Pos -> Radius -> Start -> End -> Color -> m ()
arc (Renderer p) (V2 x y) rad start end (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.arc" "arcRGBA" $
SDL.Raw.Primitive.arc
p (cint x) (cint y) (cint rad) (cint start) (cint end) r g b a
circle :: MonadIO m => Renderer -> Pos -> Radius -> Color -> m ()
circle (Renderer p) (V2 x y) rad (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.circle" "circleRGBA" $
SDL.Raw.Primitive.circle
p (cint x) (cint y) (cint rad) r g b a
fillCircle :: MonadIO m => Renderer -> Pos -> Radius -> Color -> m ()
fillCircle (Renderer p) (V2 x y) rad (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.filledCircle" "filledCircleRGBA" $
SDL.Raw.Primitive.filledCircle
p (cint x) (cint y) (cint rad) r g b a
smoothCircle :: MonadIO m => Renderer -> Pos -> Radius -> Color -> m ()
smoothCircle (Renderer p) (V2 x y) rad (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.aaCircle" "aacircleRGBA" $
SDL.Raw.Primitive.aaCircle
p (cint x) (cint y) (cint rad) r g b a
ellipse :: MonadIO m => Renderer -> Pos -> Radius -> Radius -> Color -> m ()
ellipse (Renderer p) (V2 x y) rx ry (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.ellipse" "ellipseRGBA" $
SDL.Raw.Primitive.ellipse
p (cint x) (cint y) (cint rx) (cint ry) r g b a
smoothEllipse :: MonadIO m => Renderer -> Pos -> Radius -> Radius -> Color -> m ()
smoothEllipse (Renderer p) (V2 x y) rx ry (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.smoothEllipse" "aaellipseRGBA" $
SDL.Raw.Primitive.aaEllipse
p (cint x) (cint y) (cint rx) (cint ry) r g b a
fillEllipse :: MonadIO m => Renderer -> Pos -> Radius -> Radius -> Color -> m ()
fillEllipse (Renderer p) (V2 x y) rx ry (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.fillEllipse" "filledEllipseRGBA" $
SDL.Raw.Primitive.filledEllipse
p (cint x) (cint y) (cint rx) (cint ry) r g b a
pie :: MonadIO m => Renderer -> Pos -> Radius -> Start -> End -> Color -> m ()
pie (Renderer p) (V2 x y) rad start end (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.pie" "pieRGBA" $
SDL.Raw.Primitive.pie
p (cint x) (cint y) (cint rad) (cint start) (cint end) r g b a
fillPie :: MonadIO m => Renderer -> Pos -> Radius -> Start -> End -> Color -> m ()
fillPie (Renderer p) (V2 x y) rad start end (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.fillPie" "filledPieRGBA" $
SDL.Raw.Primitive.filledPie
p (cint x) (cint y) (cint rad) (cint start) (cint end) r g b a
type Steps = CInt
bezier :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Steps -> Color -> m ()
bezier (Renderer p) xs ys steps (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.bezier" "bezierRGBA" $
liftIO .
unsafeWith xs $ \xs' ->
unsafeWith ys $ \ys' ->
SDL.Raw.Primitive.bezier
p xs' ys' (fromIntegral $ length xs) steps r g b a
triangle :: MonadIO m => Renderer -> Pos -> Pos -> Pos -> Color -> m ()
triangle (Renderer p) (V2 x y) (V2 u v) (V2 t z) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.triangle" "trigonRGBA" $
SDL.Raw.Primitive.trigon
p (cint x) (cint y) (cint u) (cint v) (cint t) (cint z) r g b a
smoothTriangle :: MonadIO m => Renderer -> Pos -> Pos -> Pos -> Color -> m ()
smoothTriangle (Renderer p) (V2 x y) (V2 u v) (V2 t z) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.smoothTriangle" "aatrigonRGBA" $
SDL.Raw.Primitive.aaTrigon
p (cint x) (cint y) (cint u) (cint v) (cint t) (cint z) r g b a
fillTriangle :: MonadIO m => Renderer -> Pos -> Pos -> Pos -> Color -> m ()
fillTriangle (Renderer p) (V2 x y) (V2 u v) (V2 t z) (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.fillTriangle" "filledTrigonRGBA" $
SDL.Raw.Primitive.filledTrigon
p (cint x) (cint y) (cint u) (cint v) (cint t) (cint z) r g b a
polygon :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Color -> m ()
polygon (Renderer p) xs ys (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.polygon" "polygonRGBA" $
liftIO .
unsafeWith xs $ \xs' ->
unsafeWith ys $ \ys' ->
SDL.Raw.Primitive.polygon
p xs' ys' (fromIntegral $ length xs) r g b a
smoothPolygon :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Color -> m ()
smoothPolygon (Renderer p) xs ys (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.smoothPolygon" "aapolygonRGBA" $
liftIO .
unsafeWith xs $ \xs' ->
unsafeWith ys $ \ys' ->
SDL.Raw.Primitive.aaPolygon
p xs' ys' (fromIntegral $ length xs) r g b a
fillPolygon :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Color -> m ()
fillPolygon (Renderer p) xs ys (V4 r g b a) =
throwIfNeg_ "SDL.Primitive.fillPolygon" "filledPolygonRGBA" $
liftIO .
unsafeWith xs $ \xs' ->
unsafeWith ys $ \ys' ->
SDL.Raw.Primitive.filledPolygon
p xs' ys' (fromIntegral $ length xs) r g b a