{-# OPTIONS -Wall #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Bindings to @rshapes@
module Raylib.Core.Shapes
  ( -- * High level
    setShapesTexture,
    getShapesTexture,
    getShapesTextureRectangle,
    drawPixel,
    drawPixelV,
    drawLine,
    drawLineV,
    drawLineEx,
    drawLineStrip,
    drawLineBezier,
    drawCircle,
    drawCircleSector,
    drawCircleSectorLines,
    drawCircleGradient,
    drawCircleV,
    drawCircleLines,
    drawCircleLinesV,
    drawEllipse,
    drawEllipseLines,
    drawRing,
    drawRingLines,
    drawRectangle,
    drawRectangleV,
    drawRectangleRec,
    drawRectanglePro,
    drawRectangleGradientV,
    drawRectangleGradientH,
    drawRectangleGradientEx,
    drawRectangleLines,
    drawRectangleLinesEx,
    drawRectangleRounded,
    drawRectangleRoundedLines,
    drawTriangle,
    drawTriangleLines,
    drawTriangleFan,
    drawTriangleStrip,
    drawPoly,
    drawPolyLines,
    drawPolyLinesEx,
    drawSplineLinear,
    drawSplineBasis,
    drawSplineCatmullRom,
    drawSplineBezierQuadratic,
    drawSplineBezierCubic,
    drawSplineSegmentLinear,
    drawSplineSegmentBasis,
    drawSplineSegmentCatmullRom,
    drawSplineSegmentBezierQuadratic,
    drawSplineSegmentBezierCubic,
    getSplinePointLinear,
    getSplinePointBasis,
    getSplinePointCatmullRom,
    getSplinePointBezierQuad,
    getSplinePointBezierCubic,
    checkCollisionRecs,
    checkCollisionCircles,
    checkCollisionCircleRec,
    checkCollisionPointRec,
    checkCollisionPointCircle,
    checkCollisionPointTriangle,
    checkCollisionPointPoly,
    checkCollisionLines,
    checkCollisionPointLine,
    getCollisionRec,

    -- * Native
    c'setShapesTexture,
    c'getShapesTexture,
    c'getShapesTextureRectangle,
    c'drawPixel,
    c'drawPixelV,
    c'drawLine,
    c'drawLineV,
    c'drawLineEx,
    c'drawLineStrip,
    c'drawLineBezier,
    c'drawCircle,
    c'drawCircleSector,
    c'drawCircleSectorLines,
    c'drawCircleGradient,
    c'drawCircleV,
    c'drawCircleLines,
    c'drawCircleLinesV,
    c'drawEllipse,
    c'drawEllipseLines,
    c'drawRing,
    c'drawRingLines,
    c'drawRectangle,
    c'drawRectangleV,
    c'drawRectangleRec,
    c'drawRectanglePro,
    c'drawRectangleGradientV,
    c'drawRectangleGradientH,
    c'drawRectangleGradientEx,
    c'drawRectangleLines,
    c'drawRectangleLinesEx,
    c'drawRectangleRounded,
    c'drawRectangleRoundedLines,
    c'drawTriangle,
    c'drawTriangleLines,
    c'drawTriangleFan,
    c'drawTriangleStrip,
    c'drawPoly,
    c'drawPolyLines,
    c'drawPolyLinesEx,
    c'drawSplineLinear,
    c'drawSplineBasis,
    c'drawSplineCatmullRom,
    c'drawSplineBezierQuadratic,
    c'drawSplineBezierCubic,
    c'drawSplineSegmentLinear,
    c'drawSplineSegmentBasis,
    c'drawSplineSegmentCatmullRom,
    c'drawSplineSegmentBezierQuadratic,
    c'drawSplineSegmentBezierCubic,
    c'getSplinePointLinear,
    c'getSplinePointBasis,
    c'getSplinePointCatmullRom,
    c'getSplinePointBezierQuad,
    c'getSplinePointBezierCubic,
    c'checkCollisionRecs,
    c'checkCollisionCircles,
    c'checkCollisionCircleRec,
    c'checkCollisionPointRec,
    c'checkCollisionPointCircle,
    c'checkCollisionPointTriangle,
    c'checkCollisionPointPoly,
    c'checkCollisionLines,
    c'checkCollisionPointLine,
    c'getCollisionRec
  )
where

import Data.List (genericLength)
import Foreign (Ptr, Storable (peek), toBool)
import Foreign.C
  ( CBool (..),
    CFloat (..),
    CInt (..),
  )
import GHC.IO (unsafePerformIO)
import Raylib.Internal.Foreign (pop, withFreeable, withFreeableArray, withFreeableArrayLen)
import Raylib.Internal.TH (genNative)
import Raylib.Types (Color, Rectangle, Texture, Vector2 (Vector2))

$( genNative
     [ ("c'setShapesTexture", "SetShapesTexture_", "rl_bindings.h", [t|Ptr Texture -> Ptr Rectangle -> IO ()|], False),
       ("c'getShapesTexture", "GetShapesTexture_", "rl_bindings.h", [t|IO (Ptr Texture)|], False),
       ("c'getShapesTextureRectangle", "GetShapesTextureRectangle_", "rl_bindings.h", [t|IO (Ptr Rectangle)|], False),
       ("c'drawPixel", "DrawPixel_", "rl_bindings.h", [t|CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawPixelV", "DrawPixelV_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawLine", "DrawLine_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawLineV", "DrawLineV_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawLineEx", "DrawLineEx_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawLineStrip", "DrawLineStrip_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawLineBezier", "DrawLineBezier_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawCircle", "DrawCircle_", "rl_bindings.h", [t|CInt -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawCircleSector", "DrawCircleSector_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCircleSectorLines", "DrawCircleSectorLines_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCircleGradient", "DrawCircleGradient_", "rl_bindings.h", [t|CInt -> CInt -> CFloat -> Ptr Color -> Ptr Color -> IO ()|], False),
       ("c'drawCircleV", "DrawCircleV_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawCircleLines", "DrawCircleLines_", "rl_bindings.h", [t|CInt -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawCircleLinesV", "DrawCircleLinesV_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawEllipse", "DrawEllipse_", "rl_bindings.h", [t|CInt -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawEllipseLines", "DrawEllipseLines_", "rl_bindings.h", [t|CInt -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawRing", "DrawRing_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawRingLines", "DrawRingLines_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawRectangle", "DrawRectangle_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleV", "DrawRectangleV_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleRec", "DrawRectangleRec_", "rl_bindings.h", [t|Ptr Rectangle -> Ptr Color -> IO ()|], False),
       ("c'drawRectanglePro", "DrawRectanglePro_", "rl_bindings.h", [t|Ptr Rectangle -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleGradientV", "DrawRectangleGradientV_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleGradientH", "DrawRectangleGradientH_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleGradientEx", "DrawRectangleGradientEx_", "rl_bindings.h", [t|Ptr Rectangle -> Ptr Color -> Ptr Color -> Ptr Color -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleLines", "DrawRectangleLines_", "rl_bindings.h", [t|CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleLinesEx", "DrawRectangleLinesEx_", "rl_bindings.h", [t|Ptr Rectangle -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleRounded", "DrawRectangleRounded_", "rl_bindings.h", [t|Ptr Rectangle -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawRectangleRoundedLines", "DrawRectangleRoundedLines_", "rl_bindings.h", [t|Ptr Rectangle -> CFloat -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawTriangle", "DrawTriangle_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawTriangleLines", "DrawTriangleLines_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawTriangleFan", "DrawTriangleFan_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawTriangleStrip", "DrawTriangleStrip_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawPoly", "DrawPoly_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawPolyLines", "DrawPolyLines_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawPolyLinesEx", "DrawPolyLinesEx_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineLinear", "DrawSplineLinear_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineBasis", "DrawSplineBasis_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineCatmullRom", "DrawSplineCatmullRom_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineBezierQuadratic", "DrawSplineBezierQuadratic_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineBezierCubic", "DrawSplineBezierCubic_", "rl_bindings.h", [t|Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineSegmentLinear", "DrawSplineSegmentLinear_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineSegmentBasis", "DrawSplineSegmentBasis_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineSegmentCatmullRom", "DrawSplineSegmentCatmullRom_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineSegmentBezierQuadratic", "DrawSplineSegmentBezierQuadratic_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSplineSegmentBezierCubic", "DrawSplineSegmentBezierCubic_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'getSplinePointLinear", "GetSplinePointLinear_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)|], False),
       ("c'getSplinePointBasis", "GetSplinePointBasis_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)|], False),
       ("c'getSplinePointCatmullRom", "GetSplinePointCatmullRom_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)|], False),
       ("c'getSplinePointBezierQuad", "GetSplinePointBezierQuad_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)|], False),
       ("c'getSplinePointBezierCubic", "GetSplinePointBezierCubic_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)|], False),
       ("c'checkCollisionRecs", "CheckCollisionRecs_", "rl_bindings.h", [t|Ptr Rectangle -> Ptr Rectangle -> IO CBool|], False),
       ("c'checkCollisionCircles", "CheckCollisionCircles_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> Ptr Vector2 -> CFloat -> IO CBool|], False),
       ("c'checkCollisionCircleRec", "CheckCollisionCircleRec_", "rl_bindings.h", [t|Ptr Vector2 -> CFloat -> Ptr Rectangle -> IO CBool|], False),
       ("c'checkCollisionPointRec", "CheckCollisionPointRec_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Rectangle -> IO CBool|], False),
       ("c'checkCollisionPointCircle", "CheckCollisionPointCircle_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO CBool|], False),
       ("c'checkCollisionPointTriangle", "CheckCollisionPointTriangle_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> IO CBool|], False),
       ("c'checkCollisionPointPoly", "CheckCollisionPointPoly_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> CInt -> IO CBool|], False),
       ("c'checkCollisionLines", "CheckCollisionLines_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> IO CBool|], False),
       ("c'checkCollisionPointLine", "CheckCollisionPointLine_", "rl_bindings.h", [t|Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CInt -> IO CBool|], False),
       ("c'getCollisionRec", "GetCollisionRec_", "rl_bindings.h", [t|Ptr Rectangle -> Ptr Rectangle -> IO (Ptr Rectangle)|], False)
     ]
 )

setShapesTexture :: Texture -> Rectangle -> IO ()
setShapesTexture :: Texture -> Rectangle -> IO ()
setShapesTexture Texture
tex Rectangle
source = Texture -> (Ptr Texture -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
tex (Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source ((Ptr Rectangle -> IO ()) -> IO ())
-> (Ptr Texture -> Ptr Rectangle -> IO ()) -> Ptr Texture -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Texture -> Ptr Rectangle -> IO ()
c'setShapesTexture)

getShapesTexture :: IO Texture
getShapesTexture :: IO Texture
getShapesTexture = IO (Ptr Texture)
c'getShapesTexture IO (Ptr Texture) -> (Ptr Texture -> IO Texture) -> IO Texture
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Texture -> IO Texture
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getShapesTextureRectangle :: IO Rectangle
getShapesTextureRectangle :: IO Rectangle
getShapesTextureRectangle = IO (Ptr Rectangle)
c'getShapesTextureRectangle IO (Ptr Rectangle)
-> (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Rectangle -> IO Rectangle
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

drawPixel :: Int -> Int -> Color -> IO ()
drawPixel :: Int -> Int -> Color -> IO ()
drawPixel Int
x Int
y Color
color = Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> Ptr Color -> IO ()
c'drawPixel (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

drawPixelV :: Vector2 -> Color -> IO ()
drawPixelV :: Vector2 -> Color -> IO ()
drawPixelV Vector2
position Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Color -> IO ()
c'drawPixelV)

drawLine :: Int -> Int -> Int -> Int -> Color -> IO ()
drawLine :: Int -> Int -> Int -> Int -> Color -> IO ()
drawLine Int
startX Int
startY Int
endX Int
endY Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawLine (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endY)

drawLineV :: Vector2 -> Vector2 -> Color -> IO ()
drawLineV :: Vector2 -> Vector2 -> Color -> IO ()
drawLineV Vector2
start Vector2
end Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawLineV Ptr Vector2
s))

drawLineEx :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineEx :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineEx Vector2
start Vector2
end Float
thickness Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (\Ptr Vector2
e -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawLineEx Ptr Vector2
s Ptr Vector2
e (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))))

drawLineStrip :: [Vector2] -> Color -> IO ()
drawLineStrip :: [Vector2] -> Color -> IO ()
drawLineStrip [Vector2]
points Color
color = [Vector2] -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector2]
points (\Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawLineStrip Ptr Vector2
p ([Vector2] -> CInt
forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

drawLineBezier :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezier :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezier Vector2
start Vector2
end Float
thickness Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (\Ptr Vector2
e -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawLineBezier Ptr Vector2
s Ptr Vector2
e (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))))

drawCircle :: Int -> Int -> Float -> Color -> IO ()
drawCircle :: Int -> Int -> Float -> Color -> IO ()
drawCircle Int
centerX Int
centerY Float
radius Color
color = Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawCircle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

drawCircleSector :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCircleSector :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCircleSector Vector2
center Float
radius Float
startAngle Float
endAngle Int
segments Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Color
color
          ( Ptr Vector2
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCircleSector Ptr Vector2
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

drawCircleSectorLines :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCircleSectorLines :: Vector2 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCircleSectorLines Vector2
center Float
radius Float
startAngle Float
endAngle Int
segments Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Color
color
          ( Ptr Vector2
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCircleSectorLines Ptr Vector2
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

drawCircleGradient :: Int -> Int -> Float -> Color -> Color -> IO ()
drawCircleGradient :: Int -> Int -> Float -> Color -> Color -> IO ()
drawCircleGradient Int
centerX Int
centerY Float
radius Color
color1 Color
color2 =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color1 (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color2 ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Color -> Ptr Color -> IO ()) -> Ptr Color -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CFloat -> Ptr Color -> Ptr Color -> IO ()
c'drawCircleGradient (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

drawCircleV :: Vector2 -> Float -> Color -> IO ()
drawCircleV :: Vector2 -> Float -> Color -> IO ()
drawCircleV Vector2
center Float
radius Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawCircleV Ptr Vector2
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

drawCircleLines :: Int -> Int -> Float -> Color -> IO ()
drawCircleLines :: Int -> Int -> Float -> Color -> IO ()
drawCircleLines Int
centerX Int
centerY Float
radius Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawCircleLines (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

drawCircleLinesV :: Vector2 -> Float -> Color -> IO ()
drawCircleLinesV :: Vector2 -> Float -> Color -> IO ()
drawCircleLinesV Vector2
center Float
radius Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawCircleLinesV Ptr Vector2
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

drawEllipse :: Int -> Int -> Float -> Float -> Color -> IO ()
drawEllipse :: Int -> Int -> Float -> Float -> Color -> IO ()
drawEllipse Int
centerX Int
centerY Float
radiusH Float
radiusV Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawEllipse (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusH) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusV))

drawEllipseLines :: Int -> Int -> Float -> Float -> Color -> IO ()
drawEllipseLines :: Int -> Int -> Float -> Float -> Color -> IO ()
drawEllipseLines Int
centerX Int
centerY Float
radiusH Float
radiusV Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawEllipseLines (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusH) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusV))

drawRing :: Vector2 -> Float -> Float -> Float -> Float -> Int -> Color -> IO ()
drawRing :: Vector2
-> Float -> Float -> Float -> Float -> Int -> Color -> IO ()
drawRing Vector2
center Float
innerRadius Float
outerRadius Float
startAngle Float
endAngle Int
segments Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Color
color
          ( Ptr Vector2
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CInt
-> Ptr Color
-> IO ()
c'drawRing
              Ptr Vector2
c
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
innerRadius)
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
outerRadius)
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle)
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle)
              (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

drawRingLines :: Vector2 -> Float -> Float -> Float -> Float -> Int -> Color -> IO ()
drawRingLines :: Vector2
-> Float -> Float -> Float -> Float -> Int -> Color -> IO ()
drawRingLines Vector2
center Float
innerRadius Float
outerRadius Float
startAngle Float
endAngle Int
segments Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Color
color
          ( Ptr Vector2
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CInt
-> Ptr Color
-> IO ()
c'drawRingLines
              Ptr Vector2
c
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
innerRadius)
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
outerRadius)
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle)
              (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle)
              (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments)
          )
    )

drawRectangle :: Int -> Int -> Int -> Int -> Color -> IO ()
drawRectangle :: Int -> Int -> Int -> Int -> Color -> IO ()
drawRectangle Int
posX Int
posY Int
width Int
height Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawRectangle (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height))

drawRectangleV :: Vector2 -> Vector2 -> Color -> IO ()
drawRectangleV :: Vector2 -> Vector2 -> Color -> IO ()
drawRectangleV Vector2
position Vector2
size Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawRectangleV Ptr Vector2
p))

drawRectangleRec :: Rectangle -> Color -> IO ()
drawRectangleRec :: Rectangle -> Color -> IO ()
drawRectangleRec Rectangle
rect Color
color = Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Rectangle -> Ptr Color -> IO ()) -> Ptr Rectangle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Color -> IO ()
c'drawRectangleRec)

drawRectanglePro :: Rectangle -> Vector2 -> Float -> Color -> IO ()
drawRectanglePro :: Rectangle -> Vector2 -> Float -> Color -> IO ()
drawRectanglePro Rectangle
rect Vector2
origin Float
rotation Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
origin (\Ptr Vector2
o -> Ptr Rectangle -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawRectanglePro Ptr Rectangle
r Ptr Vector2
o (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation) Ptr Color
c)))

drawRectangleGradientV :: Int -> Int -> Int -> Int -> Color -> Color -> IO ()
drawRectangleGradientV :: Int -> Int -> Int -> Int -> Color -> Color -> IO ()
drawRectangleGradientV Int
posX Int
posY Int
width Int
height Color
color1 Color
color2 =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Color
color1
    ( Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color2
        ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Color -> Ptr Color -> IO ()) -> Ptr Color -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientV
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX)
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY)
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
    )

drawRectangleGradientH :: Int -> Int -> Int -> Int -> Color -> Color -> IO ()
drawRectangleGradientH :: Int -> Int -> Int -> Int -> Color -> Color -> IO ()
drawRectangleGradientH Int
posX Int
posY Int
width Int
height Color
color1 Color
color2 =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Color
color1
    ( Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color2
        ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Color -> Ptr Color -> IO ()) -> Ptr Color -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientH
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX)
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY)
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
          (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
    )

drawRectangleGradientEx :: Rectangle -> Color -> Color -> Color -> Color -> IO ()
drawRectangleGradientEx :: Rectangle -> Color -> Color -> Color -> Color -> IO ()
drawRectangleGradientEx Rectangle
rect Color
col1 Color
col2 Color
col3 Color
col4 =
  Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
rect
    ( \Ptr Rectangle
r ->
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Color
col1
          ( \Ptr Color
c1 ->
              Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                Color
col2
                ( \Ptr Color
c2 ->
                    Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
col3 (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
col4 ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Color -> Ptr Color -> IO ()) -> Ptr Color -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle
-> Ptr Color -> Ptr Color -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientEx Ptr Rectangle
r Ptr Color
c1 Ptr Color
c2)
                )
          )
    )

drawRectangleLines :: Int -> Int -> Int -> Int -> Color -> IO ()
drawRectangleLines :: Int -> Int -> Int -> Int -> Color -> IO ()
drawRectangleLines Int
posX Int
posY Int
width Int
height Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawRectangleLines (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height))

drawRectangleLinesEx :: Rectangle -> Float -> Color -> IO ()
drawRectangleLinesEx :: Rectangle -> Float -> Color -> IO ()
drawRectangleLinesEx Rectangle
rect Float
thickness Color
color =
  Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> Ptr Rectangle -> CFloat -> Ptr Color -> IO ()
c'drawRectangleLinesEx Ptr Rectangle
r (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness) Ptr Color
c))

drawRectangleRounded :: Rectangle -> Float -> Int -> Color -> IO ()
drawRectangleRounded :: Rectangle -> Float -> Int -> Color -> IO ()
drawRectangleRounded Rectangle
rect Float
roundness Int
segments Color
color =
  Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawRectangleRounded Ptr Rectangle
r (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
roundness) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments))

drawRectangleRoundedLines :: Rectangle -> Float -> Int -> Float -> Color -> IO ()
drawRectangleRoundedLines :: Rectangle -> Float -> Int -> Float -> Color -> IO ()
drawRectangleRoundedLines Rectangle
rect Float
roundness Int
segments Float
thickness Color
color =
  Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> CFloat -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawRectangleRoundedLines Ptr Rectangle
r (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
roundness) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))

drawTriangle :: Vector2 -> Vector2 -> Vector2 -> Color -> IO ()
drawTriangle :: Vector2 -> Vector2 -> Vector2 -> Color -> IO ()
drawTriangle Vector2
v1 Vector2
v2 Vector2
v3 Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
v1
    ( \Ptr Vector2
p1 ->
        Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Vector2
v2
          ( \Ptr Vector2
p2 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
v3 (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawTriangle Ptr Vector2
p1 Ptr Vector2
p2)
          )
    )

drawTriangleLines :: Vector2 -> Vector2 -> Vector2 -> Color -> IO ()
drawTriangleLines :: Vector2 -> Vector2 -> Vector2 -> Color -> IO ()
drawTriangleLines Vector2
v1 Vector2
v2 Vector2
v3 Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
v1
    ( \Ptr Vector2
p1 ->
        Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Vector2
v2
          ( \Ptr Vector2
p2 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
v3 (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawTriangleLines Ptr Vector2
p1 Ptr Vector2
p2)
          )
    )

drawTriangleFan :: [Vector2] -> Color -> IO ()
drawTriangleFan :: [Vector2] -> Color -> IO ()
drawTriangleFan [Vector2]
points Color
color = [Vector2] -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector2]
points (\Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawTriangleFan Ptr Vector2
p ([Vector2] -> CInt
forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

drawTriangleStrip :: [Vector2] -> Color -> IO ()
drawTriangleStrip :: [Vector2] -> Color -> IO ()
drawTriangleStrip [Vector2]
points Color
color =
  [Vector2] -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector2]
points (\Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawTriangleStrip Ptr Vector2
p ([Vector2] -> CInt
forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

drawPoly :: Vector2 -> Int -> Float -> Float -> Color -> IO ()
drawPoly :: Vector2 -> Int -> Float -> Float -> Color -> IO ()
drawPoly Vector2
center Int
sides Float
radius Float
rotation Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPoly Ptr Vector2
c (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation))

drawPolyLines :: Vector2 -> Int -> Float -> Float -> Color -> IO ()
drawPolyLines :: Vector2 -> Int -> Float -> Float -> Color -> IO ()
drawPolyLines Vector2
center Int
sides Float
radius Float
rotation Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPolyLines Ptr Vector2
c (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation))

drawPolyLinesEx :: Vector2 -> Int -> Float -> Float -> Float -> Color -> IO ()
drawPolyLinesEx :: Vector2 -> Int -> Float -> Float -> Float -> Color -> IO ()
drawPolyLinesEx Vector2
center Int
sides Float
radius Float
rotation Float
thickness Color
color =
  Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          Ptr Vector2
-> CInt -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPolyLinesEx
            Ptr Vector2
c
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides)
            (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)
            (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation)
            (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness)
    )

drawSplineLinear :: [Vector2] -> Float -> Color -> IO ()
drawSplineLinear :: [Vector2] -> Float -> Color -> IO ()
drawSplineLinear [Vector2]
points Float
thick Color
color = [Vector2] -> (Int -> Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Vector2]
points (\Int
l Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawSplineLinear Ptr Vector2
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick)))

drawSplineBasis :: [Vector2] -> Float -> Color -> IO ()
drawSplineBasis :: [Vector2] -> Float -> Color -> IO ()
drawSplineBasis [Vector2]
points Float
thick Color
color = [Vector2] -> (Int -> Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Vector2]
points (\Int
l Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawSplineBasis Ptr Vector2
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick)))

drawSplineCatmullRom :: [Vector2] -> Float -> Color -> IO ()
drawSplineCatmullRom :: [Vector2] -> Float -> Color -> IO ()
drawSplineCatmullRom [Vector2]
points Float
thick Color
color = [Vector2] -> (Int -> Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Vector2]
points (\Int
l Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawSplineCatmullRom Ptr Vector2
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick)))

drawSplineBezierQuadratic :: [Vector2] -> Float -> Color -> IO ()
drawSplineBezierQuadratic :: [Vector2] -> Float -> Color -> IO ()
drawSplineBezierQuadratic [Vector2]
points Float
thick Color
color = [Vector2] -> (Int -> Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Vector2]
points (\Int
l Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawSplineBezierQuadratic Ptr Vector2
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick)))

drawSplineBezierCubic :: [Vector2] -> Float -> Color -> IO ()
drawSplineBezierCubic :: [Vector2] -> Float -> Color -> IO ()
drawSplineBezierCubic [Vector2]
points Float
thick Color
color = [Vector2] -> (Int -> Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Vector2]
points (\Int
l Ptr Vector2
p -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawSplineBezierCubic Ptr Vector2
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick)))

drawSplineSegmentLinear :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentLinear :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentLinear Vector2
p1 Vector2
p2 Float
thick Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawSplineSegmentLinear Ptr Vector2
q1 Ptr Vector2
q2 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick))))

drawSplineSegmentBasis :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentBasis :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentBasis Vector2
p1 Vector2
p2 Vector2
p3 Vector2
p4 Float
thick Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p4 (\Ptr Vector2
q4 -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawSplineSegmentBasis Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 Ptr Vector2
q4 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick))))))

drawSplineSegmentCatmullRom :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentCatmullRom :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentCatmullRom Vector2
p1 Vector2
p2 Vector2
p3 Vector2
p4 Float
thick Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p4 (\Ptr Vector2
q4 -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawSplineSegmentCatmullRom Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 Ptr Vector2
q4 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick))))))

drawSplineSegmentBezierQuadratic :: Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentBezierQuadratic :: Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentBezierQuadratic Vector2
p1 Vector2
p2 Vector2
p3 Float
thick Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2
-> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawSplineSegmentBezierQuadratic Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick)))))

drawSplineSegmentBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawSplineSegmentBezierCubic Vector2
p1 Vector2
p2 Vector2
p3 Vector2
p4 Float
thick Color
color = Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p4 (\Ptr Vector2
q4 -> Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawSplineSegmentBezierCubic Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 Ptr Vector2
q4 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thick))))))

getSplinePointLinear :: Vector2 -> Vector2 -> Float -> Vector2
getSplinePointLinear :: Vector2 -> Vector2 -> Float -> Vector2
getSplinePointLinear Vector2
p1 Vector2
p2 Float
t = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)
c'getSplinePointLinear Ptr Vector2
q1 Ptr Vector2
q2 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
t))) IO (Ptr Vector2) -> (Ptr Vector2 -> IO Vector2) -> IO Vector2
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Vector2 -> IO Vector2
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getSplinePointBasis :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointBasis :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointBasis Vector2
p1 Vector2
p2 Vector2
p3 Vector2
p4 Float
t = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p4 (\Ptr Vector2
q4 -> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> IO (Ptr Vector2)
c'getSplinePointBasis Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 Ptr Vector2
q4 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
t))))) IO (Ptr Vector2) -> (Ptr Vector2 -> IO Vector2) -> IO Vector2
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Vector2 -> IO Vector2
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getSplinePointCatmullRom :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointCatmullRom :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointCatmullRom Vector2
p1 Vector2
p2 Vector2
p3 Vector2
p4 Float
t = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p4 (\Ptr Vector2
q4 -> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> IO (Ptr Vector2)
c'getSplinePointCatmullRom Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 Ptr Vector2
q4 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
t))))) IO (Ptr Vector2) -> (Ptr Vector2 -> IO Vector2) -> IO Vector2
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Vector2 -> IO Vector2
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getSplinePointBezierQuad :: Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointBezierQuad :: Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointBezierQuad Vector2
p1 Vector2
p2 Vector2
p3 Float
t = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Ptr Vector2
-> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO (Ptr Vector2)
c'getSplinePointBezierQuad Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
t)))) IO (Ptr Vector2) -> (Ptr Vector2 -> IO Vector2) -> IO Vector2
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Vector2 -> IO Vector2
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getSplinePointBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Vector2
getSplinePointBezierCubic Vector2
p1 Vector2
p2 Vector2
p3 Vector2
p4 Float
t = IO Vector2 -> Vector2
forall a. IO a -> a
unsafePerformIO (IO Vector2 -> Vector2) -> IO Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
q1 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
q2 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 (\Ptr Vector2
q3 -> Vector2 -> (Ptr Vector2 -> IO (Ptr Vector2)) -> IO (Ptr Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p4 (\Ptr Vector2
q4 -> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> IO (Ptr Vector2)
c'getSplinePointBezierCubic Ptr Vector2
q1 Ptr Vector2
q2 Ptr Vector2
q3 Ptr Vector2
q4 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
t))))) IO (Ptr Vector2) -> (Ptr Vector2 -> IO Vector2) -> IO Vector2
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Vector2 -> IO Vector2
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

checkCollisionRecs :: Rectangle -> Rectangle -> Bool
checkCollisionRecs :: Rectangle -> Rectangle -> Bool
checkCollisionRecs Rectangle
rec1 Rectangle
rec2 = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec1 (Rectangle -> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec2 ((Ptr Rectangle -> IO CBool) -> IO CBool)
-> (Ptr Rectangle -> Ptr Rectangle -> IO CBool)
-> Ptr Rectangle
-> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Rectangle -> IO CBool
c'checkCollisionRecs)

checkCollisionCircles :: Vector2 -> Float -> Vector2 -> Float -> Bool
checkCollisionCircles :: Vector2 -> Float -> Vector2 -> Float -> Bool
checkCollisionCircles Vector2
center1 Float
radius1 Vector2
center2 Float
radius2 =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center1 (\Ptr Vector2
c1 -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center2 (\Ptr Vector2
c2 -> Ptr Vector2 -> CFloat -> Ptr Vector2 -> CFloat -> IO CBool
c'checkCollisionCircles Ptr Vector2
c1 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius1) Ptr Vector2
c2 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius2)))

checkCollisionCircleRec :: Vector2 -> Float -> Rectangle -> Bool
checkCollisionCircleRec :: Vector2 -> Float -> Rectangle -> Bool
checkCollisionCircleRec Vector2
center Float
radius Rectangle
rect =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> Rectangle -> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect ((Ptr Rectangle -> IO CBool) -> IO CBool)
-> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CFloat -> Ptr Rectangle -> IO CBool
c'checkCollisionCircleRec Ptr Vector2
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))

checkCollisionPointRec :: Vector2 -> Rectangle -> Bool
checkCollisionPointRec :: Vector2 -> Rectangle -> Bool
checkCollisionPointRec Vector2
point Rectangle
rect =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (Rectangle -> (Ptr Rectangle -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect ((Ptr Rectangle -> IO CBool) -> IO CBool)
-> (Ptr Vector2 -> Ptr Rectangle -> IO CBool)
-> Ptr Vector2
-> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2 -> Ptr Rectangle -> IO CBool
c'checkCollisionPointRec)

checkCollisionPointCircle :: Vector2 -> Vector2 -> Float -> Bool
checkCollisionPointCircle :: Vector2 -> Vector2 -> Float -> Bool
checkCollisionPointCircle Vector2
point Vector2
center Float
radius =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> IO CBool
c'checkCollisionPointCircle Ptr Vector2
p Ptr Vector2
c (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

checkCollisionPointTriangle :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Bool
checkCollisionPointTriangle :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Bool
checkCollisionPointTriangle Vector2
point Vector2
p1 Vector2
p2 Vector2
p3 =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
ptr1 -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 ((Ptr Vector2 -> IO CBool) -> IO CBool)
-> (Ptr Vector2 -> Ptr Vector2 -> IO CBool)
-> Ptr Vector2
-> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector2
-> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> IO CBool
c'checkCollisionPointTriangle Ptr Vector2
p Ptr Vector2
ptr1)))

checkCollisionPointPoly :: Vector2 -> [Vector2] -> Bool
checkCollisionPointPoly :: Vector2 -> [Vector2] -> Bool
checkCollisionPointPoly Vector2
point [Vector2]
points =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vector2] -> (Int -> Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Vector2]
points (\Int
l Ptr Vector2
ps -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> Ptr Vector2 -> Ptr Vector2 -> CInt -> IO CBool
c'checkCollisionPointPoly Ptr Vector2
p Ptr Vector2
ps (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)))

-- | If a collision is found, returns @Just collisionPoint@, otherwise returns @Nothing@
checkCollisionLines :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Maybe Vector2
checkCollisionLines :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Maybe Vector2
checkCollisionLines Vector2
start1 Vector2
end1 Vector2
start2 Vector2
end2 =
  IO (Maybe Vector2) -> Maybe Vector2
forall a. IO a -> a
unsafePerformIO (IO (Maybe Vector2) -> Maybe Vector2)
-> IO (Maybe Vector2) -> Maybe Vector2
forall a b. (a -> b) -> a -> b
$
    Vector2
-> (Ptr Vector2 -> IO (Maybe Vector2)) -> IO (Maybe Vector2)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
      (Float -> Float -> Vector2
Vector2 Float
0 Float
0)
      ( \Ptr Vector2
res -> do
          Bool
foundCollision <- CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start1 (\Ptr Vector2
s1 -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end1 (\Ptr Vector2
e1 -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start2 (\Ptr Vector2
s2 -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end2 (\Ptr Vector2
e2 -> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> Ptr Vector2
-> IO CBool
c'checkCollisionLines Ptr Vector2
s1 Ptr Vector2
e1 Ptr Vector2
s2 Ptr Vector2
e2 Ptr Vector2
res))))
          if Bool
foundCollision then Vector2 -> Maybe Vector2
forall a. a -> Maybe a
Just (Vector2 -> Maybe Vector2) -> IO Vector2 -> IO (Maybe Vector2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vector2 -> IO Vector2
forall a. Storable a => Ptr a -> IO a
peek Ptr Vector2
res else Maybe Vector2 -> IO (Maybe Vector2)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Vector2
forall a. Maybe a
Nothing
      )

checkCollisionPointLine :: Vector2 -> Vector2 -> Vector2 -> Int -> Bool
checkCollisionPointLine :: Vector2 -> Vector2 -> Vector2 -> Int -> Bool
checkCollisionPointLine Vector2
point Vector2
p1 Vector2
p2 Int
threshold =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
ptr1 -> Vector2 -> (Ptr Vector2 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (\Ptr Vector2
ptr2 -> Ptr Vector2 -> Ptr Vector2 -> Ptr Vector2 -> CInt -> IO CBool
c'checkCollisionPointLine Ptr Vector2
p Ptr Vector2
ptr1 Ptr Vector2
ptr2 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
threshold))))

getCollisionRec :: Rectangle -> Rectangle -> Rectangle
getCollisionRec :: Rectangle -> Rectangle -> Rectangle
getCollisionRec Rectangle
rec1 Rectangle
rec2 =
  IO Rectangle -> Rectangle
forall a. IO a -> a
unsafePerformIO (IO Rectangle -> Rectangle) -> IO Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ Rectangle
-> (Ptr Rectangle -> IO (Ptr Rectangle)) -> IO (Ptr Rectangle)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec1 (Rectangle
-> (Ptr Rectangle -> IO (Ptr Rectangle)) -> IO (Ptr Rectangle)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec2 ((Ptr Rectangle -> IO (Ptr Rectangle)) -> IO (Ptr Rectangle))
-> (Ptr Rectangle -> Ptr Rectangle -> IO (Ptr Rectangle))
-> Ptr Rectangle
-> IO (Ptr Rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Rectangle -> IO (Ptr Rectangle)
c'getCollisionRec) IO (Ptr Rectangle)
-> (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Rectangle -> IO Rectangle
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop