{-# OPTIONS -Wall #-}

module Raylib.Core.Models where

import Control.Monad (forM_)
import Foreign
  ( Ptr,
    Storable (peek, poke),
    castPtr,
    fromBool,
    malloc,
    peekArray,
    toBool,
  )
import Foreign.C (CFloat, withCString)
import GHC.IO (unsafePerformIO)
import Raylib.ForeignUtil
  ( c'free,
    pop,
    popCArray,
    withFreeable, withFreeableArray, withFreeableArrayLen
  )
import Raylib.Internal (addShaderId, addTextureId, addVaoId, addVboIds, unloadSingleShader, unloadSingleTexture, unloadSingleVaoId, unloadSingleVboIdList, WindowResources)
import Raylib.Native
  ( c'checkCollisionBoxSphere,
    c'checkCollisionBoxes,
    c'checkCollisionSpheres,
    c'drawBillboard,
    c'drawBillboardPro,
    c'drawBillboardRec,
    c'drawBoundingBox,
    c'drawCapsule,
    c'drawCapsuleWires,
    c'drawCircle3D,
    c'drawCube,
    c'drawCubeV,
    c'drawCubeWires,
    c'drawCubeWiresV,
    c'drawCylinder,
    c'drawCylinderEx,
    c'drawCylinderWires,
    c'drawCylinderWiresEx,
    c'drawGrid,
    c'drawLine3D,
    c'drawMesh,
    c'drawMeshInstanced,
    c'drawModel,
    c'drawModelEx,
    c'drawModelWires,
    c'drawModelWiresEx,
    c'drawPlane,
    c'drawPoint3D,
    c'drawRay,
    c'drawSphere,
    c'drawSphereEx,
    c'drawSphereWires,
    c'drawTriangle3D,
    c'drawTriangleStrip3D,
    c'exportMesh,
    c'genMeshCone,
    c'genMeshCube,
    c'genMeshCubicmap,
    c'genMeshCylinder,
    c'genMeshHeightmap,
    c'genMeshHemiSphere,
    c'genMeshKnot,
    c'genMeshPlane,
    c'genMeshPoly,
    c'genMeshSphere,
    c'genMeshTangents,
    c'genMeshTorus,
    c'getMeshBoundingBox,
    c'getModelBoundingBox,
    c'getRayCollisionBox,
    c'getRayCollisionMesh,
    c'getRayCollisionQuad,
    c'getRayCollisionSphere,
    c'getRayCollisionTriangle,
    c'isMaterialReady,
    c'isModelAnimationValid,
    c'isModelReady,
    c'loadMaterialDefault,
    c'loadMaterials,
    c'loadModel,
    c'loadModelAnimations,
    c'loadModelFromMesh,
    c'setMaterialTexture,
    c'setModelMeshMaterial,
    c'updateMeshBuffer,
    c'updateModelAnimation,
    c'uploadMesh,
  )
import Raylib.Types
  ( BoundingBox,
    Camera3D,
    Color,
    Image,
    Material (material'maps, material'shader),
    MaterialMap (materialMap'texture),
    Matrix,
    Mesh (mesh'vaoId, mesh'vboId),
    Model (model'materials, model'meshes),
    ModelAnimation,
    Ray,
    RayCollision,
    Rectangle,
    Shader (shader'id),
    Texture (texture'id),
    Vector2,
    Vector3,
  )
import Prelude hiding (length)

drawLine3D :: Vector3 -> Vector3 -> Color -> IO ()
drawLine3D :: Vector3 -> Vector3 -> Color -> IO ()
drawLine3D Vector3
start Vector3
end Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
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 Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawLine3D Ptr Vector3
s))

drawPoint3D :: Vector3 -> Color -> IO ()
drawPoint3D :: Vector3 -> Color -> IO ()
drawPoint3D Vector3
point Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
point (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 Vector3 -> Ptr Color -> IO ()
c'drawPoint3D)

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

drawTriangle3D :: Vector3 -> Vector3 -> Vector3 -> Color -> IO ()
drawTriangle3D :: Vector3 -> Vector3 -> Vector3 -> Color -> IO ()
drawTriangle3D Vector3
v1 Vector3
v2 Vector3
v3 Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v1 (\Ptr Vector3
p1 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v2 (\Ptr Vector3
p2 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
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 Vector3 -> Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawTriangle3D Ptr Vector3
p1 Ptr Vector3
p2)))

drawTriangleStrip3D :: [Vector3] -> Int -> Color -> IO ()
drawTriangleStrip3D :: [Vector3] -> Int -> Color -> IO ()
drawTriangleStrip3D [Vector3]
points Int
pointCount Color
color = forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector3]
points (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3 -> CInt -> Ptr Color -> IO ()
c'drawTriangleStrip3D Ptr Vector3
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pointCount)))

drawCube :: Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCube :: Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCube Vector3
position Float
width Float
height Float
length Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawCube Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length)))

drawCubeV :: Vector3 -> Vector3 -> Color -> IO ()
drawCubeV :: Vector3 -> Vector3 -> Color -> IO ()
drawCubeV Vector3
position Vector3
size Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
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 Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawCubeV Ptr Vector3
p))

drawCubeWires :: Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCubeWires :: Vector3 -> Float -> Float -> Float -> Color -> IO ()
drawCubeWires Vector3
position Float
width Float
height Float
length Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawCubeWires Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length)))

drawCubeWiresV :: Vector3 -> Vector3 -> Color -> IO ()
drawCubeWiresV :: Vector3 -> Vector3 -> Color -> IO ()
drawCubeWiresV Vector3
position Vector3
size Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
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 Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()
c'drawCubeWiresV Ptr Vector3
p))

drawSphere :: Vector3 -> Float -> Color -> IO ()
drawSphere :: Vector3 -> Float -> Color -> IO ()
drawSphere Vector3
position Float
radius Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawSphere Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius)))

drawSphereEx :: Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawSphereEx :: Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawSphereEx Vector3
position Float
radius Int
rings Int
slices Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawSphereEx Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

drawSphereWires :: Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawSphereWires :: Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawSphereWires Vector3
position Float
radius Int
rings Int
slices Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawSphereWires Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

drawCylinder :: Vector3 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCylinder :: Vector3 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCylinder Vector3
position Float
radiusTop Float
radiusBottom Float
height Int
slices Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinder Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusTop) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusBottom) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

drawCylinderEx :: Vector3 -> Vector3 -> Float -> Float -> Int -> Color -> IO ()
drawCylinderEx :: Vector3 -> Vector3 -> Float -> Float -> Int -> Color -> IO ()
drawCylinderEx Vector3
start Vector3
end Float
startRadius Float
endRadius Int
sides Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinderEx Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startRadius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endRadius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides))))

drawCylinderWires :: Vector3 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCylinderWires :: Vector3 -> Float -> Float -> Float -> Int -> Color -> IO ()
drawCylinderWires Vector3
position Float
radiusTop Float
radiusBottom Float
height Int
slices Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3
-> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinderWires Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusTop) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusBottom) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices)))

drawCylinderWiresEx :: Vector3 -> Vector3 -> Float -> Float -> Int -> Color -> IO ()
drawCylinderWiresEx :: Vector3 -> Vector3 -> Float -> Float -> Int -> Color -> IO ()
drawCylinderWiresEx Vector3
start Vector3
end Float
startRadius Float
endRadius Int
sides Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()
c'drawCylinderWiresEx Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startRadius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endRadius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides))))

drawCapsule :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsule :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsule Vector3
start Vector3
end CFloat
radius Int
slices Int
rings Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawCapsule Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings))))

drawCapsuleWires :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsuleWires :: Vector3 -> Vector3 -> CFloat -> Int -> Int -> Color -> IO ()
drawCapsuleWires Vector3
start Vector3
end CFloat
radius Int
slices Int
rings Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (Ptr Vector3
-> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()
c'drawCapsuleWires Ptr Vector3
s Ptr Vector3
e (forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings))))

drawPlane :: Vector3 -> Vector2 -> Color -> IO ()
drawPlane :: Vector3 -> Vector2 -> Color -> IO ()
drawPlane Vector3
center Vector2
size Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
center (\Ptr Vector3
c -> 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 Vector3 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawPlane Ptr Vector3
c))

drawRay :: Ray -> Color -> IO ()
drawRay :: Ray -> Color -> IO ()
drawRay Ray
ray Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (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 Ray -> Ptr Color -> IO ()
c'drawRay)

drawGrid :: Int -> Float -> IO ()
drawGrid :: Int -> Float -> IO ()
drawGrid Int
slices Float
spacing = CInt -> CFloat -> IO ()
c'drawGrid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing)

loadModel :: String -> WindowResources -> IO Model
loadModel :: String -> WindowResources -> IO Model
loadModel String
fileName WindowResources
wr = do
  Model
model <- forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Model)
c'loadModel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Model -> [Mesh]
model'meshes Model
model) (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)
  [Material] -> WindowResources -> IO ()
storeMaterialData (Model -> [Material]
model'materials Model
model) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Model
model

loadModelFromMesh :: Mesh -> WindowResources -> IO Model
loadModelFromMesh :: Mesh -> WindowResources -> IO Model
loadModelFromMesh Mesh
mesh WindowResources
wr = do
  Ptr Mesh
meshPtr <- forall a. Storable a => IO (Ptr a)
malloc
  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Mesh
meshPtr Mesh
mesh
  Model
model <- Ptr Mesh -> IO (Ptr Model)
c'loadModelFromMesh Ptr Mesh
meshPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr Mesh
meshPtr
  [Material] -> WindowResources -> IO ()
storeMaterialData (Model -> [Material]
model'materials Model
model) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Model
model

-- | Unloads a model from GPU memory (VRAM). This unloads its associated

-- meshes and materials. Models are automatically unloaded when `closeWindow`

-- is called, so manually unloading models is not required. In larger projects,

-- you may want to manually unload models to avoid having them in VRAM for too

-- long.

unloadModel :: Model -> WindowResources -> IO ()
unloadModel :: Model -> WindowResources -> IO ()
unloadModel Model
model WindowResources
wr = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Model -> [Mesh]
model'meshes Model
model) (Mesh -> WindowResources -> IO ()
`unloadMesh` WindowResources
wr)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Model -> [Material]
model'materials Model
model) (Material -> WindowResources -> IO ()
`unloadMaterial` WindowResources
wr)

isModelReady :: Model -> IO Bool
isModelReady :: Model -> IO Bool
isModelReady Model
model = 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 Model
model Ptr Model -> IO CBool
c'isModelReady

getModelBoundingBox :: Model -> IO BoundingBox
getModelBoundingBox :: Model -> IO BoundingBox
getModelBoundingBox Model
model = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model Ptr Model -> IO (Ptr BoundingBox)
c'getModelBoundingBox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

drawModel :: Model -> Vector3 -> Float -> Color -> IO ()
drawModel :: Model -> Vector3 -> Float -> Color -> IO ()
drawModel Model
model Vector3
position Float
scale Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Model -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawModel Ptr Model
m Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
scale))))

drawModelEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO ()
drawModelEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO ()
drawModelEx Model
model Vector3
position Vector3
rotationAxis Float
rotationAngle Vector3
scale Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
rotationAxis (\Ptr Vector3
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
scale (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Model
-> Ptr Vector3
-> Ptr Vector3
-> CFloat
-> Ptr Vector3
-> Ptr Color
-> IO ()
c'drawModelEx Ptr Model
m Ptr Vector3
p Ptr Vector3
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotationAngle)))))

drawModelWires :: Model -> Vector3 -> Float -> Color -> IO ()
drawModelWires :: Model -> Vector3 -> Float -> Color -> IO ()
drawModelWires Model
model Vector3
position Float
scale Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Model -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawModelWires Ptr Model
m Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
scale))))

drawModelWiresEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO ()
drawModelWiresEx :: Model -> Vector3 -> Vector3 -> Float -> Vector3 -> Color -> IO ()
drawModelWiresEx Model
model Vector3
position Vector3
rotationAxis Float
rotationAngle Vector3
scale Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
rotationAxis (\Ptr Vector3
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
scale (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Model
-> Ptr Vector3
-> Ptr Vector3
-> CFloat
-> Ptr Vector3
-> Ptr Color
-> IO ()
c'drawModelWiresEx Ptr Model
m Ptr Vector3
p Ptr Vector3
r (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotationAngle)))))

drawBoundingBox :: BoundingBox -> Color -> IO ()
drawBoundingBox :: BoundingBox -> Color -> IO ()
drawBoundingBox BoundingBox
box Color
color = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box (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 BoundingBox -> Ptr Color -> IO ()
c'drawBoundingBox)

drawBillboard :: Camera3D -> Texture -> Vector3 -> Float -> Color -> IO ()
drawBillboard :: Camera3D -> Texture -> Vector3 -> Float -> Color -> IO ()
drawBillboard Camera3D
camera Texture
texture Vector3
position Float
size Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Camera3D
-> Ptr Texture -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()
c'drawBillboard Ptr Camera3D
c Ptr Texture
t Ptr Vector3
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size)))))

drawBillboardRec :: Camera3D -> Texture -> Rectangle -> Vector3 -> Vector2 -> Color -> IO ()
drawBillboardRec :: Camera3D
-> Texture -> Rectangle -> Vector3 -> Vector2 -> Color -> IO ()
drawBillboardRec Camera3D
camera Texture
texture Rectangle
source Vector3
position Vector2
size Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source (\Ptr Rectangle
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
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
tint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Camera3D
-> Ptr Texture
-> Ptr Rectangle
-> Ptr Vector3
-> Ptr Vector2
-> Ptr Color
-> IO ()
c'drawBillboardRec Ptr Camera3D
c Ptr Texture
t Ptr Rectangle
s Ptr Vector3
p)))))

drawBillboardPro :: Camera3D -> Texture -> Rectangle -> Vector3 -> Vector3 -> Vector2 -> Vector2 -> Float -> Color -> IO ()
drawBillboardPro :: Camera3D
-> Texture
-> Rectangle
-> Vector3
-> Vector3
-> Vector2
-> Vector2
-> Float
-> Color
-> IO ()
drawBillboardPro Camera3D
camera Texture
texture Rectangle
source Vector3
position Vector3
up Vector2
size Vector2
origin Float
rotation Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source (\Ptr Rectangle
s -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
up (\Ptr Vector3
u -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (\Ptr Vector2
sz -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
origin (\Ptr Vector2
o -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Camera3D
-> Ptr Texture
-> Ptr Rectangle
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> Ptr Color
-> IO ()
c'drawBillboardPro Ptr Camera3D
c Ptr Texture
t Ptr Rectangle
s Ptr Vector3
p Ptr Vector3
u Ptr Vector2
sz Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation)))))))))

uploadMesh :: Mesh -> Bool -> WindowResources -> IO Mesh
uploadMesh :: Mesh -> Bool -> WindowResources -> IO Mesh
uploadMesh Mesh
mesh Bool
dynamic WindowResources
wr = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> Ptr Mesh -> CInt -> IO ()
c'uploadMesh Ptr Mesh
m (forall a. Num a => Bool -> a
fromBool Bool
dynamic) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Mesh
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr))

updateMeshBuffer :: Mesh -> Int -> Ptr () -> Int -> Int -> IO ()
updateMeshBuffer :: Mesh -> Int -> Ptr () -> Int -> Int -> IO ()
updateMeshBuffer Mesh
mesh Int
index Ptr ()
dataValue Int
dataSize Int
offset = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> Ptr Mesh -> CInt -> Ptr () -> CInt -> CInt -> IO ()
c'updateMeshBuffer Ptr Mesh
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Ptr ()
dataValue (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))

-- | Unloads a mesh from GPU memory (VRAM). Meshes are

-- automatically unloaded when `closeWindow` is called, so manually unloading

-- meshes is not required. In larger projects, you may want to

-- manually unload meshes to avoid having them in VRAM for too long.

unloadMesh :: Mesh -> WindowResources -> IO ()
unloadMesh :: Mesh -> WindowResources -> IO ()
unloadMesh Mesh
mesh WindowResources
wr = do
  forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleVaoId (Mesh -> Integer
mesh'vaoId Mesh
mesh) WindowResources
wr
  forall a. Integral a => Maybe [a] -> WindowResources -> IO ()
unloadSingleVboIdList (Mesh -> Maybe [Integer]
mesh'vboId Mesh
mesh) WindowResources
wr

-- Internal

storeMeshData :: Mesh -> WindowResources -> IO Mesh
storeMeshData :: Mesh -> WindowResources -> IO Mesh
storeMeshData Mesh
mesh WindowResources
wr = do
  forall a. Integral a => a -> WindowResources -> IO ()
addVaoId (Mesh -> Integer
mesh'vaoId Mesh
mesh) WindowResources
wr
  forall a. Integral a => Maybe [a] -> WindowResources -> IO ()
addVboIds (Mesh -> Maybe [Integer]
mesh'vboId Mesh
mesh) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Mesh
mesh

drawMesh :: Mesh -> Material -> Matrix -> IO ()
drawMesh :: Mesh -> Material -> Matrix -> IO ()
drawMesh Mesh
mesh Material
material Matrix
transform = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Material
material (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Mesh -> Ptr Material -> Ptr Matrix -> IO ()
c'drawMesh Ptr Mesh
m))

drawMeshInstanced :: Mesh -> Material -> [Matrix] -> IO ()
drawMeshInstanced :: Mesh -> Material -> [Matrix] -> IO ()
drawMeshInstanced Mesh
mesh Material
material [Matrix]
transforms = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Material
material (\Ptr Material
mat -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen [Matrix]
transforms (\Int
size Ptr Matrix
t -> Ptr Mesh -> Ptr Material -> Ptr Matrix -> CInt -> IO ()
c'drawMeshInstanced Ptr Mesh
m Ptr Material
mat Ptr Matrix
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size))))

exportMesh :: Mesh -> String -> IO Bool
exportMesh :: Mesh -> String -> IO Bool
exportMesh Mesh
mesh String
fileName = 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 Mesh
mesh (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Mesh -> CString -> IO CBool
c'exportMesh)

getMeshBoundingBox :: Mesh -> IO BoundingBox
getMeshBoundingBox :: Mesh -> IO BoundingBox
getMeshBoundingBox Mesh
mesh = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh Ptr Mesh -> IO (Ptr BoundingBox)
c'getMeshBoundingBox forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genMeshTangents :: Mesh -> IO Mesh
genMeshTangents :: Mesh -> IO Mesh
genMeshTangents Mesh
mesh = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> Ptr Mesh -> IO ()
c'genMeshTangents Ptr Mesh
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Mesh
m)

genMeshPoly :: Int -> Float -> WindowResources -> IO Mesh
genMeshPoly :: Int -> Float -> WindowResources -> IO Mesh
genMeshPoly Int
sides Float
radius WindowResources
wr = CInt -> CFloat -> IO (Ptr Mesh)
c'genMeshPoly (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshPlane :: Float -> Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshPlane :: Float -> Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshPlane Float
width Float
length Int
resX Int
resZ WindowResources
wr = CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshPlane (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resX) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resZ) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshCube :: Float -> Float -> Float -> WindowResources -> IO Mesh
genMeshCube :: Float -> Float -> Float -> WindowResources -> IO Mesh
genMeshCube Float
width Float
height Float
length WindowResources
wr = CFloat -> CFloat -> CFloat -> IO (Ptr Mesh)
c'genMeshCube (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
length) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshSphere :: Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshSphere :: Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshSphere Float
radius Int
rings Int
slices WindowResources
wr = CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshSphere (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshHemiSphere :: Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshHemiSphere :: Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshHemiSphere Float
radius Int
rings Int
slices WindowResources
wr = CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshHemiSphere (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshCylinder :: Float -> Float -> Int -> WindowResources -> IO Mesh
genMeshCylinder :: Float -> Float -> Int -> WindowResources -> IO Mesh
genMeshCylinder Float
radius Float
height Int
slices WindowResources
wr = CFloat -> CFloat -> CInt -> IO (Ptr Mesh)
c'genMeshCylinder (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshCone :: Float -> Float -> Int -> WindowResources -> IO Mesh
genMeshCone :: Float -> Float -> Int -> WindowResources -> IO Mesh
genMeshCone Float
radius Float
height Int
slices WindowResources
wr = CFloat -> CFloat -> CInt -> IO (Ptr Mesh)
c'genMeshCone (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshTorus :: Float -> Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshTorus :: Float -> Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshTorus Float
radius Float
size Int
radSeg Int
sides WindowResources
wr = CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshTorus (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radSeg) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshKnot :: Float -> Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshKnot :: Float -> Float -> Int -> Int -> WindowResources -> IO Mesh
genMeshKnot Float
radius Float
size Int
radSeg Int
sides WindowResources
wr = CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)
c'genMeshKnot (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radSeg) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshHeightmap :: Image -> Vector3 -> WindowResources -> IO Mesh
genMeshHeightmap :: Image -> Vector3 -> WindowResources -> IO Mesh
genMeshHeightmap Image
heightmap Vector3
size WindowResources
wr = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
heightmap (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
size forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)
c'genMeshHeightmap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

genMeshCubicmap :: Image -> Vector3 -> WindowResources -> IO Mesh
genMeshCubicmap :: Image -> Vector3 -> WindowResources -> IO Mesh
genMeshCubicmap Image
cubicmap Vector3
cubeSize WindowResources
wr = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
cubicmap (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
cubeSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)
c'genMeshCubicmap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Mesh -> WindowResources -> IO Mesh
`storeMeshData` WindowResources
wr)

loadMaterials :: String -> WindowResources -> IO [Material]
loadMaterials :: String -> WindowResources -> IO [Material]
loadMaterials String
fileName WindowResources
wr =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
fileName
    ( \CString
f ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
n -> do
              Ptr Material
ptr <- CString -> Ptr CInt -> IO (Ptr Material)
c'loadMaterials CString
f Ptr CInt
n
              CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
              [Material]
materials <- forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr Material
ptr
              [Material] -> WindowResources -> IO ()
storeMaterialData [Material]
materials WindowResources
wr
              forall (m :: * -> *) a. Monad m => a -> m a
return [Material]
materials
          )
    )

-- Internal

storeMaterialData :: [Material] -> WindowResources -> IO ()
storeMaterialData :: [Material] -> WindowResources -> IO ()
storeMaterialData [Material]
materials WindowResources
wr =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    [Material]
materials
    ( \Material
mat -> do
        forall a. Integral a => a -> WindowResources -> IO ()
addShaderId (Shader -> Integer
shader'id forall a b. (a -> b) -> a -> b
$ Material -> Shader
material'shader Material
mat) WindowResources
wr
        case Material -> Maybe [MaterialMap]
material'maps Material
mat of
          Maybe [MaterialMap]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          (Just [MaterialMap]
maps) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MaterialMap]
maps (\MaterialMap
m -> forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ MaterialMap -> Texture
materialMap'texture MaterialMap
m) WindowResources
wr)
    )

-- | Unloads a material from GPU memory (VRAM). Materials are

-- automatically unloaded when `closeWindow` is called, so manually unloading

-- materials is not required. In larger projects, you may want to

-- manually unload materials to avoid having them in VRAM for too long.

unloadMaterial :: Material -> WindowResources -> IO ()
unloadMaterial :: Material -> WindowResources -> IO ()
unloadMaterial Material
material WindowResources
wr = do
  forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleShader (Shader -> Integer
shader'id forall a b. (a -> b) -> a -> b
$ Material -> Shader
material'shader Material
material) WindowResources
wr
  case Material -> Maybe [MaterialMap]
material'maps Material
material of
    Maybe [MaterialMap]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Just [MaterialMap]
maps) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MaterialMap]
maps (\MaterialMap
m -> forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleTexture (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ MaterialMap -> Texture
materialMap'texture MaterialMap
m) WindowResources
wr)

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

isMaterialReady :: Material -> IO Bool
isMaterialReady :: Material -> IO Bool
isMaterialReady Material
material = 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 Material
material Ptr Material -> IO CBool
c'isMaterialReady

setMaterialTexture :: Material -> Int -> Texture -> IO Material
setMaterialTexture :: Material -> Int -> Texture -> IO Material
setMaterialTexture Material
material Int
mapType Texture
texture = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Material
material (\Ptr Material
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (Ptr Material -> CInt -> Ptr Texture -> IO ()
c'setMaterialTexture Ptr Material
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mapType)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Material
m)

setModelMeshMaterial :: Model -> Int -> Int -> IO Model
setModelMeshMaterial :: Model -> Int -> Int -> IO Model
setModelMeshMaterial Model
model Int
meshId Int
materialId = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> Ptr Model -> CInt -> CInt -> IO ()
c'setModelMeshMaterial Ptr Model
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
meshId) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
materialId) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Model
m)

loadModelAnimations :: String -> IO [ModelAnimation]
loadModelAnimations :: String -> IO [ModelAnimation]
loadModelAnimations String
fileName =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
fileName
    ( \CString
f ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CUInt
0
          ( \Ptr CUInt
n -> do
              Ptr ModelAnimation
ptr <- CString -> Ptr CUInt -> IO (Ptr ModelAnimation)
c'loadModelAnimations CString
f Ptr CUInt
n
              CUInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
n
              forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
num) Ptr ModelAnimation
ptr
          )
    )

updateModelAnimation :: Model -> ModelAnimation -> Int -> IO ()
updateModelAnimation :: Model -> ModelAnimation -> Int -> IO ()
updateModelAnimation Model
model ModelAnimation
animation Int
frame = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable ModelAnimation
animation (\Ptr ModelAnimation
a -> Ptr Model -> Ptr ModelAnimation -> CInt -> IO ()
c'updateModelAnimation Ptr Model
m Ptr ModelAnimation
a (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frame)))

isModelAnimationValid :: Model -> ModelAnimation -> IO Bool
isModelAnimationValid :: Model -> ModelAnimation -> IO Bool
isModelAnimationValid Model
model ModelAnimation
animation = 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 Model
model (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable ModelAnimation
animation forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Model -> Ptr ModelAnimation -> IO CBool
c'isModelAnimationValid)

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

checkCollisionBoxes :: BoundingBox -> BoundingBox -> Bool
checkCollisionBoxes :: BoundingBox -> BoundingBox -> Bool
checkCollisionBoxes BoundingBox
box1 BoundingBox
box2 = forall a. (Eq a, Num a) => a -> Bool
toBool forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box1 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BoundingBox -> Ptr BoundingBox -> IO CBool
c'checkCollisionBoxes))

checkCollisionBoxSphere :: BoundingBox -> Vector3 -> Float -> Bool
checkCollisionBoxSphere :: BoundingBox -> Vector3 -> Float -> Bool
checkCollisionBoxSphere BoundingBox
box Vector3
center Float
radius = forall a. (Eq a, Num a) => a -> Bool
toBool forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box (\Ptr BoundingBox
b -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
center (\Ptr Vector3
c -> Ptr BoundingBox -> Ptr Vector3 -> CFloat -> IO CBool
c'checkCollisionBoxSphere Ptr BoundingBox
b Ptr Vector3
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))))

getRayCollisionSphere :: Ray -> Vector3 -> Float -> RayCollision
getRayCollisionSphere :: Ray -> Vector3 -> Float -> RayCollision
getRayCollisionSphere Ray
ray Vector3
center Float
radius = 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 Ray
ray (\Ptr Ray
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
center (\Ptr Vector3
c -> Ptr Ray -> Ptr Vector3 -> CFloat -> IO (Ptr RayCollision)
c'getRayCollisionSphere Ptr Ray
r Ptr Vector3
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getRayCollisionBox :: Ray -> BoundingBox -> RayCollision
getRayCollisionBox :: Ray -> BoundingBox -> RayCollision
getRayCollisionBox Ray
ray BoundingBox
box = 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 Ray
ray (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr BoundingBox -> IO (Ptr RayCollision)
c'getRayCollisionBox) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getRayCollisionMesh :: Ray -> Mesh -> Matrix -> RayCollision
getRayCollisionMesh :: Ray -> Mesh -> Matrix -> RayCollision
getRayCollisionMesh Ray
ray Mesh
mesh Matrix
transform = 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 Ray
ray (\Ptr Ray
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr Mesh -> Ptr Matrix -> IO (Ptr RayCollision)
c'getRayCollisionMesh Ptr Ray
r)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getRayCollisionTriangle :: Ray -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionTriangle :: Ray -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionTriangle Ray
ray Vector3
v1 Vector3
v2 Vector3
v3 = 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 Ray
ray (\Ptr Ray
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v1 (\Ptr Vector3
p1 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v2 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector3
-> IO (Ptr RayCollision)
c'getRayCollisionTriangle Ptr Ray
r Ptr Vector3
p1))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getRayCollisionQuad :: Ray -> Vector3 -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionQuad :: Ray -> Vector3 -> Vector3 -> Vector3 -> Vector3 -> RayCollision
getRayCollisionQuad Ray
ray Vector3
v1 Vector3
v2 Vector3
v3 Vector3
v4 = 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 Ray
ray (\Ptr Ray
r -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v1 (\Ptr Vector3
p1 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v2 (\Ptr Vector3
p2 -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v3 (forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector3
-> Ptr Vector3
-> IO (Ptr RayCollision)
c'getRayCollisionQuad Ptr Ray
r Ptr Vector3
p1 Ptr Vector3
p2)))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop