{-# OPTIONS -Wall #-}

module Raylib.Core.Shapes where

import Data.List (genericLength)
import Foreign (Storable (peek), toBool)
import GHC.IO (unsafePerformIO)
import Raylib.ForeignUtil (pop, withFreeable, withFreeableArray)
import Raylib.Native
  ( c'checkCollisionCircleRec,
    c'checkCollisionCircles,
    c'checkCollisionLines,
    c'checkCollisionPointCircle,
    c'checkCollisionPointLine,
    c'checkCollisionPointRec,
    c'checkCollisionPointTriangle,
    c'checkCollisionRecs,
    c'drawCircle,
    c'drawCircleGradient,
    c'drawCircleLines,
    c'drawCircleSector,
    c'drawCircleSectorLines,
    c'drawCircleV,
    c'drawEllipse,
    c'drawEllipseLines,
    c'drawLine,
    c'drawLineBezier,
    c'drawLineBezierCubic,
    c'drawLineBezierQuad,
    c'drawLineEx,
    c'drawLineStrip,
    c'drawLineV,
    c'drawPixel,
    c'drawPixelV,
    c'drawPoly,
    c'drawPolyLines,
    c'drawPolyLinesEx,
    c'drawRectangle,
    c'drawRectangleGradientEx,
    c'drawRectangleGradientH,
    c'drawRectangleGradientV,
    c'drawRectangleLines,
    c'drawRectangleLinesEx,
    c'drawRectanglePro,
    c'drawRectangleRec,
    c'drawRectangleRounded,
    c'drawRectangleRoundedLines,
    c'drawRectangleV,
    c'drawRing,
    c'drawRingLines,
    c'drawTriangle,
    c'drawTriangleFan,
    c'drawTriangleLines,
    c'drawTriangleStrip,
    c'getCollisionRec,
    c'setShapesTexture,
  )
import Raylib.Types (Color, Rectangle, Texture, Vector2 (Vector2))

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

drawPixel :: Int -> Int -> Color -> IO ()
drawPixel :: Int -> Int -> Color -> IO ()
drawPixel Int
x Int
y Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> Ptr Color -> IO ()
c'drawPixel (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color 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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawLine (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endX) (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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color 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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (\Ptr Vector2
e -> 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))))

drawLineBezier :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezier :: Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezier Vector2
start Vector2
end Float
thickness Color
color =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (\Ptr Vector2
e -> 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness))))

drawLineBezierQuad :: Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezierQuad :: Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezierQuad Vector2
start Vector2
end Vector2
control Float
thickness Color
color =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start (\Ptr Vector2
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end (\Ptr Vector2
e -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
control (\Ptr Vector2
c -> 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'drawLineBezierQuad Ptr Vector2
s Ptr Vector2
e Ptr Vector2
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness)))))

drawLineBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezierCubic :: Vector2 -> Vector2 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawLineBezierCubic Vector2
start Vector2
end Vector2
startControl Vector2
endControl Float
thickness Color
color =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
start
    ( \Ptr Vector2
s ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Vector2
end
          ( \Ptr Vector2
e ->
              forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                Vector2
startControl
                ( \Ptr Vector2
sc ->
                    forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                      Vector2
endControl
                      ( \Ptr Vector2
ec ->
                          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'drawLineBezierCubic Ptr Vector2
s Ptr Vector2
e Ptr Vector2
sc Ptr Vector2
ec (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 = forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector2]
points (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawLineStrip Ptr Vector2
p (forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

drawCircle :: Int -> Int -> Float -> Color -> IO ()
drawCircle :: Int -> Int -> Float -> Color -> IO ()
drawCircle Int
centerX Int
centerY Float
radius Color
color = 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color1 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CFloat -> Ptr Color -> Ptr Color -> IO ()
c'drawCircleGradient (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> 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 (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusH) (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
centerY) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusH) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        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
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
innerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
outerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle)
              (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        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
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
innerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
outerRadius)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startAngle)
              (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endAngle)
              (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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color 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 = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color 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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> 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 (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Color
color1
    ( forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color2
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientV
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX)
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY)
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
          (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Color
color1
    ( forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color2
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr Color -> Ptr Color -> IO ()
c'drawRectangleGradientH
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX)
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY)
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
          (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Rectangle
rect
    ( \Ptr Rectangle
r ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Color
col1
          ( \Ptr Color
c1 ->
              forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
                Color
col2
                ( \Ptr Color
c2 ->
                    forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
col3 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
col4 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 =
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
posY) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (\Ptr Color
c -> 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 (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawRectangleRounded Ptr Rectangle
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
roundness) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect (\Ptr Rectangle
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Rectangle -> CFloat -> CInt -> CFloat -> Ptr Color -> IO ()
c'drawRectangleRoundedLines Ptr Rectangle
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
roundness) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segments) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
v1
    ( \Ptr Vector2
p1 ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Vector2
v2
          ( \Ptr Vector2
p2 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
v3 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color 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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
v1
    ( \Ptr Vector2
p1 ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          Vector2
v2
          ( \Ptr Vector2
p2 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
v3 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color 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 = forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector2]
points (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawTriangleFan Ptr Vector2
p (forall i a. Num i => [a] -> i
genericLength [Vector2]
points))

drawTriangleStrip :: [Vector2] -> Color -> IO ()
drawTriangleStrip :: [Vector2] -> Color -> IO ()
drawTriangleStrip [Vector2]
points Color
color =
  forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector2]
points (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> Ptr Color -> IO ()
c'drawTriangleStrip Ptr Vector2
p (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPoly Ptr Vector2
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CInt -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPolyLines Ptr Vector2
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (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 =
  forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
    Vector2
center
    ( \Ptr Vector2
c ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color forall a b. (a -> b) -> a -> b
$
          Ptr Vector2
-> CInt -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawPolyLinesEx
            Ptr Vector2
c
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides)
            (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)
            (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation)
            (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
thickness)
    )

checkCollisionRecs :: Rectangle -> Rectangle -> Bool
checkCollisionRecs :: Rectangle -> Rectangle -> Bool
checkCollisionRecs Rectangle
rec1 Rectangle
rec2 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec1 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec2 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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center1 (\Ptr Vector2
c1 -> 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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius1) Ptr Vector2
c2 (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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
center (\Ptr Vector2
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect forall a b. (a -> b) -> a -> b
$ Ptr Vector2 -> CFloat -> Ptr Rectangle -> IO CBool
c'checkCollisionCircleRec Ptr Vector2
c (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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rect 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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> 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 (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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
ptr1 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p2 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p3 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)))

-- | 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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    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 <- forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start1 (\Ptr Vector2
s1 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
end1 (\Ptr Vector2
e1 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
start2 (\Ptr Vector2
s2 -> 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 forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Vector2
res else forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
point (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
p1 (\Ptr Vector2
ptr1 -> 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 (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 =
  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec1 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
rec2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Rectangle -> Ptr Rectangle -> IO (Ptr Rectangle)
c'getCollisionRec) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop