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

-- | Bindings to @rmodels@
module Raylib.Core.Models
  ( -- * High level
    drawLine3D,
    drawPoint3D,
    drawCircle3D,
    drawTriangle3D,
    drawTriangleStrip3D,
    drawCube,
    drawCubeV,
    drawCubeWires,
    drawCubeWiresV,
    drawSphere,
    drawSphereEx,
    drawSphereWires,
    drawCylinder,
    drawCylinderEx,
    drawCylinderWires,
    drawCylinderWiresEx,
    drawCapsule,
    drawCapsuleWires,
    drawPlane,
    drawRay,
    drawGrid,
    loadModel,
    loadModelFromMesh,
    unloadModel,
    isModelReady,
    getModelBoundingBox,
    drawModel,
    drawModelEx,
    drawModelWires,
    drawModelWiresEx,
    drawBoundingBox,
    drawBillboard,
    drawBillboardRec,
    drawBillboardPro,
    uploadMesh,
    updateMeshBuffer,
    unloadMesh,
    drawMesh,
    drawMeshInstanced,
    exportMesh,
    exportMeshAsCode,
    getMeshBoundingBox,
    genMeshTangents,
    genMeshPoly,
    genMeshPlane,
    genMeshCube,
    genMeshSphere,
    genMeshHemiSphere,
    genMeshCylinder,
    genMeshCone,
    genMeshTorus,
    genMeshKnot,
    genMeshHeightmap,
    genMeshCubicmap,
    loadMaterials,
    unloadMaterial,
    loadMaterialDefault,
    isMaterialReady,
    setMaterialTexture,
    setModelMeshMaterial,
    loadModelAnimations,
    updateModelAnimation,
    isModelAnimationValid,
    checkCollisionSpheres,
    checkCollisionBoxes,
    checkCollisionBoxSphere,
    getRayCollisionSphere,
    getRayCollisionBox,
    getRayCollisionMesh,
    getRayCollisionTriangle,
    getRayCollisionQuad,

    -- * Native
    c'drawLine3D,
    c'drawPoint3D,
    c'drawCircle3D,
    c'drawTriangle3D,
    c'drawTriangleStrip3D,
    c'drawCube,
    c'drawCubeV,
    c'drawCubeWires,
    c'drawCubeWiresV,
    c'drawSphere,
    c'drawSphereEx,
    c'drawSphereWires,
    c'drawCylinder,
    c'drawCylinderEx,
    c'drawCylinderWires,
    c'drawCylinderWiresEx,
    c'drawCapsule,
    c'drawCapsuleWires,
    c'drawPlane,
    c'drawRay,
    c'drawGrid,
    c'loadModel,
    c'loadModelFromMesh,
    c'isModelReady,
    c'unloadModel,
    c'getModelBoundingBox,
    c'drawModel,
    c'drawModelEx,
    c'drawModelWires,
    c'drawModelWiresEx,
    c'drawBoundingBox,
    c'drawBillboard,
    c'drawBillboardRec,
    c'drawBillboardPro,
    c'uploadMesh,
    c'updateMeshBuffer,
    c'unloadMesh,
    c'drawMesh,
    c'drawMeshInstanced,
    c'exportMesh,
    c'exportMeshAsCode,
    c'getMeshBoundingBox,
    c'genMeshTangents,
    c'genMeshPoly,
    c'genMeshPlane,
    c'genMeshCube,
    c'genMeshSphere,
    c'genMeshHemiSphere,
    c'genMeshCylinder,
    c'genMeshCone,
    c'genMeshTorus,
    c'genMeshKnot,
    c'genMeshHeightmap,
    c'genMeshCubicmap,
    c'loadMaterials,
    c'loadMaterialDefault,
    c'isMaterialReady,
    c'unloadMaterial,
    c'setMaterialTexture,
    c'setModelMeshMaterial,
    c'loadModelAnimations,
    c'updateModelAnimation,
    c'unloadModelAnimation,
    c'unloadModelAnimations,
    c'isModelAnimationValid,
    c'checkCollisionSpheres,
    c'checkCollisionBoxes,
    c'checkCollisionBoxSphere,
    c'getRayCollisionSphere,
    c'getRayCollisionBox,
    c'getRayCollisionMesh,
    c'getRayCollisionTriangle,
    c'getRayCollisionQuad,
  )
where

import Control.Monad (forM_)
import Foreign (Ptr, Storable (peek), fromBool, peekArray, toBool, with)
import Foreign.C
  ( CBool (..),
    CFloat (..),
    CInt (..),
    CString,
    withCString,
  )
import GHC.IO (unsafePerformIO)
import Raylib.Internal (WindowResources, addShaderId, addTextureId, addVaoId, addVboIds, unloadSingleShader, unloadSingleTexture, unloadSingleVaoId, unloadSingleVboIdList)
import Raylib.Internal.Foreign
  ( pop,
    popCArray,
    withFreeable,
    withFreeableArray,
    withFreeableArrayLen,
  )
import Raylib.Internal.TH (genNative)
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,
  )

$( genNative
     [ ("c'drawLine3D", "DrawLine3D_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawPoint3D", "DrawPoint3D_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawCircle3D", "DrawCircle3D_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawTriangle3D", "DrawTriangle3D_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawTriangleStrip3D", "DrawTriangleStrip3D_", "rl_bindings.h", [t|Ptr Vector3 -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCube", "DrawCube_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawCubeV", "DrawCubeV_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawCubeWires", "DrawCubeWires_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> CFloat -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawCubeWiresV", "DrawCubeWiresV_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawSphere", "DrawSphere_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawSphereEx", "DrawSphereEx_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawSphereWires", "DrawSphereWires_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCylinder", "DrawCylinder_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCylinderEx", "DrawCylinderEx_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCylinderWires", "DrawCylinderWires_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCylinderWiresEx", "DrawCylinderWiresEx_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> CFloat -> CFloat -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCapsule", "DrawCapsule_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawCapsuleWires", "DrawCapsuleWires_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector3 -> CFloat -> CInt -> CInt -> Ptr Color -> IO ()|], False),
       ("c'drawPlane", "DrawPlane_", "rl_bindings.h", [t|Ptr Vector3 -> Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawRay", "DrawRay_", "rl_bindings.h", [t|Ptr Ray -> Ptr Color -> IO ()|], False),
       ("c'drawGrid", "DrawGrid_", "rl_bindings.h", [t|CInt -> CFloat -> IO ()|], False),
       ("c'loadModel", "LoadModel_", "rl_bindings.h", [t|CString -> IO (Ptr Model)|], False),
       ("c'loadModelFromMesh", "LoadModelFromMesh_", "rl_bindings.h", [t|Ptr Mesh -> IO (Ptr Model)|], False),
       ("c'isModelReady", "IsModelReady_", "rl_bindings.h", [t|Ptr Model -> IO CBool|], False),
       ("c'unloadModel", "UnloadModel_", "rl_bindings.h", [t|Ptr Model -> IO ()|], False),
       ("c'getModelBoundingBox", "GetModelBoundingBox_", "rl_bindings.h", [t|Ptr Model -> IO (Ptr BoundingBox)|], False),
       ("c'drawModel", "DrawModel_", "rl_bindings.h", [t|Ptr Model -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawModelEx", "DrawModelEx_", "rl_bindings.h", [t|Ptr Model -> Ptr Vector3 -> Ptr Vector3 -> CFloat -> Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawModelWires", "DrawModelWires_", "rl_bindings.h", [t|Ptr Model -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawModelWiresEx", "DrawModelWiresEx_", "rl_bindings.h", [t|Ptr Model -> Ptr Vector3 -> Ptr Vector3 -> CFloat -> Ptr Vector3 -> Ptr Color -> IO ()|], False),
       ("c'drawBoundingBox", "DrawBoundingBox_", "rl_bindings.h", [t|Ptr BoundingBox -> Ptr Color -> IO ()|], False),
       ("c'drawBillboard", "DrawBillboard_", "rl_bindings.h", [t|Ptr Camera3D -> Ptr Texture -> Ptr Vector3 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'drawBillboardRec", "DrawBillboardRec_", "rl_bindings.h", [t|Ptr Camera3D -> Ptr Texture -> Ptr Rectangle -> Ptr Vector3 -> Ptr Vector2 -> Ptr Color -> IO ()|], False),
       ("c'drawBillboardPro", "DrawBillboardPro_", "rl_bindings.h", [t|Ptr Camera3D -> Ptr Texture -> Ptr Rectangle -> Ptr Vector3 -> Ptr Vector3 -> Ptr Vector2 -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()|], False),
       ("c'uploadMesh", "UploadMesh_", "rl_bindings.h", [t|Ptr Mesh -> CInt -> IO ()|], False),
       ("c'updateMeshBuffer", "UpdateMeshBuffer_", "rl_bindings.h", [t|Ptr Mesh -> CInt -> Ptr () -> CInt -> CInt -> IO ()|], False),
       ("c'unloadMesh", "UnloadMesh_", "rl_bindings.h", [t|Ptr Mesh -> IO ()|], False),
       ("c'drawMesh", "DrawMesh_", "rl_bindings.h", [t|Ptr Mesh -> Ptr Material -> Ptr Matrix -> IO ()|], False),
       ("c'drawMeshInstanced", "DrawMeshInstanced_", "rl_bindings.h", [t|Ptr Mesh -> Ptr Material -> Ptr Matrix -> CInt -> IO ()|], False),
       ("c'exportMesh", "ExportMesh_", "rl_bindings.h", [t|Ptr Mesh -> CString -> IO CBool|], False),
       ("c'exportMeshAsCode", "ExportMeshAsCode_", "rl_bindings.h", [t|Ptr Mesh -> CString -> IO CBool|], False),
       ("c'getMeshBoundingBox", "GetMeshBoundingBox_", "rl_bindings.h", [t|Ptr Mesh -> IO (Ptr BoundingBox)|], False),
       ("c'genMeshTangents", "GenMeshTangents_", "rl_bindings.h", [t|Ptr Mesh -> IO ()|], False),
       ("c'genMeshPoly", "GenMeshPoly_", "rl_bindings.h", [t|CInt -> CFloat -> IO (Ptr Mesh)|], False),
       ("c'genMeshPlane", "GenMeshPlane_", "rl_bindings.h", [t|CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshCube", "GenMeshCube_", "rl_bindings.h", [t|CFloat -> CFloat -> CFloat -> IO (Ptr Mesh)|], False),
       ("c'genMeshSphere", "GenMeshSphere_", "rl_bindings.h", [t|CFloat -> CInt -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshHemiSphere", "GenMeshHemiSphere_", "rl_bindings.h", [t|CFloat -> CInt -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshCylinder", "GenMeshCylinder_", "rl_bindings.h", [t|CFloat -> CFloat -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshCone", "GenMeshCone_", "rl_bindings.h", [t|CFloat -> CFloat -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshTorus", "GenMeshTorus_", "rl_bindings.h", [t|CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshKnot", "GenMeshKnot_", "rl_bindings.h", [t|CFloat -> CFloat -> CInt -> CInt -> IO (Ptr Mesh)|], False),
       ("c'genMeshHeightmap", "GenMeshHeightmap_", "rl_bindings.h", [t|Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)|], False),
       ("c'genMeshCubicmap", "GenMeshCubicmap_", "rl_bindings.h", [t|Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)|], False),
       ("c'loadMaterials", "LoadMaterials_", "rl_bindings.h", [t|CString -> Ptr CInt -> IO (Ptr Material)|], False),
       ("c'loadMaterialDefault", "LoadMaterialDefault_", "rl_bindings.h", [t|IO (Ptr Material)|], False),
       ("c'isMaterialReady", "IsMaterialReady_", "rl_bindings.h", [t|Ptr Material -> IO CBool|], False),
       ("c'unloadMaterial", "UnloadMaterial_", "rl_bindings.h", [t|Ptr Material -> IO ()|], False),
       ("c'setMaterialTexture", "SetMaterialTexture_", "rl_bindings.h", [t|Ptr Material -> CInt -> Ptr Texture -> IO ()|], False),
       ("c'setModelMeshMaterial", "SetModelMeshMaterial_", "rl_bindings.h", [t|Ptr Model -> CInt -> CInt -> IO ()|], False),
       ("c'loadModelAnimations", "LoadModelAnimations_", "rl_bindings.h", [t|CString -> Ptr CInt -> IO (Ptr ModelAnimation)|], False),
       ("c'updateModelAnimation", "UpdateModelAnimation_", "rl_bindings.h", [t|Ptr Model -> Ptr ModelAnimation -> CInt -> IO ()|], False),
       ("c'unloadModelAnimation", "UnloadModelAnimation_", "rl_bindings.h", [t|Ptr ModelAnimation -> IO ()|], False),
       ("c'unloadModelAnimations", "UnloadModelAnimations_", "rl_bindings.h", [t|Ptr ModelAnimation -> CInt -> IO ()|], False),
       ("c'isModelAnimationValid", "IsModelAnimationValid_", "rl_bindings.h", [t|Ptr Model -> Ptr ModelAnimation -> IO CBool|], False),
       ("c'checkCollisionSpheres", "CheckCollisionSpheres_", "rl_bindings.h", [t|Ptr Vector3 -> CFloat -> Ptr Vector3 -> CFloat -> IO CBool|], False),
       ("c'checkCollisionBoxes", "CheckCollisionBoxes_", "rl_bindings.h", [t|Ptr BoundingBox -> Ptr BoundingBox -> IO CBool|], False),
       ("c'checkCollisionBoxSphere", "CheckCollisionBoxSphere_", "rl_bindings.h", [t|Ptr BoundingBox -> Ptr Vector3 -> CFloat -> IO CBool|], False),
       ("c'getRayCollisionSphere", "GetRayCollisionSphere_", "rl_bindings.h", [t|Ptr Ray -> Ptr Vector3 -> CFloat -> IO (Ptr RayCollision)|], False),
       ("c'getRayCollisionBox", "GetRayCollisionBox_", "rl_bindings.h", [t|Ptr Ray -> Ptr BoundingBox -> IO (Ptr RayCollision)|], False),
       ("c'getRayCollisionMesh", "GetRayCollisionMesh_", "rl_bindings.h", [t|Ptr Ray -> Ptr Mesh -> Ptr Matrix -> IO (Ptr RayCollision)|], False),
       ("c'getRayCollisionTriangle", "GetRayCollisionTriangle_", "rl_bindings.h", [t|Ptr Ray -> Ptr Vector3 -> Ptr Vector3 -> Ptr Vector3 -> IO (Ptr RayCollision)|], False),
       ("c'getRayCollisionQuad", "GetRayCollisionQuad_", "rl_bindings.h", [t|Ptr Ray -> Ptr Vector3 -> Ptr Vector3 -> Ptr Vector3 -> Ptr Vector3 -> IO (Ptr RayCollision)|], False)
     ]
 )

drawLine3D :: Vector3 -> Vector3 -> Color -> IO ()
drawLine3D :: Vector3 -> Vector3 -> Color -> IO ()
drawLine3D Vector3
start Vector3
end Color
color = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
point (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
center (\Ptr Vector3
c -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
rotationAxis (\Ptr Vector3
r -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) Ptr Vector3
r (Float -> CFloat
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v1 (\Ptr Vector3
p1 -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v2 (\Ptr Vector3
p2 -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v3 (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 = [Vector3] -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [Vector3]
points (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Float -> CFloat
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
size (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Float -> CFloat
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
size (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusTop) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusBottom) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startRadius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endRadius) (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusTop) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radiusBottom) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
startRadius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
endRadius) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides))))

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

drawCapsuleWires :: Vector3 -> Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawCapsuleWires :: Vector3 -> Vector3 -> Float -> Int -> Int -> Color -> IO ()
drawCapsuleWires Vector3
start Vector3
end Float
radius Int
slices Int
rings Color
color = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
start (\Ptr Vector3
s -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
end (\Ptr Vector3
e -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (Int -> CInt
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 = Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
center (\Ptr Vector3
c -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vector3 -> Ptr Vector2 -> Ptr Color -> IO ()
c'drawPlane Ptr Vector3
c))

drawRay :: Ray -> Color -> IO ()
drawRay :: Ray -> Color -> IO ()
drawRay Ray
ray Color
color = Ray -> (Ptr Ray -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Ray -> Ptr Color -> IO ()) -> Ptr Ray -> IO ()
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) (Float -> CFloat
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 <- String -> (CString -> IO (Ptr Model)) -> IO (Ptr Model)
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Model)
c'loadModel IO (Ptr Model) -> (Ptr Model -> IO Model) -> IO Model
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Model -> IO Model
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  [Mesh] -> (Mesh -> IO Mesh) -> IO ()
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
  Model -> IO Model
forall a. a -> IO a
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
  Model
model <- Mesh -> (Ptr Mesh -> IO (Ptr Model)) -> IO (Ptr Model)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Mesh
mesh Ptr Mesh -> IO (Ptr Model)
c'loadModelFromMesh IO (Ptr Model) -> (Ptr Model -> IO Model) -> IO Model
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Model -> IO Model
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  [Material] -> WindowResources -> IO ()
storeMaterialData (Model -> [Material]
model'materials Model
model) WindowResources
wr
  Model -> IO Model
forall a. a -> IO a
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 `Raylib.Core.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
  [Mesh] -> (Mesh -> IO ()) -> IO ()
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)
  [Material] -> (Material -> IO ()) -> IO ()
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 = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Model -> (Ptr Model -> IO CBool) -> IO CBool
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 = Model
-> (Ptr Model -> IO (Ptr BoundingBox)) -> IO (Ptr BoundingBox)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model Ptr Model -> IO (Ptr BoundingBox)
c'getModelBoundingBox IO (Ptr BoundingBox)
-> (Ptr BoundingBox -> IO BoundingBox) -> IO BoundingBox
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr BoundingBox -> IO BoundingBox
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 = Model -> (Ptr Model -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
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 = Model -> (Ptr Model -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
rotationAxis (\Ptr Vector3
r -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
scale (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 (Float -> CFloat
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 = Model -> (Ptr Model -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
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 = Model -> (Ptr Model -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
rotationAxis (\Ptr Vector3
r -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
scale (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector3 -> Ptr Color -> IO ()) -> Ptr Vector3 -> IO ()
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 (Float -> CFloat
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 = BoundingBox -> (Ptr BoundingBox -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color ((Ptr Color -> IO ()) -> IO ())
-> (Ptr BoundingBox -> Ptr Color -> IO ())
-> Ptr BoundingBox
-> IO ()
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 = Camera3D -> (Ptr Camera3D -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> Texture -> (Ptr Texture -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
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 = Camera3D -> (Ptr Camera3D -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> Texture -> (Ptr Texture -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source (\Ptr Rectangle
s -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (Color -> (Ptr Color -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint ((Ptr Color -> IO ()) -> IO ())
-> (Ptr Vector2 -> Ptr Color -> IO ()) -> Ptr Vector2 -> IO ()
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 = Camera3D -> (Ptr Camera3D -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Camera3D
camera (\Ptr Camera3D
c -> Texture -> (Ptr Texture -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Texture
texture (\Ptr Texture
t -> Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Rectangle
source (\Ptr Rectangle
s -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
position (\Ptr Vector3
p -> Vector3 -> (Ptr Vector3 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
up (\Ptr Vector3
u -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
size (\Ptr Vector2
sz -> Vector2 -> (Ptr Vector2 -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
origin (\Ptr Vector2
o -> Color -> (Ptr Color -> IO ()) -> IO ()
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 (Float -> CFloat
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 = Mesh -> (Ptr Mesh -> IO Mesh) -> IO Mesh
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 (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
dynamic) IO () -> IO Mesh -> IO Mesh
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Mesh -> IO Mesh
forall a. Storable a => Ptr a -> IO a
peek Ptr Mesh
m IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 = Mesh -> (Ptr Mesh -> IO ()) -> IO ()
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) Ptr ()
dataValue (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))

-- | Unloads a mesh from GPU memory (VRAM). Meshes are
-- automatically unloaded when `Raylib.Core.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
  Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleVaoId (Mesh -> Integer
mesh'vaoId Mesh
mesh) WindowResources
wr
  Maybe [Integer] -> WindowResources -> IO ()
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
  Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
addVaoId (Mesh -> Integer
mesh'vaoId Mesh
mesh) WindowResources
wr
  Maybe [Integer] -> WindowResources -> IO ()
forall a. Integral a => Maybe [a] -> WindowResources -> IO ()
addVboIds (Mesh -> Maybe [Integer]
mesh'vboId Mesh
mesh) WindowResources
wr
  Mesh -> IO Mesh
forall a. a -> IO a
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 = Mesh -> (Ptr Mesh -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> Material -> (Ptr Material -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Material
material (Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
transform ((Ptr Matrix -> IO ()) -> IO ())
-> (Ptr Material -> Ptr Matrix -> IO ()) -> Ptr Material -> IO ()
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 = Mesh -> (Ptr Mesh -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (\Ptr Mesh
m -> Material -> (Ptr Material -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Material
material (\Ptr Material
mat -> [Matrix] -> (Int -> Ptr Matrix -> IO ()) -> IO ()
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 (Int -> CInt
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 = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mesh -> (Ptr Mesh -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName ((CString -> IO CBool) -> IO CBool)
-> (Ptr Mesh -> CString -> IO CBool) -> Ptr Mesh -> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Mesh -> CString -> IO CBool
c'exportMesh)

exportMeshAsCode :: Mesh -> String -> IO Bool
exportMeshAsCode :: Mesh -> String -> IO Bool
exportMeshAsCode Mesh
mesh String
fileName = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mesh -> (Ptr Mesh -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName ((CString -> IO CBool) -> IO CBool)
-> (Ptr Mesh -> CString -> IO CBool) -> Ptr Mesh -> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Mesh -> CString -> IO CBool
c'exportMeshAsCode)

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

genMeshTangents :: Mesh -> IO Mesh
genMeshTangents :: Mesh -> IO Mesh
genMeshTangents Mesh
mesh = Mesh -> (Ptr Mesh -> IO Mesh) -> IO 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 IO () -> IO Mesh -> IO Mesh
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Mesh -> IO Mesh
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
_length) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resZ) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
width) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
_length) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rings) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slices) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radSeg) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
size) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radSeg) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 = Image -> (Ptr Image -> IO (Ptr Mesh)) -> IO (Ptr Mesh)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
heightmap (Vector3 -> (Ptr Vector3 -> IO (Ptr Mesh)) -> IO (Ptr Mesh)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
size ((Ptr Vector3 -> IO (Ptr Mesh)) -> IO (Ptr Mesh))
-> (Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh))
-> Ptr Image
-> IO (Ptr Mesh)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)
c'genMeshHeightmap) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 = Image -> (Ptr Image -> IO (Ptr Mesh)) -> IO (Ptr Mesh)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
cubicmap (Vector3 -> (Ptr Vector3 -> IO (Ptr Mesh)) -> IO (Ptr Mesh)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
cubeSize ((Ptr Vector3 -> IO (Ptr Mesh)) -> IO (Ptr Mesh))
-> (Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh))
-> Ptr Image
-> IO (Ptr Mesh)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Image -> Ptr Vector3 -> IO (Ptr Mesh)
c'genMeshCubicmap) IO (Ptr Mesh) -> (Ptr Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Mesh -> IO Mesh
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop IO Mesh -> (Mesh -> IO Mesh) -> IO Mesh
forall a b. IO a -> (a -> IO b) -> IO b
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 =
  String -> (CString -> IO [Material]) -> IO [Material]
forall a. String -> (CString -> IO a) -> IO a
withCString
    String
fileName
    ( \CString
f ->
        CInt -> (Ptr CInt -> IO [Material]) -> IO [Material]
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 <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
              [Material]
materials <- Int -> Ptr Material -> IO [Material]
forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr Material
ptr
              [Material] -> WindowResources -> IO ()
storeMaterialData [Material]
materials WindowResources
wr
              [Material] -> IO [Material]
forall a. a -> IO a
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 =
  [Material] -> (Material -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    [Material]
materials
    ( \Material
mat -> do
        Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
addShaderId (Shader -> Integer
shader'id (Shader -> Integer) -> Shader -> Integer
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 -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          (Just [MaterialMap]
maps) -> [MaterialMap] -> (MaterialMap -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MaterialMap]
maps (\MaterialMap
m -> Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id (Texture -> Integer) -> Texture -> Integer
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 `Raylib.Core.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
  Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleShader (Shader -> Integer
shader'id (Shader -> Integer) -> Shader -> Integer
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 -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Just [MaterialMap]
maps) -> [MaterialMap] -> (MaterialMap -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MaterialMap]
maps (\MaterialMap
m -> Integer -> WindowResources -> IO ()
forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleTexture (Texture -> Integer
texture'id (Texture -> Integer) -> Texture -> Integer
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 IO (Ptr Material) -> (Ptr Material -> IO Material) -> IO Material
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Material -> IO Material
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

isMaterialReady :: Material -> IO Bool
isMaterialReady :: Material -> IO Bool
isMaterialReady Material
material = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Material -> (Ptr Material -> IO CBool) -> IO CBool
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 = Material -> (Ptr Material -> IO Material) -> IO Material
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Material
material (\Ptr Material
m -> Texture -> (Ptr Texture -> IO ()) -> IO ()
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mapType)) IO () -> IO Material -> IO Material
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Material -> IO Material
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 = Model -> (Ptr Model -> IO Model) -> IO Model
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
meshId) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
materialId) IO () -> IO Model -> IO Model
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Model -> IO Model
forall a. Storable a => Ptr a -> IO a
peek Ptr Model
m)

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

updateModelAnimation :: Model -> ModelAnimation -> Int -> IO ()
updateModelAnimation :: Model -> ModelAnimation -> Int -> IO ()
updateModelAnimation Model
model ModelAnimation
animation Int
frame = Model -> (Ptr Model -> IO ()) -> IO ()
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (\Ptr Model
m -> ModelAnimation -> (Ptr ModelAnimation -> IO ()) -> IO ()
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 (Int -> CInt
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 = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Model -> (Ptr Model -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Model
model (ModelAnimation -> (Ptr ModelAnimation -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable ModelAnimation
animation ((Ptr ModelAnimation -> IO CBool) -> IO CBool)
-> (Ptr Model -> Ptr ModelAnimation -> IO CBool)
-> Ptr Model
-> IO CBool
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 = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ IO CBool -> CBool
forall a. IO a -> a
unsafePerformIO (Vector3 -> (Ptr Vector3 -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
center1 (\Ptr Vector3
c1 -> Vector3 -> (Ptr Vector3 -> IO CBool) -> IO CBool
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius1) Ptr Vector3
c2 (Float -> CFloat
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 = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ IO CBool -> CBool
forall a. IO a -> a
unsafePerformIO (BoundingBox -> (Ptr BoundingBox -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box1 (BoundingBox -> (Ptr BoundingBox -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box2 ((Ptr BoundingBox -> IO CBool) -> IO CBool)
-> (Ptr BoundingBox -> Ptr BoundingBox -> IO CBool)
-> Ptr BoundingBox
-> IO CBool
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 = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ IO CBool -> CBool
forall a. IO a -> a
unsafePerformIO (BoundingBox -> (Ptr BoundingBox -> IO CBool) -> IO CBool
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box (\Ptr BoundingBox
b -> Vector3 -> (Ptr Vector3 -> IO CBool) -> IO CBool
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 (Float -> CFloat
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 = IO RayCollision -> RayCollision
forall a. IO a -> a
unsafePerformIO (IO RayCollision -> RayCollision)
-> IO RayCollision -> RayCollision
forall a b. (a -> b) -> a -> b
$ Ray -> (Ptr Ray -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (\Ptr Ray
r -> Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
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 (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
radius))) IO (Ptr RayCollision)
-> (Ptr RayCollision -> IO RayCollision) -> IO RayCollision
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr RayCollision -> IO RayCollision
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getRayCollisionBox :: Ray -> BoundingBox -> RayCollision
getRayCollisionBox :: Ray -> BoundingBox -> RayCollision
getRayCollisionBox Ray
ray BoundingBox
box = IO RayCollision -> RayCollision
forall a. IO a -> a
unsafePerformIO (IO RayCollision -> RayCollision)
-> IO RayCollision -> RayCollision
forall a b. (a -> b) -> a -> b
$ Ray -> (Ptr Ray -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (BoundingBox
-> (Ptr BoundingBox -> IO (Ptr RayCollision))
-> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable BoundingBox
box ((Ptr BoundingBox -> IO (Ptr RayCollision))
 -> IO (Ptr RayCollision))
-> (Ptr Ray -> Ptr BoundingBox -> IO (Ptr RayCollision))
-> Ptr Ray
-> IO (Ptr RayCollision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr BoundingBox -> IO (Ptr RayCollision)
c'getRayCollisionBox) IO (Ptr RayCollision)
-> (Ptr RayCollision -> IO RayCollision) -> IO RayCollision
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr RayCollision -> IO RayCollision
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 = IO RayCollision -> RayCollision
forall a. IO a -> a
unsafePerformIO (IO RayCollision -> RayCollision)
-> IO RayCollision -> RayCollision
forall a b. (a -> b) -> a -> b
$ Ray -> (Ptr Ray -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (\Ptr Ray
r -> Mesh
-> (Ptr Mesh -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Mesh
mesh (Matrix
-> (Ptr Matrix -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Matrix
transform ((Ptr Matrix -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision))
-> (Ptr Mesh -> Ptr Matrix -> IO (Ptr RayCollision))
-> Ptr Mesh
-> IO (Ptr RayCollision)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ray -> Ptr Mesh -> Ptr Matrix -> IO (Ptr RayCollision)
c'getRayCollisionMesh Ptr Ray
r)) IO (Ptr RayCollision)
-> (Ptr RayCollision -> IO RayCollision) -> IO RayCollision
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr RayCollision -> IO RayCollision
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 = IO RayCollision -> RayCollision
forall a. IO a -> a
unsafePerformIO (IO RayCollision -> RayCollision)
-> IO RayCollision -> RayCollision
forall a b. (a -> b) -> a -> b
$ Ray -> (Ptr Ray -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (\Ptr Ray
r -> Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v1 (\Ptr Vector3
p1 -> Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v2 (Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v3 ((Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision))
-> (Ptr Vector3 -> Ptr Vector3 -> IO (Ptr RayCollision))
-> Ptr Vector3
-> IO (Ptr RayCollision)
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))) IO (Ptr RayCollision)
-> (Ptr RayCollision -> IO RayCollision) -> IO RayCollision
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr RayCollision -> IO RayCollision
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 = IO RayCollision -> RayCollision
forall a. IO a -> a
unsafePerformIO (IO RayCollision -> RayCollision)
-> IO RayCollision -> RayCollision
forall a b. (a -> b) -> a -> b
$ Ray -> (Ptr Ray -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Ray
ray (\Ptr Ray
r -> Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v1 (\Ptr Vector3
p1 -> Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v2 (\Ptr Vector3
p2 -> Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v3 (Vector3
-> (Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision)
forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector3
v4 ((Ptr Vector3 -> IO (Ptr RayCollision)) -> IO (Ptr RayCollision))
-> (Ptr Vector3 -> Ptr Vector3 -> IO (Ptr RayCollision))
-> Ptr Vector3
-> IO (Ptr RayCollision)
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)))) IO (Ptr RayCollision)
-> (Ptr RayCollision -> IO RayCollision) -> IO RayCollision
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr RayCollision -> IO RayCollision
forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop