From 0494c88cbf49a7f3580b6fc3e405650a37d324d6 Mon Sep 17 00:00:00 2001 From: Anand Swaroop Date: Wed, 21 Feb 2024 16:36:58 -0500 Subject: [PATCH] feat: add pointer utilities --- examples/bunnymark/src/Main.hs | 22 +- src/Raylib/Types.hs | 74 ++--- src/Raylib/Types/Core.hs | 508 +++++++++++++++++++++-------- src/Raylib/Types/Core/Audio.hs | 376 ++++++++++++++++------ src/Raylib/Types/Core/Camera.hs | 80 +++-- src/Raylib/Types/Core/Models.hs | 509 +++++++++++++++++++++--------- src/Raylib/Types/Core/Text.hs | 109 +++++-- src/Raylib/Types/Core/Textures.hs | 168 +++++++--- src/Raylib/Types/Util/GUI.hs | 31 +- src/Raylib/Types/Util/RLGL.hs | 177 +++++++---- 10 files changed, 1471 insertions(+), 583 deletions(-) diff --git a/examples/bunnymark/src/Main.hs b/examples/bunnymark/src/Main.hs index 9fc06fe..da27ab2 100644 --- a/examples/bunnymark/src/Main.hs +++ b/examples/bunnymark/src/Main.hs @@ -1,6 +1,6 @@ {-# OPTIONS -Wall #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TemplateHaskell #-} -- Writing performant h-raylib code requires the use of pointers and other -- un-Haskelly functionality. Unfortunately, this cannot be avoided. @@ -41,7 +41,7 @@ import Raylib.Core import Raylib.Core.Shapes (drawRectangle) import Raylib.Core.Text (drawFPS, drawText) import Raylib.Core.Textures (c'drawTexture, c'loadTexture, c'unloadTexture) -import Raylib.Types (Color (Color), MouseButton (MouseButtonLeft), Texture (texture'height, texture'width)) +import Raylib.Types (Color (Color), MouseButton (MouseButtonLeft), Texture, p'texture'height, p'texture'width) import Raylib.Util (inGHCi, raylibApplication) import Raylib.Util.Colors (black, green, maroon, rayWhite) @@ -120,20 +120,20 @@ startup = do texPtr <- withCString texPath c'loadTexture -- Use `peek` when you need to access the underlying fields - -- If you have to do this often (e.g. every frame), use `plusPtr` - -- to get a pointer to the exact field that you need - - -- For example, this could be rewritten as - -- tWidth <- fromIntegral (peekByteOff texPtr 4 :: IO CInt) - -- but since we are only doing this on startup, there is no need to optimize it - tex <- peek texPtr + -- This could be rewritten as + -- tex <- peek texPtr + -- let tWidth = texture'width tex + -- ... + -- but the code below is faster as it doesn't have to load the entire structure into Haskell + tWidth <- peek (p'texture'width texPtr) + tHeight <- peek (p'texture'height texPtr) bunniesPtr <- callocArray maxBunnies return ( AppState { texBunny = texPtr, bunnies = bunniesPtr, - halfTexWidth = fromIntegral (texture'width tex) / 2, - halfTexHeight = fromIntegral (texture'height tex) / 2, + halfTexWidth = fromIntegral tWidth / 2, + halfTexHeight = fromIntegral tHeight / 2, bunniesCount = 0 } ) diff --git a/src/Raylib/Types.hs b/src/Raylib/Types.hs index 9fe0b44..0d25eb5 100644 --- a/src/Raylib/Types.hs +++ b/src/Raylib/Types.hs @@ -1,38 +1,41 @@ {-# OPTIONS -Wall #-} -{-| - -Each @Types@ module has up to 3 sections: one for enumerations, one for -structures, and one for callbacks. Any one of these may be omitted if not -needed (for example, most of the @Types@ modules do not have a callback -section). Most of these types are instances of `Foreign.Storable` so they can -be converted to raw bytes and passed to a C function. - -The enumerations section contains Haskell sum types that are instances of -@Enum@. Each of these types corresponds to a raylib (C) @enum@ or a set of -@define@ directives. The `Prelude.fromEnum` and `Prelude.toEnum` functions for -these types use the numbers associated with these values in C. /NOTE: Some of/ -/these types correspond to C @enum@s that are defined in C source files, rather/ -/than header files./ - -The structures section contains Haskell types that each correspond to a raylib -@struct@. Each field in these types is named @typeName'fieldName@ (e.g. -@Vector2.x@ in C is `vector2'x` in Haskell). These structs also all derive the -typeclass t`Raylib.Util.Freeable`. This typeclass allows types to describe how -to properly free all the data associated with a pointer to that type. For -example, `Image`'s implementation of @Freeable@ also frees the pointer stored -in the @Image.data@ field in C. - -The callbacks section contains `Foreign.FunPtr` types, along with higher-level -Haskell wrappers. When you pass one of these wrappers (e.g. -`LoadFileDataCallback`) to a function that takes one as an argument (e.g. -`Raylib.Core.setLoadFileDataCallback`), the function will return a @FunPtr@ -type (e.g. `C'LoadFileDataCallback`). You will have to manually free this with -`Foreign.freeHaskellFunPtr` at the end of your program to avoid memory leaks -(TODO: implement automatic memory management for `FunPtr`s). - --} - +-- | +-- +-- Each @Types@ module has up to 4 sections: one for enumerations, one for +-- structures, one for pointer utilities, and one for callbacks. Any one of +-- these may be omitted if not needed (for example, most of the @Types@ modules +-- do not have a callback section). Most of these types are instances of +-- `Foreign.Storable` so they can be converted to raw bytes and passed to a C +-- function. +-- +-- The enumerations section contains Haskell sum types that are instances of +-- @Enum@. Each of these types corresponds to a raylib (C) @enum@ or a set of +-- @define@ directives. The `Prelude.fromEnum` and `Prelude.toEnum` functions for +-- these types use the numbers associated with these values in C. /NOTE: Some of/ +-- /these types correspond to C @enum@s that are defined in C source files, rather/ +-- /than header files./ +-- +-- The structures section contains Haskell types that each correspond to a raylib +-- @struct@. Each field in these types is named @typeName'fieldName@ (e.g. +-- @Vector2.x@ in C is `vector2'x` in Haskell). These structs also all derive the +-- typeclass t`Raylib.Util.Freeable`. This typeclass allows types to describe how +-- to properly free all the data associated with a pointer to that type. For +-- example, `Image`'s implementation of @Freeable@ also frees the pointer stored +-- in the @Image.data@ field in C. +-- +-- The pointer utilities section contains functions starting with @p'@. These +-- functions advance a pointer by some amount to allow for efficient memory +-- access. These are only necessary when writing high-performance applications +-- where memory access has to be fast. +-- +-- The callbacks section contains `Foreign.FunPtr` types, along with higher-level +-- Haskell wrappers. When you pass one of these wrappers (e.g. +-- `LoadFileDataCallback`) to a function that takes one as an argument (e.g. +-- `Raylib.Core.setLoadFileDataCallback`), the function will return a @FunPtr@ +-- type (e.g. `C'LoadFileDataCallback`). You will have to manually free this with +-- `Foreign.freeHaskellFunPtr` at the end of your program to avoid memory leaks +-- (TODO: implement automatic memory management for `FunPtr`s). module Raylib.Types ( module Raylib.Types.Core, module Raylib.Types.Core.Audio, @@ -42,7 +45,8 @@ module Raylib.Types module Raylib.Types.Core.Textures, module Raylib.Types.Util.GUI, module Raylib.Types.Util.RLGL, - ) where + ) +where import Raylib.Types.Core import Raylib.Types.Core.Audio @@ -52,5 +56,3 @@ import Raylib.Types.Core.Text import Raylib.Types.Core.Textures import Raylib.Types.Util.GUI import Raylib.Types.Util.RLGL - --- TODO: Add pointer advancing functions (p'field) for all records diff --git a/src/Raylib/Types/Core.hs b/src/Raylib/Types/Core.hs index 3315784..652029e 100644 --- a/src/Raylib/Types/Core.hs +++ b/src/Raylib/Types/Core.hs @@ -18,8 +18,8 @@ module Raylib.Types.Core Vector2 (..), Vector3 (..), Vector4 (..), - Matrix (..), vectorToColor, + Matrix (..), Color (..), Rectangle (..), VrDeviceInfo (..), @@ -30,6 +30,67 @@ module Raylib.Types.Core Quaternion, AutomationEventListRef, + -- * Pointer utilities + p'vector2'x, + p'vector2'y, + p'vector3'x, + p'vector3'y, + p'vector3'z, + p'vector4'x, + p'vector4'y, + p'vector4'z, + p'vector4'w, + p'matrix'm0, + p'matrix'm4, + p'matrix'm8, + p'matrix'm12, + p'matrix'm1, + p'matrix'm5, + p'matrix'm9, + p'matrix'm13, + p'matrix'm2, + p'matrix'm6, + p'matrix'm10, + p'matrix'm14, + p'matrix'm3, + p'matrix'm7, + p'matrix'm11, + p'matrix'm15, + p'color'r, + p'color'g, + p'color'b, + p'color'a, + p'rectangle'x, + p'rectangle'y, + p'rectangle'width, + p'rectangle'height, + p'vrDeviceInfo'hResolution, + p'vrDeviceInfo'vResolution, + p'vrDeviceInfo'hScreenSize, + p'vrDeviceInfo'vScreenSize, + p'vrDeviceInfo'eyeToScreenDistance, + p'vrDeviceInfo'lensSeparationDistance, + p'vrDeviceInfo'interpupillaryDistance, + p'vrDeviceInfo'lensDistortionValues, + p'vrDeviceInfo'chromaAbCorrection, + p'vrStereoConfig'projection, + p'vrStereoConfig'viewOffset, + p'vrStereoConfig'leftLensCenter, + p'vrStereoConfig'rightLensCenter, + p'vrStereoConfig'leftScreenCenter, + p'vrStereoConfig'rightScreenCenter, + p'vrStereoConfig'scale, + p'vrStereoConfig'scaleIn, + p'filePathList'capacity, + p'filePathList'count, + p'filePathList'paths, + p'automationEvent'frame, + p'automationEvent'type, + p'automationEvent'params, + p'automationEventList'capacity, + p'automationEventList'count, + p'automationEventList'events, + -- * Callbacks LoadFileDataCallback, SaveFileDataCallback, @@ -45,12 +106,12 @@ where import Foreign ( FunPtr, Ptr, - Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + Storable (alignment, peek, poke, sizeOf), Word8, - callocBytes, castPtr, newArray, peekArray, + plusPtr, callocArray, pokeArray, ) import Foreign.C ( CFloat, @@ -61,7 +122,7 @@ import Foreign.C newCString, peekCString, ) -import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArrayOff, pokeStaticArrayOff) +import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArray, pokeStaticArray) --------------------------------------- -- core enums ------------------------- @@ -587,14 +648,20 @@ instance Storable Vector2 where sizeOf _ = 8 alignment _ = 4 peek _p = do - x <- realToFrac <$> (peekByteOff _p 0 :: IO CFloat) - y <- realToFrac <$> (peekByteOff _p 4 :: IO CFloat) + x <- realToFrac <$> peek (p'vector2'x _p) + y <- realToFrac <$> peek (p'vector2'y _p) return $ Vector2 x y poke _p (Vector2 x y) = do - pokeByteOff _p 0 (realToFrac x :: CFloat) - pokeByteOff _p 4 (realToFrac y :: CFloat) + poke (p'vector2'x _p) (realToFrac x) + poke (p'vector2'y _p) (realToFrac y) return () +p'vector2'x :: Ptr Vector2 -> Ptr CFloat +p'vector2'x = (`plusPtr` 0) + +p'vector2'y :: Ptr Vector2 -> Ptr CFloat +p'vector2'y = (`plusPtr` 4) + data Vector3 = Vector3 { vector3'x :: Float, vector3'y :: Float, @@ -606,16 +673,25 @@ instance Storable Vector3 where sizeOf _ = 12 alignment _ = 4 peek _p = do - x <- realToFrac <$> (peekByteOff _p 0 :: IO CFloat) - y <- realToFrac <$> (peekByteOff _p 4 :: IO CFloat) - z <- realToFrac <$> (peekByteOff _p 8 :: IO CFloat) + x <- realToFrac <$> peek (p'vector3'x _p) + y <- realToFrac <$> peek (p'vector3'y _p) + z <- realToFrac <$> peek (p'vector3'z _p) return $ Vector3 x y z poke _p (Vector3 x y z) = do - pokeByteOff _p 0 (realToFrac x :: CFloat) - pokeByteOff _p 4 (realToFrac y :: CFloat) - pokeByteOff _p 8 (realToFrac z :: CFloat) + poke (p'vector3'x _p) (realToFrac x) + poke (p'vector3'y _p) (realToFrac y) + poke (p'vector3'z _p) (realToFrac z) return () +p'vector3'x :: Ptr Vector3 -> Ptr CFloat +p'vector3'x = (`plusPtr` 0) + +p'vector3'y :: Ptr Vector3 -> Ptr CFloat +p'vector3'y = (`plusPtr` 4) + +p'vector3'z :: Ptr Vector3 -> Ptr CFloat +p'vector3'z = (`plusPtr` 8) + data Vector4 = Vector4 { vector4'x :: Float, vector4'y :: Float, @@ -628,18 +704,33 @@ instance Storable Vector4 where sizeOf _ = 16 alignment _ = 4 peek _p = do - x <- realToFrac <$> (peekByteOff _p 0 :: IO CFloat) - y <- realToFrac <$> (peekByteOff _p 4 :: IO CFloat) - z <- realToFrac <$> (peekByteOff _p 8 :: IO CFloat) - w <- realToFrac <$> (peekByteOff _p 12 :: IO CFloat) + x <- realToFrac <$> peek (p'vector4'x _p) + y <- realToFrac <$> peek (p'vector4'y _p) + z <- realToFrac <$> peek (p'vector4'z _p) + w <- realToFrac <$> peek (p'vector4'w _p) return $ Vector4 x y z w poke _p (Vector4 x y z w) = do - pokeByteOff _p 0 (realToFrac x :: CFloat) - pokeByteOff _p 4 (realToFrac y :: CFloat) - pokeByteOff _p 8 (realToFrac z :: CFloat) - pokeByteOff _p 12 (realToFrac w :: CFloat) + poke (p'vector4'x _p) (realToFrac x) + poke (p'vector4'y _p) (realToFrac y) + poke (p'vector4'z _p) (realToFrac z) + poke (p'vector4'w _p) (realToFrac w) return () +vectorToColor :: Vector4 -> Color +vectorToColor (Vector4 x y z w) = Color (round $ x * 255) (round $ y * 255) (round $ z * 255) (round $ w * 255) + +p'vector4'x :: Ptr Vector4 -> Ptr CFloat +p'vector4'x = (`plusPtr` 0) + +p'vector4'y :: Ptr Vector4 -> Ptr CFloat +p'vector4'y = (`plusPtr` 4) + +p'vector4'z :: Ptr Vector4 -> Ptr CFloat +p'vector4'z = (`plusPtr` 8) + +p'vector4'w :: Ptr Vector4 -> Ptr CFloat +p'vector4'w = (`plusPtr` 12) + type Quaternion = Vector4 data Matrix = Matrix @@ -666,44 +757,89 @@ instance Storable Matrix where sizeOf _ = 64 alignment _ = 4 peek _p = do - m0 <- realToFrac <$> (peekByteOff _p 0 :: IO CFloat) - m4 <- realToFrac <$> (peekByteOff _p 4 :: IO CFloat) - m8 <- realToFrac <$> (peekByteOff _p 8 :: IO CFloat) - m12 <- realToFrac <$> (peekByteOff _p 12 :: IO CFloat) - m1 <- realToFrac <$> (peekByteOff _p 16 :: IO CFloat) - m5 <- realToFrac <$> (peekByteOff _p 20 :: IO CFloat) - m9 <- realToFrac <$> (peekByteOff _p 24 :: IO CFloat) - m13 <- realToFrac <$> (peekByteOff _p 28 :: IO CFloat) - m2 <- realToFrac <$> (peekByteOff _p 32 :: IO CFloat) - m6 <- realToFrac <$> (peekByteOff _p 36 :: IO CFloat) - m10 <- realToFrac <$> (peekByteOff _p 40 :: IO CFloat) - m14 <- realToFrac <$> (peekByteOff _p 44 :: IO CFloat) - m3 <- realToFrac <$> (peekByteOff _p 48 :: IO CFloat) - m7 <- realToFrac <$> (peekByteOff _p 52 :: IO CFloat) - m11 <- realToFrac <$> (peekByteOff _p 56 :: IO CFloat) - m15 <- realToFrac <$> (peekByteOff _p 60 :: IO CFloat) + m0 <- realToFrac <$> peek (p'matrix'm0 _p) + m4 <- realToFrac <$> peek (p'matrix'm4 _p) + m8 <- realToFrac <$> peek (p'matrix'm8 _p) + m12 <- realToFrac <$> peek (p'matrix'm12 _p) + m1 <- realToFrac <$> peek (p'matrix'm1 _p) + m5 <- realToFrac <$> peek (p'matrix'm5 _p) + m9 <- realToFrac <$> peek (p'matrix'm9 _p) + m13 <- realToFrac <$> peek (p'matrix'm13 _p) + m2 <- realToFrac <$> peek (p'matrix'm2 _p) + m6 <- realToFrac <$> peek (p'matrix'm6 _p) + m10 <- realToFrac <$> peek (p'matrix'm10 _p) + m14 <- realToFrac <$> peek (p'matrix'm14 _p) + m3 <- realToFrac <$> peek (p'matrix'm3 _p) + m7 <- realToFrac <$> peek (p'matrix'm7 _p) + m11 <- realToFrac <$> peek (p'matrix'm11 _p) + m15 <- realToFrac <$> peek (p'matrix'm15 _p) return $ Matrix m0 m4 m8 m12 m1 m5 m9 m13 m2 m6 m10 m14 m3 m7 m11 m15 poke _p (Matrix m0 m4 m8 m12 m1 m5 m9 m13 m2 m6 m10 m14 m3 m7 m11 m15) = do - pokeByteOff _p 0 (realToFrac m0 :: CFloat) - pokeByteOff _p 4 (realToFrac m4 :: CFloat) - pokeByteOff _p 8 (realToFrac m8 :: CFloat) - pokeByteOff _p 12 (realToFrac m12 :: CFloat) - pokeByteOff _p 16 (realToFrac m1 :: CFloat) - pokeByteOff _p 20 (realToFrac m5 :: CFloat) - pokeByteOff _p 24 (realToFrac m9 :: CFloat) - pokeByteOff _p 28 (realToFrac m13 :: CFloat) - pokeByteOff _p 32 (realToFrac m2 :: CFloat) - pokeByteOff _p 36 (realToFrac m6 :: CFloat) - pokeByteOff _p 40 (realToFrac m10 :: CFloat) - pokeByteOff _p 44 (realToFrac m14 :: CFloat) - pokeByteOff _p 48 (realToFrac m3 :: CFloat) - pokeByteOff _p 52 (realToFrac m7 :: CFloat) - pokeByteOff _p 56 (realToFrac m11 :: CFloat) - pokeByteOff _p 60 (realToFrac m15 :: CFloat) + poke (p'matrix'm0 _p) (realToFrac m0) + poke (p'matrix'm4 _p) (realToFrac m4) + poke (p'matrix'm8 _p) (realToFrac m8) + poke (p'matrix'm12 _p) (realToFrac m12) + poke (p'matrix'm1 _p) (realToFrac m1) + poke (p'matrix'm5 _p) (realToFrac m5) + poke (p'matrix'm9 _p) (realToFrac m9) + poke (p'matrix'm13 _p) (realToFrac m13) + poke (p'matrix'm2 _p) (realToFrac m2) + poke (p'matrix'm6 _p) (realToFrac m6) + poke (p'matrix'm10 _p) (realToFrac m10) + poke (p'matrix'm14 _p) (realToFrac m14) + poke (p'matrix'm3 _p) (realToFrac m3) + poke (p'matrix'm7 _p) (realToFrac m7) + poke (p'matrix'm11 _p) (realToFrac m11) + poke (p'matrix'm15 _p) (realToFrac m15) return () -vectorToColor :: Vector4 -> Color -vectorToColor (Vector4 x y z w) = Color (round $ x * 255) (round $ y * 255) (round $ z * 255) (round $ w * 255) +p'matrix'm0 :: Ptr Matrix -> Ptr CFloat +p'matrix'm0 = (`plusPtr` 0) + +p'matrix'm4 :: Ptr Matrix -> Ptr CFloat +p'matrix'm4 = (`plusPtr` 4) + +p'matrix'm8 :: Ptr Matrix -> Ptr CFloat +p'matrix'm8 = (`plusPtr` 8) + +p'matrix'm12 :: Ptr Matrix -> Ptr CFloat +p'matrix'm12 = (`plusPtr` 12) + +p'matrix'm1 :: Ptr Matrix -> Ptr CFloat +p'matrix'm1 = (`plusPtr` 16) + +p'matrix'm5 :: Ptr Matrix -> Ptr CFloat +p'matrix'm5 = (`plusPtr` 20) + +p'matrix'm9 :: Ptr Matrix -> Ptr CFloat +p'matrix'm9 = (`plusPtr` 24) + +p'matrix'm13 :: Ptr Matrix -> Ptr CFloat +p'matrix'm13 = (`plusPtr` 28) + +p'matrix'm2 :: Ptr Matrix -> Ptr CFloat +p'matrix'm2 = (`plusPtr` 32) + +p'matrix'm6 :: Ptr Matrix -> Ptr CFloat +p'matrix'm6 = (`plusPtr` 36) + +p'matrix'm10 :: Ptr Matrix -> Ptr CFloat +p'matrix'm10 = (`plusPtr` 40) + +p'matrix'm14 :: Ptr Matrix -> Ptr CFloat +p'matrix'm14 = (`plusPtr` 44) + +p'matrix'm3 :: Ptr Matrix -> Ptr CFloat +p'matrix'm3 = (`plusPtr` 48) + +p'matrix'm7 :: Ptr Matrix -> Ptr CFloat +p'matrix'm7 = (`plusPtr` 52) + +p'matrix'm11 :: Ptr Matrix -> Ptr CFloat +p'matrix'm11 = (`plusPtr` 56) + +p'matrix'm15 :: Ptr Matrix -> Ptr CFloat +p'matrix'm15 = (`plusPtr` 60) data Color = Color { color'r :: Word8, @@ -717,18 +853,30 @@ instance Storable Color where sizeOf _ = 4 alignment _ = 1 peek _p = do - r <- fromIntegral <$> (peekByteOff _p 0 :: IO CUChar) - g <- fromIntegral <$> (peekByteOff _p 1 :: IO CUChar) - b <- fromIntegral <$> (peekByteOff _p 2 :: IO CUChar) - a <- fromIntegral <$> (peekByteOff _p 3 :: IO CUChar) + r <- fromIntegral <$> peek (p'color'r _p) + g <- fromIntegral <$> peek (p'color'g _p) + b <- fromIntegral <$> peek (p'color'b _p) + a <- fromIntegral <$> peek (p'color'a _p) return $ Color r g b a poke _p (Color r g b a) = do - pokeByteOff _p 0 (fromIntegral r :: CUChar) - pokeByteOff _p 1 (fromIntegral g :: CUChar) - pokeByteOff _p 2 (fromIntegral b :: CUChar) - pokeByteOff _p 3 (fromIntegral a :: CUChar) + poke (p'color'r _p) (fromIntegral r) + poke (p'color'g _p) (fromIntegral g) + poke (p'color'b _p) (fromIntegral b) + poke (p'color'a _p) (fromIntegral a) return () +p'color'r :: Ptr Color -> Ptr CUChar +p'color'r = (`plusPtr` 0) + +p'color'g :: Ptr Color -> Ptr CUChar +p'color'g = (`plusPtr` 1) + +p'color'b :: Ptr Color -> Ptr CUChar +p'color'b = (`plusPtr` 2) + +p'color'a :: Ptr Color -> Ptr CUChar +p'color'a = (`plusPtr` 3) + data Rectangle = Rectangle { rectangle'x :: Float, rectangle'y :: Float, @@ -741,18 +889,30 @@ instance Storable Rectangle where sizeOf _ = 16 alignment _ = 4 peek _p = do - x <- realToFrac <$> (peekByteOff _p 0 :: IO CFloat) - y <- realToFrac <$> (peekByteOff _p 4 :: IO CFloat) - width <- realToFrac <$> (peekByteOff _p 8 :: IO CFloat) - height <- realToFrac <$> (peekByteOff _p 12 :: IO CFloat) + x <- realToFrac <$> peek (p'rectangle'x _p) + y <- realToFrac <$> peek (p'rectangle'y _p) + width <- realToFrac <$> peek (p'rectangle'width _p) + height <- realToFrac <$> peek (p'rectangle'height _p) return $ Rectangle x y width height poke _p (Rectangle x y width height) = do - pokeByteOff _p 0 (realToFrac x :: CFloat) - pokeByteOff _p 4 (realToFrac y :: CFloat) - pokeByteOff _p 8 (realToFrac width :: CFloat) - pokeByteOff _p 12 (realToFrac height :: CFloat) + poke (p'rectangle'x _p) (realToFrac x) + poke (p'rectangle'y _p) (realToFrac y) + poke (p'rectangle'width _p) (realToFrac width) + poke (p'rectangle'height _p) (realToFrac height) return () +p'rectangle'x :: Ptr Rectangle -> Ptr CFloat +p'rectangle'x = (`plusPtr` 0) + +p'rectangle'y :: Ptr Rectangle -> Ptr CFloat +p'rectangle'y = (`plusPtr` 4) + +p'rectangle'width :: Ptr Rectangle -> Ptr CFloat +p'rectangle'width = (`plusPtr` 8) + +p'rectangle'height :: Ptr Rectangle -> Ptr CFloat +p'rectangle'height = (`plusPtr` 12) + data VrDeviceInfo = VrDeviceInfo { vrDeviceInfo'hResolution :: Int, vrDeviceInfo'vResolution :: Int, @@ -770,28 +930,57 @@ instance Storable VrDeviceInfo where sizeOf _ = 60 alignment _ = 4 peek _p = do - hResolution <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - vResolution <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - hScreenSize <- realToFrac <$> (peekByteOff _p 8 :: IO CFloat) - vScreenSize <- realToFrac <$> (peekByteOff _p 12 :: IO CFloat) - eyeToScreenDistance <- realToFrac <$> (peekByteOff _p 16 :: IO CFloat) - lensSeparationDistance <- realToFrac <$> (peekByteOff _p 20 :: IO CFloat) - interpupillaryDistance <- realToFrac <$> (peekByteOff _p 24 :: IO CFloat) - lensDistortionValues <- map realToFrac <$> (peekStaticArrayOff 4 (castPtr _p) 28 :: IO [CFloat]) - chromaAbCorrection <- map realToFrac <$> (peekStaticArrayOff 4 (castPtr _p) 44 :: IO [CFloat]) + hResolution <- fromIntegral <$> peek (p'vrDeviceInfo'hResolution _p) + vResolution <- fromIntegral <$> peek (p'vrDeviceInfo'vResolution _p) + hScreenSize <- realToFrac <$> peek (p'vrDeviceInfo'hScreenSize _p) + vScreenSize <- realToFrac <$> peek (p'vrDeviceInfo'vScreenSize _p) + eyeToScreenDistance <- realToFrac <$> peek (p'vrDeviceInfo'eyeToScreenDistance _p) + lensSeparationDistance <- realToFrac <$> peek (p'vrDeviceInfo'lensSeparationDistance _p) + interpupillaryDistance <- realToFrac <$> peek (p'vrDeviceInfo'interpupillaryDistance _p) + lensDistortionValues <- map realToFrac <$> peekStaticArray 4 (p'vrDeviceInfo'lensDistortionValues _p) + chromaAbCorrection <- map realToFrac <$> peekStaticArray 4 (p'vrDeviceInfo'chromaAbCorrection _p) return $ VrDeviceInfo hResolution vResolution hScreenSize vScreenSize eyeToScreenDistance lensSeparationDistance interpupillaryDistance lensDistortionValues chromaAbCorrection poke _p (VrDeviceInfo hResolution vResolution hScreenSize vScreenSize eyeToScreenDistance lensSeparationDistance interpupillaryDistance lensDistortionValues chromaAbCorrection) = do - pokeByteOff _p 0 (fromIntegral hResolution :: CInt) - pokeByteOff _p 4 (fromIntegral vResolution :: CInt) - pokeByteOff _p 8 (realToFrac hScreenSize :: CFloat) - pokeByteOff _p 12 (realToFrac vScreenSize :: CFloat) - pokeByteOff _p 16 (realToFrac eyeToScreenDistance :: CFloat) - pokeByteOff _p 20 (realToFrac lensSeparationDistance :: CFloat) - pokeByteOff _p 24 (realToFrac interpupillaryDistance :: CFloat) - pokeStaticArrayOff (castPtr _p) 28 (map realToFrac lensDistortionValues :: [CFloat]) - pokeStaticArrayOff (castPtr _p) 44 (map realToFrac chromaAbCorrection :: [CFloat]) + poke (p'vrDeviceInfo'hResolution _p) (fromIntegral hResolution) + poke (p'vrDeviceInfo'vResolution _p) (fromIntegral vResolution) + poke (p'vrDeviceInfo'hScreenSize _p) (realToFrac hScreenSize) + poke (p'vrDeviceInfo'vScreenSize _p) (realToFrac vScreenSize) + poke (p'vrDeviceInfo'eyeToScreenDistance _p) (realToFrac eyeToScreenDistance) + poke (p'vrDeviceInfo'lensSeparationDistance _p) (realToFrac lensSeparationDistance) + poke (p'vrDeviceInfo'interpupillaryDistance _p) (realToFrac interpupillaryDistance) + pokeStaticArray (p'vrDeviceInfo'lensDistortionValues _p) (map realToFrac lensDistortionValues) + pokeStaticArray (p'vrDeviceInfo'chromaAbCorrection _p) (map realToFrac chromaAbCorrection) return () +p'vrDeviceInfo'hResolution :: Ptr VrDeviceInfo -> Ptr CInt +p'vrDeviceInfo'hResolution = (`plusPtr` 0) + +p'vrDeviceInfo'vResolution :: Ptr VrDeviceInfo -> Ptr CInt +p'vrDeviceInfo'vResolution = (`plusPtr` 4) + +p'vrDeviceInfo'hScreenSize :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'hScreenSize = (`plusPtr` 8) + +p'vrDeviceInfo'vScreenSize :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'vScreenSize = (`plusPtr` 12) + +p'vrDeviceInfo'eyeToScreenDistance :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'eyeToScreenDistance = (`plusPtr` 16) + +p'vrDeviceInfo'lensSeparationDistance :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'lensSeparationDistance = (`plusPtr` 20) + +p'vrDeviceInfo'interpupillaryDistance :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'interpupillaryDistance = (`plusPtr` 24) + +-- static array (4) +p'vrDeviceInfo'lensDistortionValues :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'lensDistortionValues = (`plusPtr` 28) + +-- static array (4) +p'vrDeviceInfo'chromaAbCorrection :: Ptr VrDeviceInfo -> Ptr CFloat +p'vrDeviceInfo'chromaAbCorrection = (`plusPtr` 44) + data VrStereoConfig = VrStereoConfig { vrStereoConfig'projection :: [Matrix], vrStereoConfig'viewOffset :: [Matrix], @@ -808,26 +997,58 @@ instance Storable VrStereoConfig where sizeOf _ = 304 alignment _ = 4 peek _p = do - projection <- peekStaticArrayOff 2 (castPtr _p) 0 - viewOffset <- peekStaticArrayOff 2 (castPtr _p) 128 - leftLensCenter <- map realToFrac <$> (peekStaticArrayOff 2 (castPtr _p) 256 :: IO [CFloat]) - rightLensCenter <- map realToFrac <$> (peekStaticArrayOff 2 (castPtr _p) 264 :: IO [CFloat]) - leftScreenCenter <- map realToFrac <$> (peekStaticArrayOff 2 (castPtr _p) 272 :: IO [CFloat]) - rightScreenCenter <- map realToFrac <$> (peekStaticArrayOff 2 (castPtr _p) 280 :: IO [CFloat]) - scale <- map realToFrac <$> (peekStaticArrayOff 2 (castPtr _p) 288 :: IO [CFloat]) - scaleIn <- map realToFrac <$> (peekStaticArrayOff 2 (castPtr _p) 296 :: IO [CFloat]) + projection <- peekStaticArray 2 (p'vrStereoConfig'projection _p) + viewOffset <- peekStaticArray 2 (p'vrStereoConfig'viewOffset _p) + leftLensCenter <- map realToFrac <$> peekStaticArray 2 (p'vrStereoConfig'leftLensCenter _p) + rightLensCenter <- map realToFrac <$> peekStaticArray 2 (p'vrStereoConfig'rightLensCenter _p) + leftScreenCenter <- map realToFrac <$> peekStaticArray 2 (p'vrStereoConfig'leftScreenCenter _p) + rightScreenCenter <- map realToFrac <$> peekStaticArray 2 (p'vrStereoConfig'rightScreenCenter _p) + scale <- map realToFrac <$> peekStaticArray 2 (p'vrStereoConfig'scale _p) + scaleIn <- map realToFrac <$> peekStaticArray 2 (p'vrStereoConfig'scaleIn _p) return $ VrStereoConfig projection viewOffset leftLensCenter rightLensCenter leftScreenCenter rightScreenCenter scale scaleIn poke _p (VrStereoConfig projection viewOffset leftLensCenter rightLensCenter leftScreenCenter rightScreenCenter scale scaleIn) = do - pokeStaticArrayOff (castPtr _p) 0 projection - pokeStaticArrayOff (castPtr _p) 128 viewOffset - pokeStaticArrayOff (castPtr _p) 256 (map realToFrac leftLensCenter :: [CFloat]) - pokeStaticArrayOff (castPtr _p) 264 (map realToFrac rightLensCenter :: [CFloat]) - pokeStaticArrayOff (castPtr _p) 272 (map realToFrac leftScreenCenter :: [CFloat]) - pokeStaticArrayOff (castPtr _p) 280 (map realToFrac rightScreenCenter :: [CFloat]) - pokeStaticArrayOff (castPtr _p) 288 (map realToFrac scale :: [CFloat]) - pokeStaticArrayOff (castPtr _p) 296 (map realToFrac scaleIn :: [CFloat]) + pokeStaticArray (p'vrStereoConfig'projection _p) projection + pokeStaticArray (p'vrStereoConfig'viewOffset _p) viewOffset + pokeStaticArray (p'vrStereoConfig'leftLensCenter _p) (map realToFrac leftLensCenter) + pokeStaticArray (p'vrStereoConfig'rightLensCenter _p) (map realToFrac rightLensCenter) + pokeStaticArray (p'vrStereoConfig'leftScreenCenter _p) (map realToFrac leftScreenCenter) + pokeStaticArray (p'vrStereoConfig'rightScreenCenter _p) (map realToFrac rightScreenCenter) + pokeStaticArray (p'vrStereoConfig'scale _p) (map realToFrac scale) + pokeStaticArray (p'vrStereoConfig'scaleIn _p) (map realToFrac scaleIn) return () +-- static array (2) +p'vrStereoConfig'projection :: Ptr VrStereoConfig -> Ptr Matrix +p'vrStereoConfig'projection = (`plusPtr` 0) + +-- static array (2) +p'vrStereoConfig'viewOffset :: Ptr VrStereoConfig -> Ptr Matrix +p'vrStereoConfig'viewOffset = (`plusPtr` 128) + +-- static array (2) +p'vrStereoConfig'leftLensCenter :: Ptr VrStereoConfig -> Ptr CFloat +p'vrStereoConfig'leftLensCenter = (`plusPtr` 256) + +-- static array (2) +p'vrStereoConfig'rightLensCenter :: Ptr VrStereoConfig -> Ptr CFloat +p'vrStereoConfig'rightLensCenter = (`plusPtr` 264) + +-- static array (2) +p'vrStereoConfig'leftScreenCenter :: Ptr VrStereoConfig -> Ptr CFloat +p'vrStereoConfig'leftScreenCenter = (`plusPtr` 272) + +-- static array (2) +p'vrStereoConfig'rightScreenCenter :: Ptr VrStereoConfig -> Ptr CFloat +p'vrStereoConfig'rightScreenCenter = (`plusPtr` 280) + +-- static array (2) +p'vrStereoConfig'scale :: Ptr VrStereoConfig -> Ptr CFloat +p'vrStereoConfig'scale = (`plusPtr` 288) + +-- static array (2) +p'vrStereoConfig'scaleIn :: Ptr VrStereoConfig -> Ptr CFloat +p'vrStereoConfig'scaleIn = (`plusPtr` 296) + data FilePathList = FilePathList { filePathlist'capacity :: Integer, filePathList'paths :: [String] @@ -838,22 +1059,32 @@ instance Storable FilePathList where sizeOf _ = 16 alignment _ = 4 peek _p = do - capacity <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - count <- fromIntegral <$> (peekByteOff _p 4 :: IO CUInt) - pathsPtr <- (peekByteOff _p 8 :: IO (Ptr CString)) + capacity <- fromIntegral <$> peek (p'filePathList'capacity _p) + count <- fromIntegral <$> peek (p'filePathList'count _p) + pathsPtr <- peek (p'filePathList'paths _p) pathsCStrings <- peekArray count pathsPtr paths <- mapM peekCString pathsCStrings return $ FilePathList capacity paths poke _p (FilePathList capacity paths) = do - pokeByteOff _p 0 (fromIntegral capacity :: CUInt) - pokeByteOff _p 4 (fromIntegral (length paths) :: CUInt) + poke (p'filePathList'capacity _p) (fromIntegral capacity) + poke (p'filePathList'count _p) (fromIntegral (length paths)) pathsCStrings <- mapM newCString paths - pokeByteOff _p 8 =<< newArray pathsCStrings + poke (p'filePathList'paths _p) =<< newArray pathsCStrings return () +p'filePathList'capacity :: Ptr FilePathList -> Ptr CUInt +p'filePathList'capacity = (`plusPtr` 0) + +p'filePathList'count :: Ptr FilePathList -> Ptr CUInt +p'filePathList'count = (`plusPtr` 4) + +-- array (filePathList'count) +p'filePathList'paths :: Ptr FilePathList -> Ptr (Ptr CString) +p'filePathList'paths = (`plusPtr` 8) + instance Freeable FilePathList where rlFreeDependents val ptr = do - pathsPtr <- (peekByteOff ptr 8 :: IO (Ptr CString)) + pathsPtr <- peek (p'filePathList'paths ptr) pathsCStrings <- peekArray (length $ filePathList'paths val) pathsPtr mapM_ (c'free . castPtr) pathsCStrings c'free $ castPtr pathsPtr @@ -869,16 +1100,26 @@ instance Storable AutomationEvent where sizeOf _ = 24 alignment _ = 4 peek _p = do - frame <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - aeType <- fromIntegral <$> (peekByteOff _p 4 :: IO CUInt) - params <- map fromIntegral <$> peekStaticArrayOff 4 (castPtr _p :: Ptr CInt) 8 + frame <- fromIntegral <$> peek (p'automationEvent'frame _p) + aeType <- fromIntegral <$> peek (p'automationEvent'type _p) + params <- map fromIntegral <$> peekStaticArray 4 (p'automationEvent'params _p) return $ AutomationEvent frame aeType params poke _p (AutomationEvent frame aeType params) = do - pokeByteOff _p 0 (fromIntegral frame :: CUInt) - pokeByteOff _p 4 (fromIntegral aeType :: CUInt) - pokeStaticArrayOff (castPtr _p :: Ptr CInt) 8 (map fromIntegral params) + poke (p'automationEvent'frame _p) (fromIntegral frame) + poke (p'automationEvent'type _p) (fromIntegral aeType) + pokeStaticArray (p'automationEvent'params _p) (map fromIntegral params) return () +p'automationEvent'frame :: Ptr AutomationEvent -> Ptr CUInt +p'automationEvent'frame = (`plusPtr` 0) + +p'automationEvent'type :: Ptr AutomationEvent -> Ptr CUInt +p'automationEvent'type = (`plusPtr` 4) + +-- static array (4) +p'automationEvent'params :: Ptr AutomationEvent -> Ptr CInt +p'automationEvent'params = (`plusPtr` 8) + data AutomationEventList = AutomationEventList { automationEventList'capacity :: Integer, automationEventList'events :: [AutomationEvent] @@ -889,22 +1130,31 @@ instance Storable AutomationEventList where sizeOf _ = 16 alignment _ = 8 peek _p = do - capacity <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - count <- fromIntegral <$> (peekByteOff _p 4 :: IO CUInt) - eventsPtr <- (peekByteOff _p 8 :: IO (Ptr AutomationEvent)) - events <- peekArray count eventsPtr + capacity <- fromIntegral <$> peek (p'automationEventList'capacity _p) + count <- fromIntegral <$> peek (p'automationEventList'count _p) + events <- peekArray count =<< peek (p'automationEventList'events _p) return $ AutomationEventList capacity events poke _p (AutomationEventList capacity events) = do - pokeByteOff _p 0 (fromIntegral capacity :: CUInt) - pokeByteOff _p 4 (fromIntegral (length events) :: CUInt) - ptr <- callocBytes (fromIntegral capacity * sizeOf (undefined :: AutomationEvent)) - pokeByteOff _p 8 ptr + poke (p'automationEventList'capacity _p) (fromIntegral capacity) + poke (p'automationEventList'count _p) (fromIntegral (length events)) + eventsPtr <- callocArray (fromIntegral capacity) + pokeArray eventsPtr events + poke (p'automationEventList'events _p) eventsPtr return () +p'automationEventList'capacity :: Ptr AutomationEventList -> Ptr CUInt +p'automationEventList'capacity = (`plusPtr` 0) + +p'automationEventList'count :: Ptr AutomationEventList -> Ptr CUInt +p'automationEventList'count = (`plusPtr` 4) + +-- array (automationEventList'count) +p'automationEventList'events :: Ptr AutomationEventList -> Ptr (Ptr AutomationEvent) +p'automationEventList'events = (`plusPtr` 8) + instance Freeable AutomationEventList where rlFreeDependents _ ptr = do - eventsPtr <- (peekByteOff ptr 8 :: IO (Ptr AutomationEvent)) - c'free $ castPtr eventsPtr + c'free . castPtr =<< peek (p'automationEventList'events ptr) type AutomationEventListRef = Ptr AutomationEventList diff --git a/src/Raylib/Types/Core/Audio.hs b/src/Raylib/Types/Core/Audio.hs index 7020acd..37fe606 100644 --- a/src/Raylib/Types/Core/Audio.hs +++ b/src/Raylib/Types/Core/Audio.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DeriveAnyClass #-} + {-# OPTIONS -Wall #-} -- | Bindings for types used in @raudio@ module Raylib.Types.Core.Audio ( -- * Enumerations MusicContextType (..), + -- * Structures Wave (..), RAudioBuffer (..), @@ -12,16 +14,57 @@ module Raylib.Types.Core.Audio AudioStream (..), Sound (..), Music (..), + + -- * Pointer utilities + p'wave'frameCount, + p'wave'sampleRate, + p'wave'sampleSize, + p'wave'channels, + p'wave'data, + p'rAudioBuffer'converter, + p'rAudioBuffer'callback, + p'rAudioBuffer'processor, + p'rAudioBuffer'volume, + p'rAudioBuffer'pitch, + p'rAudioBuffer'pan, + p'rAudioBuffer'playing, + p'rAudioBuffer'paused, + p'rAudioBuffer'looping, + p'rAudioBuffer'usage, + p'rAudioBuffer'isSubBufferProcessed, + p'rAudioBuffer'sizeInFrames, + p'rAudioBuffer'frameCursorPos, + p'rAudioBuffer'framesProcessed, + p'rAudioBuffer'data, + p'rAudioBuffer'next, + p'rAudioBuffer'prev, + p'rAudioProcessor'process, + p'rAudioProcessor'next, + p'rAudioProcessor'prev, + p'audioStream'buffer, + p'audioStream'processor, + p'audioStream'sampleRate, + p'audioStream'sampleSize, + p'audioStream'channels, + p'sound'stream, + p'sound'frameCount, + p'music'stream, + p'music'frameCount, + p'music'looping, + p'music'ctxType, + p'music'ctxData, + -- * Callbacks AudioCallback, C'AudioCallback, ) where +import Data.Maybe (fromMaybe) import Foreign ( FunPtr, Ptr, - Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + Storable (alignment, peek, poke, sizeOf), Word8, castPtr, fromBool, @@ -30,6 +73,7 @@ import Foreign nullFunPtr, nullPtr, peekArray, + plusPtr, toBool, ) import Foreign.C @@ -40,7 +84,7 @@ import Foreign.C CUChar, CUInt, ) -import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArray, peekStaticArrayOff, pokeMaybeOff, pokeStaticArray, pokeStaticArrayOff) +import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekMaybe, peekStaticArray, pokeMaybe, pokeStaticArray) --------------------------------------- -- audio enums ------------------------ @@ -65,6 +109,19 @@ instance Storable MusicContextType where return $ toEnum $ fromEnum (val :: CInt) poke ptr v = poke (castPtr ptr) (fromIntegral (fromEnum v) :: CInt) +data AudioBufferUsage + = AudioBufferUsageStatic + | AudioBufferUsageStream + deriving (Eq, Show, Enum) + +instance Storable AudioBufferUsage where + sizeOf _ = 4 + alignment _ = 4 + peek ptr = do + val <- peek (castPtr ptr) + return $ toEnum $ fromEnum (val :: CInt) + poke ptr v = poke (castPtr ptr) (fromIntegral (fromEnum v) :: CInt) + --------------------------------------- -- audio structures ------------------- --------------------------------------- @@ -82,24 +139,40 @@ instance Storable Wave where sizeOf _ = 24 alignment _ = 4 peek _p = do - frameCount <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - sampleRate <- fromIntegral <$> (peekByteOff _p 4 :: IO CUInt) - sampleSize <- fromIntegral <$> (peekByteOff _p 8 :: IO CUInt) - channels <- fromIntegral <$> (peekByteOff _p 12 :: IO CUInt) - wDataPtr <- (peekByteOff _p 16 :: IO (Ptr CShort)) + frameCount <- fromIntegral <$> peek (p'wave'frameCount _p) + sampleRate <- fromIntegral <$> peek (p'wave'sampleRate _p) + sampleSize <- fromIntegral <$> peek (p'wave'sampleSize _p) + channels <- fromIntegral <$> peek (p'wave'channels _p) + wDataPtr <- peek (p'wave'data _p) wData <- map fromIntegral <$> peekArray (fromInteger $ frameCount * channels) wDataPtr return $ Wave frameCount sampleRate sampleSize channels wData poke _p (Wave frameCount sampleRate sampleSize channels wData) = do - pokeByteOff _p 0 (fromIntegral frameCount :: CUInt) - pokeByteOff _p 4 (fromIntegral sampleRate :: CUInt) - pokeByteOff _p 8 (fromIntegral sampleSize :: CUInt) - pokeByteOff _p 12 (fromIntegral channels :: CUInt) - pokeByteOff _p 16 =<< newArray (map fromIntegral wData :: [CShort]) + poke (p'wave'frameCount _p) (fromIntegral frameCount) + poke (p'wave'sampleRate _p) (fromIntegral sampleRate) + poke (p'wave'sampleSize _p) (fromIntegral sampleSize) + poke (p'wave'channels _p) (fromIntegral channels) + poke (p'wave'data _p) =<< newArray (map fromIntegral wData) return () +p'wave'frameCount :: Ptr Wave -> Ptr CUInt +p'wave'frameCount = (`plusPtr` 0) + +p'wave'sampleRate :: Ptr Wave -> Ptr CUInt +p'wave'sampleRate = (`plusPtr` 4) + +p'wave'sampleSize :: Ptr Wave -> Ptr CUInt +p'wave'sampleSize = (`plusPtr` 8) + +p'wave'channels :: Ptr Wave -> Ptr CUInt +p'wave'channels = (`plusPtr` 12) + +-- array (wave'frameCount * wave'channels) +p'wave'data :: Ptr Wave -> Ptr (Ptr CShort) +p'wave'data = (`plusPtr` 16) + instance Freeable Wave where rlFreeDependents _ ptr = do - dataPtr <- peekByteOff ptr 16 :: IO (Ptr CShort) + dataPtr <- peek (p'wave'data ptr) c'free $ castPtr dataPtr -- RAudioBuffer/Processor are bound weirdly. They are currently used as `Ptr`s @@ -110,8 +183,8 @@ instance Freeable Wave where -- The types defined here are actually unnecessary because the pointers are -- never dereferenced. data RAudioBuffer = RAudioBuffer - { rAudioBuffer'converter :: [Int], -- Implemented as an array of 39 integers because the entire `ma_data_converter` type is too complex - rAudioBuffer'callback :: C'AudioCallback, + { rAudioBuffer'converter :: [Int], -- Implemented as an array of 78 integers because the entire `ma_data_converter` type is too complex + rAudioBuffer'callback :: Maybe C'AudioCallback, rAudioBuffer'processor :: Maybe RAudioProcessor, rAudioBuffer'volume :: Float, rAudioBuffer'pitch :: Float, @@ -119,7 +192,7 @@ data RAudioBuffer = RAudioBuffer rAudioBuffer'playing :: Bool, rAudioBuffer'paused :: Bool, rAudioBuffer'looping :: Bool, - rAudioBuffer'usage :: Int, + rAudioBuffer'usage :: AudioBufferUsage, rAudioBuffer'isSubBufferProcessed :: [Bool], rAudioBuffer'sizeInFrames :: Integer, rAudioBuffer'frameCursorPos :: Integer, @@ -135,9 +208,9 @@ instance Storable RAudioBuffer where alignment _ = 8 peek _p = do base <- loadBase _p - nextPtr <- peekByteOff _p 376 + nextPtr <- peek (p'rAudioBuffer'next _p) next <- loadNext nextPtr - prevPtr <- peekByteOff _p 384 + prevPtr <- peek (p'rAudioBuffer'prev _p) prev <- loadPrev prevPtr return $ let p = @@ -148,26 +221,26 @@ instance Storable RAudioBuffer where where getBytesPerSample = ([0, 1, 2, 3, 4, 4] !!) loadBase ptr = do - converter <- map fromIntegral <$> (peekStaticArray 39 (castPtr ptr) :: IO [CInt]) - callback <- peekByteOff ptr 312 - pPtr <- peekByteOff ptr 320 :: IO (Ptr RAudioProcessor) - processor <- if pPtr == nullPtr then return Nothing else Just <$> peek pPtr + converter <- map fromIntegral <$> peekStaticArray 78 (castPtr (p'rAudioBuffer'converter ptr) :: Ptr CInt) + funPtr <- peek (p'rAudioBuffer'callback ptr) + let callback = if funPtr == nullFunPtr then Nothing else Just funPtr + processor <- peekMaybe (p'rAudioBuffer'processor ptr) - volume <- realToFrac <$> (peekByteOff ptr 328 :: IO CFloat) - pitch <- realToFrac <$> (peekByteOff ptr 332 :: IO CFloat) - pan <- realToFrac <$> (peekByteOff ptr 336 :: IO CFloat) + volume <- realToFrac <$> peek (p'rAudioBuffer'volume ptr) + pitch <- realToFrac <$> peek (p'rAudioBuffer'pitch ptr) + pan <- realToFrac <$> peek (p'rAudioBuffer'pan ptr) - playing <- toBool <$> (peekByteOff ptr 340 :: IO CBool) - paused <- toBool <$> (peekByteOff ptr 341 :: IO CBool) - looping <- toBool <$> (peekByteOff ptr 342 :: IO CBool) - usage <- fromIntegral <$> (peekByteOff ptr 344 :: IO CInt) + playing <- toBool <$> peek (p'rAudioBuffer'playing ptr) + paused <- toBool <$> peek (p'rAudioBuffer'paused ptr) + looping <- toBool <$> peek (p'rAudioBuffer'looping ptr) + usage <- peek (p'rAudioBuffer'usage ptr) - isSubBufferProcessed <- map toBool <$> peekStaticArrayOff 2 (castPtr ptr :: Ptr CBool) 348 - sizeInFrames <- fromIntegral <$> (peekByteOff ptr 352 :: IO CUInt) - frameCursorPos <- fromIntegral <$> (peekByteOff ptr 356 :: IO CUInt) - framesProcessed <- fromIntegral <$> (peekByteOff ptr 360 :: IO CUInt) + isSubBufferProcessed <- map toBool <$> peekStaticArray 2 (p'rAudioBuffer'isSubBufferProcessed ptr) + sizeInFrames <- fromIntegral <$> peek (p'rAudioBuffer'sizeInFrames ptr) + frameCursorPos <- fromIntegral <$> peek (p'rAudioBuffer'frameCursorPos ptr) + framesProcessed <- fromIntegral <$> peek (p'rAudioBuffer'framesProcessed ptr) - bData <- map fromIntegral <$> (peekArray (fromIntegral $ sizeInFrames * 2 * getBytesPerSample (head converter)) =<< (peekByteOff ptr 368 :: IO (Ptr CUChar))) + bData <- map fromIntegral <$> (peekArray (fromIntegral $ sizeInFrames * 2 * getBytesPerSample (head converter)) =<< peek (p'rAudioBuffer'data ptr)) return $ RAudioBuffer converter callback processor volume pitch pan playing paused looping usage isSubBufferProcessed sizeInFrames frameCursorPos framesProcessed bData loadNext ptr = @@ -175,7 +248,7 @@ instance Storable RAudioBuffer where then return Nothing else do base <- loadBase ptr - nextPtr <- peekByteOff ptr 376 + nextPtr <- peek (p'rAudioBuffer'next ptr) next <- loadNext nextPtr let p = base ((\a -> a {rAudioBuffer'prev = Just p}) <$> next) Nothing in return (Just p) @@ -185,7 +258,7 @@ instance Storable RAudioBuffer where then return Nothing else do base <- loadBase ptr - prevPtr <- peekByteOff ptr 384 + prevPtr <- peek (p'rAudioBuffer'prev ptr) prev <- loadPrev prevPtr let p = base Nothing ((\a -> a {rAudioBuffer'next = Just p}) <$> prev) in return (Just p) @@ -196,45 +269,103 @@ instance Storable RAudioBuffer where return () where pokeBase ptr (RAudioBuffer converter callback processor volume pitch pan playing paused looping usage isSubBufferProcessed sizeInFrames frameCursorPos framesProcessed bData _ _) = do - pokeStaticArray (castPtr ptr) (map fromIntegral converter :: [CInt]) - pokeByteOff ptr 312 callback - pokeMaybeOff (castPtr ptr) 320 processor + pokeStaticArray (castPtr (p'rAudioBuffer'converter ptr) :: Ptr CInt) (map fromIntegral converter) + poke (p'rAudioBuffer'callback ptr) (fromMaybe nullFunPtr callback) + pokeMaybe (p'rAudioBuffer'processor ptr) processor - pokeByteOff ptr 328 (realToFrac volume :: CFloat) - pokeByteOff ptr 332 (realToFrac pitch :: CFloat) - pokeByteOff ptr 336 (realToFrac pan :: CFloat) + poke (p'rAudioBuffer'volume ptr) (realToFrac volume) + poke (p'rAudioBuffer'pitch ptr) (realToFrac pitch) + poke (p'rAudioBuffer'pan ptr) (realToFrac pan) - pokeByteOff ptr 340 (fromBool playing :: CBool) - pokeByteOff ptr 341 (fromBool paused :: CBool) - pokeByteOff ptr 342 (fromBool looping :: CBool) - pokeByteOff ptr 344 (fromIntegral usage :: CInt) + poke (p'rAudioBuffer'playing ptr) (fromBool playing) + poke (p'rAudioBuffer'paused ptr) (fromBool paused) + poke (p'rAudioBuffer'looping ptr) (fromBool looping) + poke (p'rAudioBuffer'usage ptr) usage - pokeStaticArrayOff (castPtr ptr) 348 (map fromBool isSubBufferProcessed :: [CBool]) - pokeByteOff ptr 352 (fromIntegral sizeInFrames :: CUInt) - pokeByteOff ptr 356 (fromIntegral frameCursorPos :: CUInt) - pokeByteOff ptr 360 (fromIntegral framesProcessed :: CUInt) + pokeStaticArray (p'rAudioBuffer'isSubBufferProcessed ptr) (map fromBool isSubBufferProcessed) + poke (p'rAudioBuffer'sizeInFrames ptr) (fromIntegral sizeInFrames) + poke (p'rAudioBuffer'frameCursorPos ptr) (fromIntegral frameCursorPos) + poke (p'rAudioBuffer'framesProcessed ptr) (fromIntegral framesProcessed) - pokeByteOff ptr 368 =<< newArray (map fromIntegral bData :: [CUChar]) + poke (p'rAudioBuffer'data ptr) =<< newArray (map fromIntegral bData :: [CUChar]) return () pokeNext basePtr pNext = case pNext of - Nothing -> pokeByteOff basePtr 376 nullPtr + Nothing -> poke (p'rAudioBuffer'next basePtr) nullPtr Just val -> do nextPtr <- malloc pokeBase nextPtr val pokeNext nextPtr (rAudioBuffer'next val) - pokeByteOff nextPtr 384 basePtr - pokeByteOff basePtr 376 nextPtr + poke (p'rAudioBuffer'prev nextPtr) basePtr + poke (p'rAudioBuffer'next basePtr) nextPtr pokePrev basePtr pPrev = case pPrev of - Nothing -> pokeByteOff basePtr 384 nullPtr + Nothing -> poke (p'rAudioBuffer'prev basePtr) nullPtr Just val -> do prevPtr <- malloc pokeBase prevPtr val - pokeByteOff prevPtr 376 basePtr + poke (p'rAudioBuffer'next prevPtr) basePtr pokePrev prevPtr (rAudioBuffer'prev val) - pokeByteOff basePtr 384 prevPtr + poke (p'rAudioBuffer'prev basePtr) prevPtr + +-- bytes (312) +p'rAudioBuffer'converter :: Ptr RAudioBuffer -> Ptr () +p'rAudioBuffer'converter = (`plusPtr` 0) + +-- maybe funptr +p'rAudioBuffer'callback :: Ptr RAudioBuffer -> Ptr C'AudioCallback +p'rAudioBuffer'callback = (`plusPtr` 312) + +-- maybe +p'rAudioBuffer'processor :: Ptr RAudioBuffer -> Ptr (Ptr RAudioProcessor) +p'rAudioBuffer'processor = (`plusPtr` 320) + +p'rAudioBuffer'volume :: Ptr RAudioBuffer -> Ptr CFloat +p'rAudioBuffer'volume = (`plusPtr` 328) + +p'rAudioBuffer'pitch :: Ptr RAudioBuffer -> Ptr CFloat +p'rAudioBuffer'pitch = (`plusPtr` 332) + +p'rAudioBuffer'pan :: Ptr RAudioBuffer -> Ptr CFloat +p'rAudioBuffer'pan = (`plusPtr` 336) + +p'rAudioBuffer'playing :: Ptr RAudioBuffer -> Ptr CBool +p'rAudioBuffer'playing = (`plusPtr` 340) + +p'rAudioBuffer'paused :: Ptr RAudioBuffer -> Ptr CBool +p'rAudioBuffer'paused = (`plusPtr` 341) + +p'rAudioBuffer'looping :: Ptr RAudioBuffer -> Ptr CBool +p'rAudioBuffer'looping = (`plusPtr` 342) + +p'rAudioBuffer'usage :: Ptr RAudioBuffer -> Ptr AudioBufferUsage +p'rAudioBuffer'usage = (`plusPtr` 344) + +-- static array (2) +p'rAudioBuffer'isSubBufferProcessed :: Ptr RAudioBuffer -> Ptr CBool +p'rAudioBuffer'isSubBufferProcessed = (`plusPtr` 348) + +p'rAudioBuffer'sizeInFrames :: Ptr RAudioBuffer -> Ptr CUInt +p'rAudioBuffer'sizeInFrames = (`plusPtr` 352) + +p'rAudioBuffer'frameCursorPos :: Ptr RAudioBuffer -> Ptr CUInt +p'rAudioBuffer'frameCursorPos = (`plusPtr` 356) + +p'rAudioBuffer'framesProcessed :: Ptr RAudioBuffer -> Ptr CUInt +p'rAudioBuffer'framesProcessed = (`plusPtr` 360) + +-- array (rAudioBuffer'sizeInFrames * 2 * ([0, 1, 2, 3, 4, 4] !! (peek (rAudioBuffer'converter :: Ptr CInt)))) +p'rAudioBuffer'data :: Ptr RAudioBuffer -> Ptr (Ptr CUChar) +p'rAudioBuffer'data = (`plusPtr` 368) + +-- maybe +p'rAudioBuffer'next :: Ptr RAudioBuffer -> Ptr (Ptr RAudioBuffer) +p'rAudioBuffer'next = (`plusPtr` 376) + +-- maybe +p'rAudioBuffer'prev :: Ptr RAudioBuffer -> Ptr (Ptr RAudioBuffer) +p'rAudioBuffer'prev = (`plusPtr` 384) data RAudioProcessor = RAudioProcessor { rAudioProcessor'process :: Maybe C'AudioCallback, @@ -248,21 +379,21 @@ instance Storable RAudioProcessor where alignment _ = 8 peek _p = do process <- loadProcess _p - nextPtr <- peekByteOff _p 8 + nextPtr <- peek (p'rAudioProcessor'next _p) next <- loadNext nextPtr - prevPtr <- peekByteOff _p 16 + prevPtr <- peek (p'rAudioProcessor'prev _p) prev <- loadPrev prevPtr return $ let p = RAudioProcessor process ((\a -> a {rAudioProcessor'prev = Just p}) <$> next) ((\a -> a {rAudioProcessor'next = Just p}) <$> prev) in p where loadProcess ptr = do - funPtr <- peekByteOff ptr 0 + funPtr <- peek (p'rAudioProcessor'process ptr) if funPtr == nullFunPtr then return Nothing else return (Just funPtr) loadNext ptr = if ptr == nullPtr then return Nothing else do process <- loadProcess ptr - nextPtr <- peekByteOff ptr 8 + nextPtr <- peek (p'rAudioProcessor'next ptr) next <- loadNext nextPtr let p = RAudioProcessor process ((\a -> a {rAudioProcessor'prev = Just p}) <$> next) Nothing in return (Just p) @@ -272,41 +403,53 @@ instance Storable RAudioProcessor where then return Nothing else do process <- loadProcess ptr - prevPtr <- peekByteOff ptr 16 + prevPtr <- peek (p'rAudioProcessor'prev ptr) prev <- loadPrev prevPtr let p = RAudioProcessor process Nothing ((\a -> a {rAudioProcessor'next = Just p}) <$> prev) in return (Just p) poke _p (RAudioProcessor process next prev) = do - pokeMaybeOff (castPtr _p) 0 process - pokeNext (castPtr _p) next + poke (p'rAudioProcessor'process _p) (fromMaybe nullFunPtr process) + pokeNext _p next pokePrev (castPtr _p) prev return () where pokeNext basePtr pNext = case pNext of - Nothing -> pokeByteOff basePtr 8 nullPtr + Nothing -> poke (p'rAudioProcessor'next basePtr) nullPtr Just val -> do nextPtr <- malloc - pokeMaybeOff nextPtr 0 (rAudioProcessor'process val) + poke (p'rAudioProcessor'process nextPtr) (fromMaybe nullFunPtr (rAudioProcessor'process val)) pokeNext nextPtr (rAudioProcessor'next val) - pokeByteOff nextPtr 16 basePtr - pokeByteOff basePtr 8 nextPtr + poke (p'rAudioProcessor'prev nextPtr) basePtr + poke (p'rAudioProcessor'next basePtr) nextPtr pokePrev basePtr pPrev = case pPrev of - Nothing -> pokeByteOff basePtr 16 nullPtr + Nothing -> poke (p'rAudioProcessor'prev basePtr) nullPtr Just val -> do prevPtr <- malloc - pokeMaybeOff prevPtr 0 (rAudioProcessor'process val) - pokeByteOff prevPtr 8 basePtr + poke (p'rAudioProcessor'process prevPtr) (fromMaybe nullFunPtr (rAudioProcessor'process val)) + poke (p'rAudioProcessor'next prevPtr) basePtr pokePrev prevPtr (rAudioProcessor'prev val) - pokeByteOff basePtr 16 prevPtr + poke (p'rAudioProcessor'prev basePtr) prevPtr + +-- maybe funptr +p'rAudioProcessor'process :: Ptr RAudioProcessor -> Ptr C'AudioCallback +p'rAudioProcessor'process = (`plusPtr` 0) + +-- maybe +p'rAudioProcessor'next :: Ptr RAudioProcessor -> Ptr (Ptr RAudioProcessor) +p'rAudioProcessor'next = (`plusPtr` 8) + +-- maybe +p'rAudioProcessor'prev :: Ptr RAudioProcessor -> Ptr (Ptr RAudioProcessor) +p'rAudioProcessor'prev = (`plusPtr` 16) data AudioStream = AudioStream { audioStream'buffer :: Ptr RAudioBuffer, audioStream'processor :: Ptr RAudioProcessor, audioStream'sampleRate :: Integer, audioStream'sampleSize :: Integer, - audiostream'channels :: Integer + audioStream'channels :: Integer } deriving (Eq, Show, Freeable) @@ -314,20 +457,37 @@ instance Storable AudioStream where sizeOf _ = 32 alignment _ = 8 peek _p = do - buffer <- peekByteOff _p 0 - processor <- peekByteOff _p 8 - sampleRate <- fromIntegral <$> (peekByteOff _p 16 :: IO CUInt) - sampleSize <- fromIntegral <$> (peekByteOff _p 20 :: IO CUInt) - channels <- fromIntegral <$> (peekByteOff _p 24 :: IO CUInt) + buffer <- peek (p'audioStream'buffer _p) + processor <- peek (p'audioStream'processor _p) + sampleRate <- fromIntegral <$> peek (p'audioStream'sampleRate _p) + sampleSize <- fromIntegral <$> peek (p'audioStream'sampleSize _p) + channels <- fromIntegral <$> peek (p'audioStream'channels _p) return $ AudioStream buffer processor sampleRate sampleSize channels poke _p (AudioStream buffer processor sampleRate sampleSize channels) = do - pokeByteOff _p 0 buffer - pokeByteOff _p 8 processor - pokeByteOff _p 16 (fromIntegral sampleRate :: CUInt) - pokeByteOff _p 20 (fromIntegral sampleSize :: CUInt) - pokeByteOff _p 24 (fromIntegral channels :: CUInt) + poke (p'audioStream'buffer _p) buffer + poke (p'audioStream'processor _p) processor + poke (p'audioStream'sampleRate _p) (fromIntegral sampleRate) + poke (p'audioStream'sampleSize _p) (fromIntegral sampleSize) + poke (p'audioStream'channels _p) (fromIntegral channels) return () +-- maybe +p'audioStream'buffer :: Ptr AudioStream -> Ptr (Ptr RAudioBuffer) +p'audioStream'buffer = (`plusPtr` 0) + +-- maybe +p'audioStream'processor :: Ptr AudioStream -> Ptr (Ptr RAudioProcessor) +p'audioStream'processor = (`plusPtr` 8) + +p'audioStream'sampleRate :: Ptr AudioStream -> Ptr CUInt +p'audioStream'sampleRate = (`plusPtr` 16) + +p'audioStream'sampleSize :: Ptr AudioStream -> Ptr CUInt +p'audioStream'sampleSize = (`plusPtr` 20) + +p'audioStream'channels :: Ptr AudioStream -> Ptr CUInt +p'audioStream'channels = (`plusPtr` 24) + data Sound = Sound { sound'stream :: AudioStream, sound'frameCount :: Integer @@ -338,14 +498,20 @@ instance Storable Sound where sizeOf _ = 40 alignment _ = 8 peek _p = do - stream <- peekByteOff _p 0 - frameCount <- fromIntegral <$> (peekByteOff _p 32 :: IO CUInt) + stream <- peek (p'sound'stream _p) + frameCount <- fromIntegral <$> peek (p'sound'frameCount _p) return $ Sound stream frameCount poke _p (Sound stream frameCount) = do - pokeByteOff _p 0 stream - pokeByteOff _p 32 (fromIntegral frameCount :: CUInt) + poke (p'sound'stream _p) stream + poke (p'sound'frameCount _p) (fromIntegral frameCount) return () +p'sound'stream :: Ptr Sound -> Ptr AudioStream +p'sound'stream = (`plusPtr` 0) + +p'sound'frameCount :: Ptr Sound -> Ptr CUInt +p'sound'frameCount = (`plusPtr` 32) + data Music = Music { music'stream :: AudioStream, music'frameCount :: Integer, @@ -359,20 +525,36 @@ instance Storable Music where sizeOf _ = 56 alignment _ = 4 peek _p = do - stream <- peekByteOff _p 0 - frameCount <- fromIntegral <$> (peekByteOff _p 32 :: IO CUInt) - looping <- toBool <$> (peekByteOff _p 36 :: IO CBool) - ctxType <- peekByteOff _p 40 - ctxData <- peekByteOff _p 48 + stream <- peek (p'music'stream _p) + frameCount <- fromIntegral <$> peek (p'music'frameCount _p) + looping <- toBool <$> peek (p'music'looping _p) + ctxType <- peek (p'music'ctxType _p) + ctxData <- peek (p'music'ctxData _p) return $ Music stream frameCount looping ctxType ctxData poke _p (Music stream frameCount looping ctxType ctxData) = do - pokeByteOff _p 0 stream - pokeByteOff _p 32 (fromIntegral frameCount :: CUInt) - pokeByteOff _p 36 (fromBool looping :: CInt) - pokeByteOff _p 40 ctxType - pokeByteOff _p 48 ctxData + poke (p'music'stream _p) stream + poke (p'music'frameCount _p) (fromIntegral frameCount) + poke (p'music'looping _p) (fromBool looping) + poke (p'music'ctxType _p) ctxType + poke (p'music'ctxData _p) ctxData return () +p'music'stream :: Ptr Music -> Ptr AudioStream +p'music'stream = (`plusPtr` 0) + +p'music'frameCount :: Ptr Music -> Ptr CUInt +p'music'frameCount = (`plusPtr` 32) + +p'music'looping :: Ptr Music -> Ptr CBool +p'music'looping = (`plusPtr` 36) + +p'music'ctxType :: Ptr Music -> Ptr MusicContextType +p'music'ctxType = (`plusPtr` 40) + +-- bytes (?) +p'music'ctxData :: Ptr Music -> Ptr (Ptr ()) +p'music'ctxData = (`plusPtr` 48) + --------------------------------------- -- audio callbacks -------------------- --------------------------------------- diff --git a/src/Raylib/Types/Core/Camera.hs b/src/Raylib/Types/Core/Camera.hs index c848ab9..3bcba0f 100644 --- a/src/Raylib/Types/Core/Camera.hs +++ b/src/Raylib/Types/Core/Camera.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} + {-# OPTIONS -Wall #-} -- | Bindings for camera-related types @@ -6,16 +7,30 @@ module Raylib.Types.Core.Camera ( -- * Enumerations CameraMode (..), CameraProjection (..), + -- * Structures Camera3D (..), Camera2D (..), Camera, + + -- * Pointer utilities + p'camera3D'position, + p'camera3D'target, + p'camera3D'up, + p'camera3D'fovy, + p'camera3D'projection, + p'camera2D'offset, + p'camera2D'target, + p'camera2D'rotation, + p'camera2D'zoom, ) where import Foreign - ( Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + ( Ptr, + Storable (alignment, peek, poke, sizeOf), castPtr, + plusPtr, ) import Foreign.C ( CFloat, @@ -63,20 +78,35 @@ instance Storable Camera3D where sizeOf _ = 44 alignment _ = 4 peek _p = do - position <- peekByteOff _p 0 - target <- peekByteOff _p 12 - up <- peekByteOff _p 24 - fovy <- realToFrac <$> (peekByteOff _p 36 :: IO CFloat) - projection <- peekByteOff _p 40 + position <- peek (p'camera3D'position _p) + target <- peek (p'camera3D'target _p) + up <- peek (p'camera3D'up _p) + fovy <- realToFrac <$> peek (p'camera3D'fovy _p) + projection <- peek (p'camera3D'projection _p) return $ Camera3D position target up fovy projection poke _p (Camera3D position target up fovy projection) = do - pokeByteOff _p 0 position - pokeByteOff _p 12 target - pokeByteOff _p 24 up - pokeByteOff _p 36 (realToFrac fovy :: CFloat) - pokeByteOff _p 40 projection + poke (p'camera3D'position _p) position + poke (p'camera3D'target _p) target + poke (p'camera3D'up _p) up + poke (p'camera3D'fovy _p) (realToFrac fovy) + poke (p'camera3D'projection _p) projection return () +p'camera3D'position :: Ptr Camera3D -> Ptr Vector3 +p'camera3D'position = (`plusPtr` 0) + +p'camera3D'target :: Ptr Camera3D -> Ptr Vector3 +p'camera3D'target = (`plusPtr` 12) + +p'camera3D'up :: Ptr Camera3D -> Ptr Vector3 +p'camera3D'up = (`plusPtr` 24) + +p'camera3D'fovy :: Ptr Camera3D -> Ptr CFloat +p'camera3D'fovy = (`plusPtr` 36) + +p'camera3D'projection :: Ptr Camera3D -> Ptr CameraProjection +p'camera3D'projection = (`plusPtr` 40) + type Camera = Camera3D data Camera2D = Camera2D @@ -91,14 +121,26 @@ instance Storable Camera2D where sizeOf _ = 24 alignment _ = 4 peek _p = do - offset <- peekByteOff _p 0 - target <- peekByteOff _p 8 - rotation <- realToFrac <$> (peekByteOff _p 16 :: IO CFloat) - zoom <- realToFrac <$> (peekByteOff _p 20 :: IO CFloat) + offset <- peek (p'camera2D'offset _p) + target <- peek (p'camera2D'target _p) + rotation <- realToFrac <$> peek (p'camera2D'rotation _p) + zoom <- realToFrac <$> peek (p'camera2D'zoom _p) return $ Camera2D offset target rotation zoom poke _p (Camera2D offset target rotation zoom) = do - pokeByteOff _p 0 offset - pokeByteOff _p 8 target - pokeByteOff _p 16 (realToFrac rotation :: CFloat) - pokeByteOff _p 20 (realToFrac zoom :: CFloat) + poke (p'camera2D'offset _p) offset + poke (p'camera2D'target _p) target + poke (p'camera2D'rotation _p) (realToFrac rotation) + poke (p'camera2D'zoom _p) (realToFrac zoom) return () + +p'camera2D'offset :: Ptr Camera2D -> Ptr Vector2 +p'camera2D'offset = (`plusPtr` 0) + +p'camera2D'target :: Ptr Camera2D -> Ptr Vector2 +p'camera2D'target = (`plusPtr` 8) + +p'camera2D'rotation :: Ptr Camera2D -> Ptr CFloat +p'camera2D'rotation = (`plusPtr` 16) + +p'camera2D'zoom :: Ptr Camera2D -> Ptr CFloat +p'camera2D'zoom = (`plusPtr` 20) diff --git a/src/Raylib/Types/Core/Models.hs b/src/Raylib/Types/Core/Models.hs index 9850bcd..987d555 100644 --- a/src/Raylib/Types/Core/Models.hs +++ b/src/Raylib/Types/Core/Models.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} + {-# OPTIONS -Wall #-} -- | Bindings for types used mainly in @rmodels@ @@ -12,6 +13,7 @@ module Raylib.Types.Core.Models unpackShaderUniformData, unpackShaderUniformDataV, ShaderAttributeDataType (..), + -- * Structures Mesh (..), Shader (..), @@ -24,13 +26,64 @@ module Raylib.Types.Core.Models Ray (..), RayCollision (..), BoundingBox (..), + + -- * Pointer utilities + p'mesh'vertexCount, + p'mesh'triangleCount, + p'mesh'vertices, + p'mesh'texcoords, + p'mesh'texcoords2, + p'mesh'normals, + p'mesh'tangents, + p'mesh'colors, + p'mesh'indices, + p'mesh'animVertices, + p'mesh'animNormals, + p'mesh'boneIds, + p'mesh'boneWeights, + p'mesh'vaoId, + p'mesh'vboId, + p'shader'id, + p'shader'locs, + p'materialMap'texture, + p'materialMap'color, + p'materialMap'value, + p'material'shader, + p'material'maps, + p'material'params, + p'transform'translation, + p'transform'rotation, + p'transform'scale, + p'boneInfo'name, + p'boneInfo'parent, + p'model'transform, + p'model'meshCount, + p'model'materialCount, + p'model'meshes, + p'model'materials, + p'model'meshMaterial, + p'model'boneCount, + p'model'bones, + p'model'bindPose, + p'modelAnimation'boneCount, + p'modelAnimation'bones, + p'modelAnimation'framePoses, + p'modelAnimation'name, + p'ray'position, + p'ray'direction, + p'rayCollision'hit, + p'rayCollision'distance, + p'rayCollision'point, + p'rayCollision'normal, + p'boundingBox'min, + p'boundingBox'max, ) where import Control.Monad (forM_, unless) import Foreign ( Ptr, - Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + Storable (alignment, peek, poke, sizeOf), Word16, Word8, castPtr, @@ -39,6 +92,7 @@ import Foreign newArray, newForeignPtr, peekArray, + plusPtr, toBool, withForeignPtr, ) @@ -51,10 +105,10 @@ import Foreign.C CUInt, CUShort, castCharToCChar, + peekCString, ) -import Foreign.C.String (castCCharToChar) -import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, freeMaybePtr, newMaybeArray, p'free, peekMaybeArray, peekStaticArray, peekStaticArrayOff, pokeStaticArray, pokeStaticArrayOff, rightPad, rlFreeArray, rlFreeMaybeArray) import Raylib.Internal (c'rlGetShaderIdDefault) +import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, freeMaybePtr, newMaybeArray, p'free, peekMaybeArray, peekStaticArray, pokeStaticArray, rightPad, rlFreeArray, rlFreeMaybeArray) import Raylib.Types.Core (Color, Matrix, Quaternion, Vector2 (Vector2), Vector3 (Vector3), Vector4 (Vector4)) import Raylib.Types.Core.Textures (Texture (texture'id)) @@ -261,77 +315,122 @@ instance Storable Mesh where sizeOf _ = 112 alignment _ = 8 peek _p = do - vertexCount <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - triangleCount <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - verticesPtr <- (peekByteOff _p 8 :: IO (Ptr Vector3)) - vertices <- peekArray vertexCount verticesPtr - texcoordsPtr <- (peekByteOff _p 16 :: IO (Ptr Vector2)) - texcoords <- peekArray vertexCount texcoordsPtr - texcoords2Ptr <- (peekByteOff _p 24 :: IO (Ptr Vector2)) - texcoords2 <- peekMaybeArray vertexCount texcoords2Ptr - normalsPtr <- (peekByteOff _p 32 :: IO (Ptr Vector3)) - normals <- peekArray vertexCount normalsPtr - tangentsPtr <- (peekByteOff _p 40 :: IO (Ptr Vector4)) - tangents <- peekMaybeArray vertexCount tangentsPtr - colorsPtr <- (peekByteOff _p 48 :: IO (Ptr Color)) - colors <- peekMaybeArray vertexCount colorsPtr - indicesPtr <- (peekByteOff _p 56 :: IO (Ptr CUShort)) - indices <- (\m -> map fromIntegral <$> m) <$> peekMaybeArray vertexCount indicesPtr - animVerticesPtr <- (peekByteOff _p 64 :: IO (Ptr Vector3)) - animVertices <- peekMaybeArray vertexCount animVerticesPtr - animNormalsPtr <- (peekByteOff _p 72 :: IO (Ptr Vector3)) - animNormals <- peekMaybeArray vertexCount animNormalsPtr - boneIdsPtr <- (peekByteOff _p 80 :: IO (Ptr CUChar)) - boneIds <- (\m -> map fromIntegral <$> m) <$> peekMaybeArray (vertexCount * 4) boneIdsPtr - boneWeightsPtr <- (peekByteOff _p 88 :: IO (Ptr CFloat)) - boneWeights <- (map realToFrac <$>) <$> peekMaybeArray (vertexCount * 4) boneWeightsPtr - vaoId <- fromIntegral <$> (peekByteOff _p 96 :: IO CUInt) - vboIdPtr <- (peekByteOff _p 104 :: IO (Ptr CUInt)) - vboId <- (\m -> map fromIntegral <$> m) <$> peekMaybeArray 7 vboIdPtr + vertexCount <- fromIntegral <$> peek (p'mesh'vertexCount _p) + triangleCount <- fromIntegral <$> peek (p'mesh'triangleCount _p) + vertices <- peekArray vertexCount =<< peek (p'mesh'vertices _p) + texcoords <- peekArray vertexCount =<< peek (p'mesh'texcoords _p) + texcoords2 <- peekMaybeArray vertexCount =<< peek (p'mesh'texcoords2 _p) + normals <- peekArray vertexCount =<< peek (p'mesh'normals _p) + tangents <- peekMaybeArray vertexCount =<< peek (p'mesh'tangents _p) + colors <- peekMaybeArray vertexCount =<< peek (p'mesh'colors _p) + indices <- (map fromIntegral <$>) <$> (peekMaybeArray vertexCount =<< peek (p'mesh'indices _p)) + animVertices <- peekMaybeArray vertexCount =<< peek (p'mesh'animVertices _p) + animNormals <- peekMaybeArray vertexCount =<< peek (p'mesh'animNormals _p) + boneIds <- (map fromIntegral <$>) <$> (peekMaybeArray (vertexCount * 4) =<< peek (p'mesh'boneIds _p)) + boneWeights <- (map realToFrac <$>) <$> (peekMaybeArray (vertexCount * 4) =<< peek (p'mesh'boneWeights _p)) + vaoId <- fromIntegral <$> peek (p'mesh'vaoId _p) + vboId <- (map fromIntegral <$>) <$> (peekMaybeArray 7 =<< peek (p'mesh'vboId _p)) return $ Mesh vertexCount triangleCount vertices texcoords texcoords2 normals tangents colors indices animVertices animNormals boneIds boneWeights vaoId vboId poke _p (Mesh vertexCount triangleCount vertices texcoords texcoords2 normals tangents colors indices animVertices animNormals boneIds boneWeights vaoId vboId) = do - pokeByteOff _p 0 (fromIntegral vertexCount :: CInt) - pokeByteOff _p 4 (fromIntegral triangleCount :: CInt) - pokeByteOff _p 8 =<< newArray vertices - pokeByteOff _p 16 =<< newArray texcoords - newMaybeArray texcoords2 >>= pokeByteOff _p 24 - pokeByteOff _p 32 =<< newArray normals - newMaybeArray tangents >>= pokeByteOff _p 40 - newMaybeArray colors >>= pokeByteOff _p 48 - newMaybeArray (map fromIntegral <$> indices :: Maybe [CUShort]) >>= pokeByteOff _p 56 - newMaybeArray animVertices >>= pokeByteOff _p 64 - newMaybeArray animNormals >>= pokeByteOff _p 72 - newMaybeArray (map fromIntegral <$> boneIds :: Maybe [CUChar]) >>= pokeByteOff _p 80 - newMaybeArray (map realToFrac <$> boneWeights :: Maybe [CFloat]) >>= pokeByteOff _p 88 - pokeByteOff _p 96 (fromIntegral vaoId :: CUInt) - newMaybeArray (map fromIntegral <$> vboId :: Maybe [CUInt]) >>= pokeByteOff _p 104 + poke (p'mesh'vertexCount _p) (fromIntegral vertexCount) + poke (p'mesh'triangleCount _p) (fromIntegral triangleCount) + poke (p'mesh'vertices _p) =<< newArray vertices + poke (p'mesh'texcoords _p) =<< newArray texcoords + poke (p'mesh'texcoords2 _p) =<< newMaybeArray texcoords2 + poke (p'mesh'normals _p) =<< newArray normals + poke (p'mesh'tangents _p) =<< newMaybeArray tangents + poke (p'mesh'colors _p) =<< newMaybeArray colors + poke (p'mesh'indices _p) =<< newMaybeArray (map fromIntegral <$> indices) + poke (p'mesh'animVertices _p) =<< newMaybeArray animVertices + poke (p'mesh'animNormals _p) =<< newMaybeArray animNormals + poke (p'mesh'boneIds _p) =<< newMaybeArray (map fromIntegral <$> boneIds) + poke (p'mesh'boneWeights _p) =<< newMaybeArray (map realToFrac <$> boneWeights) + poke (p'mesh'vaoId _p) (fromIntegral vaoId) + poke (p'mesh'vboId _p) =<< newMaybeArray (map fromIntegral <$> vboId) return () +p'mesh'vertexCount :: Ptr Mesh -> Ptr CInt +p'mesh'vertexCount = (`plusPtr` 0) + +p'mesh'triangleCount :: Ptr Mesh -> Ptr CInt +p'mesh'triangleCount = (`plusPtr` 4) + +-- array (mesh'vertexCount) +p'mesh'vertices :: Ptr Mesh -> Ptr (Ptr Vector3) +p'mesh'vertices = (`plusPtr` 8) + +-- array (mesh'vertexCount) +p'mesh'texcoords :: Ptr Mesh -> Ptr (Ptr Vector2) +p'mesh'texcoords = (`plusPtr` 16) + +-- maybe array (mesh'vertexCount) +p'mesh'texcoords2 :: Ptr Mesh -> Ptr (Ptr Vector2) +p'mesh'texcoords2 = (`plusPtr` 24) + +-- array (mesh'vertexCount) +p'mesh'normals :: Ptr Mesh -> Ptr (Ptr Vector3) +p'mesh'normals = (`plusPtr` 32) + +-- maybe array (mesh'vertexCount) +p'mesh'tangents :: Ptr Mesh -> Ptr (Ptr Vector4) +p'mesh'tangents = (`plusPtr` 40) + +-- maybe array (mesh'vertexCount) +p'mesh'colors :: Ptr Mesh -> Ptr (Ptr Color) +p'mesh'colors = (`plusPtr` 48) + +-- maybe array (mesh'vertexCount) +p'mesh'indices :: Ptr Mesh -> Ptr (Ptr CUShort) +p'mesh'indices = (`plusPtr` 56) + +-- maybe array (mesh'vertexCount) +p'mesh'animVertices :: Ptr Mesh -> Ptr (Ptr Vector3) +p'mesh'animVertices = (`plusPtr` 64) + +-- maybe array (mesh'vertexCount) +p'mesh'animNormals :: Ptr Mesh -> Ptr (Ptr Vector3) +p'mesh'animNormals = (`plusPtr` 72) + +-- maybe array (mesh'vertexCount * 4) +p'mesh'boneIds :: Ptr Mesh -> Ptr (Ptr CUChar) +p'mesh'boneIds = (`plusPtr` 80) + +-- maybe array (mesh'vertexCount * 4) +p'mesh'boneWeights :: Ptr Mesh -> Ptr (Ptr CFloat) +p'mesh'boneWeights = (`plusPtr` 88) + +p'mesh'vaoId :: Ptr Mesh -> Ptr CUInt +p'mesh'vaoId = (`plusPtr` 96) + +-- maybe array (7) +p'mesh'vboId :: Ptr Mesh -> Ptr (Ptr CUInt) +p'mesh'vboId = (`plusPtr` 104) + instance Freeable Mesh where rlFreeDependents _ ptr = do - verticesPtr <- (peekByteOff ptr 8 :: IO (Ptr Float)) + verticesPtr <- peek (p'mesh'vertices ptr) c'free $ castPtr verticesPtr - texcoordsPtr <- (peekByteOff ptr 16 :: IO (Ptr Vector2)) + texcoordsPtr <- peek (p'mesh'texcoords ptr) c'free $ castPtr texcoordsPtr - texcoords2Ptr <- (peekByteOff ptr 24 :: IO (Ptr Vector2)) + texcoords2Ptr <- peek (p'mesh'texcoords2 ptr) freeMaybePtr $ castPtr texcoords2Ptr - normalsPtr <- (peekByteOff ptr 32 :: IO (Ptr Vector3)) + normalsPtr <- peek (p'mesh'normals ptr) c'free $ castPtr normalsPtr - tangentsPtr <- (peekByteOff ptr 40 :: IO (Ptr Vector4)) + tangentsPtr <- peek (p'mesh'tangents ptr) freeMaybePtr $ castPtr tangentsPtr - colorsPtr <- (peekByteOff ptr 48 :: IO (Ptr Color)) + colorsPtr <- peek (p'mesh'colors ptr) freeMaybePtr $ castPtr colorsPtr - indicesPtr <- (peekByteOff ptr 56 :: IO (Ptr CUShort)) + indicesPtr <- peek (p'mesh'indices ptr) freeMaybePtr $ castPtr indicesPtr - animVerticesPtr <- (peekByteOff ptr 64 :: IO (Ptr Vector3)) + animVerticesPtr <- peek (p'mesh'animVertices ptr) freeMaybePtr $ castPtr animVerticesPtr - animNormalsPtr <- (peekByteOff ptr 72 :: IO (Ptr Vector3)) + animNormalsPtr <- peek (p'mesh'animNormals ptr) freeMaybePtr $ castPtr animNormalsPtr - boneIdsPtr <- (peekByteOff ptr 80 :: IO (Ptr CUChar)) + boneIdsPtr <- peek (p'mesh'boneIds ptr) freeMaybePtr $ castPtr boneIdsPtr - boneWeightsPtr <- (peekByteOff ptr 88 :: IO (Ptr CFloat)) + boneWeightsPtr <- peek (p'mesh'boneWeights ptr) freeMaybePtr $ castPtr boneWeightsPtr - vboIdPtr <- (peekByteOff ptr 104 :: IO (Ptr CUInt)) + vboIdPtr <- peek (p'mesh'vboId ptr) c'free $ castPtr vboIdPtr data Shader = Shader @@ -344,28 +443,34 @@ instance Storable Shader where sizeOf _ = 16 alignment _ = 8 peek _p = do - sId <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - locsPtr <- (peekByteOff _p 8 :: IO (Ptr CInt)) - locs <- map fromIntegral <$> peekArray 32 locsPtr + sId <- fromIntegral <$> peek (p'shader'id _p) + locs <- map fromIntegral <$> (peekArray 32 =<< peek (p'shader'locs _p)) return $ Shader sId locs poke _p (Shader sId locs) = do - pokeByteOff _p 0 (fromIntegral sId :: CUInt) + poke (p'shader'id _p) (fromIntegral sId) defaultShaderId <- c'rlGetShaderIdDefault - locsArr <- newArray (map fromIntegral locs :: [CInt]) + locsArr <- newArray (map fromIntegral locs) if sId == fromIntegral defaultShaderId then do locsPtr <- newForeignPtr p'free locsArr - withForeignPtr locsPtr $ pokeByteOff _p 8 - else pokeByteOff _p 8 locsArr + withForeignPtr locsPtr $ poke (p'shader'locs _p) + else poke (p'shader'locs _p) locsArr return () +p'shader'id :: Ptr Shader -> Ptr CUInt +p'shader'id = (`plusPtr` 0) + +-- array (32) +p'shader'locs :: Ptr Shader -> Ptr (Ptr CInt) +p'shader'locs = (`plusPtr` 8) + instance Freeable Shader where rlFreeDependents val ptr = do defaultShaderId <- c'rlGetShaderIdDefault unless (shader'id val == fromIntegral defaultShaderId) ( do - locsPtr <- (peekByteOff ptr 8 :: IO (Ptr CInt)) + locsPtr <- peek (p'shader'locs ptr) c'free $ castPtr locsPtr ) @@ -380,16 +485,25 @@ instance Storable MaterialMap where sizeOf _ = 28 alignment _ = 4 peek _p = do - texture <- peekByteOff _p 0 - color <- peekByteOff _p 20 - value <- realToFrac <$> (peekByteOff _p 24 :: IO CFloat) + texture <- peek (p'materialMap'texture _p) + color <- peek (p'materialMap'color _p) + value <- realToFrac <$> peek (p'materialMap'value _p) return $ MaterialMap texture color value poke _p (MaterialMap texture color value) = do - pokeByteOff _p 0 texture - pokeByteOff _p 20 color - pokeByteOff _p 24 (realToFrac value :: CFloat) + poke (p'materialMap'texture _p) texture + poke (p'materialMap'color _p) color + poke (p'materialMap'value _p) (realToFrac value) return () +p'materialMap'texture :: Ptr MaterialMap -> Ptr Texture +p'materialMap'texture = (`plusPtr` 0) + +p'materialMap'color :: Ptr MaterialMap -> Ptr Color +p'materialMap'color = (`plusPtr` 20) + +p'materialMap'value :: Ptr MaterialMap -> Ptr CFloat +p'materialMap'value = (`plusPtr` 24) + data Material = Material { material'shader :: Shader, material'maps :: Maybe [MaterialMap], @@ -401,22 +515,31 @@ instance Storable Material where sizeOf _ = 40 alignment _ = 8 peek _p = do - shader <- peekByteOff _p 0 - mapsPtr <- (peekByteOff _p 16 :: IO (Ptr MaterialMap)) - maps <- peekMaybeArray 12 mapsPtr - params <- map realToFrac <$> peekStaticArrayOff 4 (castPtr _p :: Ptr CFloat) 24 + shader <- peek (p'material'shader _p) + maps <- peekMaybeArray 12 =<< peek (p'material'maps _p) + params <- map realToFrac <$> peekStaticArray 4 (p'material'params _p) return $ Material shader maps params poke _p (Material shader maps params) = do - pokeByteOff _p 0 shader - pokeByteOff _p 16 =<< newMaybeArray maps - pokeStaticArrayOff (castPtr _p :: Ptr CFloat) 24 (map realToFrac params :: [CFloat]) + poke (p'material'shader _p) shader + poke (p'material'maps _p) =<< newMaybeArray maps + pokeStaticArray (p'material'params _p) (map realToFrac params) return () +p'material'shader :: Ptr Material -> Ptr Shader +p'material'shader = (`plusPtr` 0) + +-- maybe array (12) +p'material'maps :: Ptr Material -> Ptr (Ptr MaterialMap) +p'material'maps = (`plusPtr` 16) + +-- static array (4) +p'material'params :: Ptr Material -> Ptr CFloat +p'material'params = (`plusPtr` 24) + instance Freeable Material where rlFreeDependents val ptr = do rlFreeDependents (material'shader val) (castPtr ptr :: Ptr Shader) - mapsPtr <- (peekByteOff ptr 16 :: IO (Ptr MaterialMap)) - rlFreeMaybeArray (material'maps val) mapsPtr + rlFreeMaybeArray (material'maps val) =<< peek (p'material'maps ptr) data Transform = Transform { transform'translation :: Vector3, @@ -429,19 +552,28 @@ instance Storable Transform where sizeOf _ = 40 alignment _ = 4 peek _p = do - translation <- peekByteOff _p 0 - rotation <- peekByteOff _p 12 - scale <- peekByteOff _p 28 + translation <- peek (p'transform'translation _p) + rotation <- peek (p'transform'rotation _p) + scale <- peek (p'transform'scale _p) return $ Transform translation rotation scale poke _p (Transform translation rotation scale) = do - pokeByteOff _p 0 translation - pokeByteOff _p 12 rotation - pokeByteOff _p 28 scale + poke (p'transform'translation _p) translation + poke (p'transform'rotation _p) rotation + poke (p'transform'scale _p) scale return () +p'transform'translation :: Ptr Transform -> Ptr Vector3 +p'transform'translation = (`plusPtr` 0) + +p'transform'rotation :: Ptr Transform -> Ptr Quaternion +p'transform'rotation = (`plusPtr` 12) + +p'transform'scale :: Ptr Transform -> Ptr Vector3 +p'transform'scale = (`plusPtr` 28) + data BoneInfo = BoneInfo { boneInfo'name :: String, - boneinfo'parent :: Int + boneInfo'parent :: Int } deriving (Eq, Show, Freeable) @@ -449,14 +581,21 @@ instance Storable BoneInfo where sizeOf _ = 36 alignment _ = 4 peek _p = do - name <- map castCCharToChar . takeWhile (/= 0) <$> peekStaticArray 32 (castPtr _p :: Ptr CChar) - parent <- fromIntegral <$> (peekByteOff _p 32 :: IO CInt) + name <- peekCString (p'boneInfo'name _p) + parent <- fromIntegral <$> peek (p'boneInfo'parent _p) return $ BoneInfo name parent poke _p (BoneInfo name parent) = do - pokeStaticArray (castPtr _p :: Ptr CChar) (rightPad 32 0 $ map castCharToCChar name) - pokeByteOff _p 32 (fromIntegral parent :: CInt) + pokeStaticArray (p'boneInfo'name _p) (rightPad 32 0 $ map castCharToCChar name) + poke (p'boneInfo'parent _p) (fromIntegral parent) return () +-- static string (32) +p'boneInfo'name :: Ptr BoneInfo -> Ptr CChar +p'boneInfo'name = (`plusPtr` 0) + +p'boneInfo'parent :: Ptr BoneInfo -> Ptr CInt +p'boneInfo'parent = (`plusPtr` 32) + data Model = Model { model'transform :: Matrix, model'meshes :: [Mesh], @@ -472,45 +611,67 @@ instance Storable Model where sizeOf _ = 120 alignment _ = 4 peek _p = do - transform <- peekByteOff _p 0 - meshCount <- fromIntegral <$> (peekByteOff _p 64 :: IO CInt) - materialCount <- fromIntegral <$> (peekByteOff _p 68 :: IO CInt) - meshesPtr <- (peekByteOff _p 72 :: IO (Ptr Mesh)) - meshes <- peekArray meshCount meshesPtr - materialsPtr <- (peekByteOff _p 80 :: IO (Ptr Material)) - materials <- peekArray materialCount materialsPtr - meshMaterialPtr <- (peekByteOff _p 88 :: IO (Ptr CInt)) - meshMaterial <- map fromIntegral <$> peekArray meshCount meshMaterialPtr - boneCount <- fromIntegral <$> (peekByteOff _p 96 :: IO CInt) - bonesPtr <- (peekByteOff _p 104 :: IO (Ptr BoneInfo)) - bones <- peekMaybeArray boneCount bonesPtr - bindPosePtr <- (peekByteOff _p 112 :: IO (Ptr Transform)) - bindPose <- peekMaybeArray boneCount bindPosePtr + transform <- peek (p'model'transform _p) + meshCount <- fromIntegral <$> peek (p'model'meshCount _p) + materialCount <- fromIntegral <$> peek (p'model'materialCount _p) + meshes <- peekArray meshCount =<< peek (p'model'meshes _p) + materials <- peekArray materialCount =<< peek (p'model'materials _p) + meshMaterial <- map fromIntegral <$> (peekArray meshCount =<< peek (p'model'meshMaterial _p)) + boneCount <- fromIntegral <$> peek (p'model'boneCount _p) + bones <- peekMaybeArray boneCount =<< peek (p'model'bones _p) + bindPose <- peekMaybeArray boneCount =<< peek (p'model'bindPose _p) return $ Model transform meshes materials meshMaterial boneCount bones bindPose poke _p (Model transform meshes materials meshMaterial boneCount bones bindPose) = do - pokeByteOff _p 0 transform - pokeByteOff _p 64 (fromIntegral $ length meshes :: CInt) - pokeByteOff _p 68 (fromIntegral $ length materials :: CInt) - pokeByteOff _p 72 =<< newArray meshes - pokeByteOff _p 80 =<< newArray materials - pokeByteOff _p 88 =<< newArray (map fromIntegral meshMaterial :: [CInt]) - pokeByteOff _p 96 (fromIntegral boneCount :: CInt) - newMaybeArray bones >>= pokeByteOff _p 104 - newMaybeArray bindPose >>= pokeByteOff _p 112 + poke (p'model'transform _p) transform + poke (p'model'meshCount _p) (fromIntegral (length meshes)) + poke (p'model'materialCount _p) (fromIntegral (length materials)) + poke (p'model'meshes _p) =<< newArray meshes + poke (p'model'materials _p) =<< newArray materials + poke (p'model'meshMaterial _p) =<< newArray (map fromIntegral meshMaterial) + poke (p'model'boneCount _p) (fromIntegral boneCount) + poke (p'model'bones _p) =<< newMaybeArray bones + poke (p'model'bindPose _p) =<< newMaybeArray bindPose return () +p'model'transform :: Ptr Model -> Ptr Matrix +p'model'transform = (`plusPtr` 0) + +p'model'meshCount :: Ptr Model -> Ptr CInt +p'model'meshCount = (`plusPtr` 64) + +p'model'materialCount :: Ptr Model -> Ptr CInt +p'model'materialCount = (`plusPtr` 68) + +-- array (model'meshCount) +p'model'meshes :: Ptr Model -> Ptr (Ptr Mesh) +p'model'meshes = (`plusPtr` 72) + +-- array (model'materialCount) +p'model'materials :: Ptr Model -> Ptr (Ptr Material) +p'model'materials = (`plusPtr` 80) + +-- array (model'meshCount) +p'model'meshMaterial :: Ptr Model -> Ptr (Ptr CInt) +p'model'meshMaterial = (`plusPtr` 88) + +p'model'boneCount :: Ptr Model -> Ptr CInt +p'model'boneCount = (`plusPtr` 96) + +-- maybe array (model'boneCount) +p'model'bones :: Ptr Model -> Ptr (Ptr BoneInfo) +p'model'bones = (`plusPtr` 104) + +-- maybe array (model'boneCount) +p'model'bindPose :: Ptr Model -> Ptr (Ptr Transform) +p'model'bindPose = (`plusPtr` 112) + instance Freeable Model where rlFreeDependents val ptr = do - meshesPtr <- (peekByteOff ptr 72 :: IO (Ptr Mesh)) - rlFreeArray (model'meshes val) meshesPtr - materialsPtr <- (peekByteOff ptr 80 :: IO (Ptr Material)) - rlFreeArray (model'materials val) materialsPtr - meshMaterialPtr <- (peekByteOff ptr 88 :: IO (Ptr CInt)) - c'free $ castPtr meshMaterialPtr - bonesPtr <- (peekByteOff ptr 104 :: IO (Ptr BoneInfo)) - freeMaybePtr $ castPtr bonesPtr - bindPosePtr <- (peekByteOff ptr 112 :: IO (Ptr Transform)) - freeMaybePtr $ castPtr bindPosePtr + rlFreeArray (model'meshes val) =<< peek (p'model'meshes ptr) + rlFreeArray (model'materials val) =<< peek (p'model'materials ptr) + c'free . castPtr =<< peek (p'model'meshMaterial ptr) + freeMaybePtr . castPtr =<< peek (p'model'bones ptr) + freeMaybePtr . castPtr =<< peek (p'model'bindPose ptr) data ModelAnimation = ModelAnimation { modelAnimation'boneCount :: Int, @@ -525,28 +686,44 @@ instance Storable ModelAnimation where sizeOf _ = 56 alignment _ = 4 peek _p = do - boneCount <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - frameCount <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - bonesPtr <- (peekByteOff _p 8 :: IO (Ptr BoneInfo)) - bones <- peekArray boneCount bonesPtr - framePosesPtr <- (peekByteOff _p 16 :: IO (Ptr (Ptr Transform))) + boneCount <- fromIntegral <$> peek (p'modelAnimation'boneCount _p) + frameCount <- fromIntegral <$> peek (p'modelAnimation'frameCount _p) + bones <- peekArray boneCount =<< peek (p'modelAnimation'bones _p) + framePosesPtr <- peek (p'modelAnimation'framePoses _p) framePosesPtrArr <- peekArray frameCount framePosesPtr framePoses <- mapM (peekArray boneCount) framePosesPtrArr - name <- map castCCharToChar <$> peekStaticArrayOff 32 (castPtr _p) 24 + name <- peekCString (p'modelAnimation'name _p) return $ ModelAnimation boneCount frameCount bones framePoses name poke _p (ModelAnimation boneCount frameCount bones framePoses name) = do - pokeByteOff _p 0 (fromIntegral boneCount :: CInt) - pokeByteOff _p 4 (fromIntegral frameCount :: CInt) - pokeByteOff _p 8 =<< newArray bones - mapM newArray framePoses >>= newArray >>= pokeByteOff _p 16 - pokeStaticArrayOff (castPtr _p) 24 (map castCharToCChar name) + poke (p'modelAnimation'boneCount _p) (fromIntegral boneCount) + poke (p'modelAnimation'frameCount _p) (fromIntegral frameCount) + poke (p'modelAnimation'bones _p) =<< newArray bones + poke (p'modelAnimation'framePoses _p) =<< newArray =<< mapM newArray framePoses + pokeStaticArray (p'modelAnimation'name _p) (rightPad 32 0 $ map castCharToCChar name) return () +p'modelAnimation'boneCount :: Ptr ModelAnimation -> Ptr CInt +p'modelAnimation'boneCount = (`plusPtr` 0) + +p'modelAnimation'frameCount :: Ptr ModelAnimation -> Ptr CInt +p'modelAnimation'frameCount = (`plusPtr` 4) + +-- array (modelAnimation'boneCount) +p'modelAnimation'bones :: Ptr ModelAnimation -> Ptr (Ptr BoneInfo) +p'modelAnimation'bones = (`plusPtr` 8) + +-- array 2d (rows: modelAnimation'frameCount, cols: modelAnimation'boneCount) +p'modelAnimation'framePoses :: Ptr ModelAnimation -> Ptr (Ptr (Ptr Transform)) +p'modelAnimation'framePoses = (`plusPtr` 16) + +-- static string (32) +p'modelAnimation'name :: Ptr ModelAnimation -> Ptr CChar +p'modelAnimation'name = (`plusPtr` 24) + instance Freeable ModelAnimation where rlFreeDependents val ptr = do - bonesPtr <- (peekByteOff ptr 8 :: IO (Ptr BoneInfo)) - c'free $ castPtr bonesPtr - framePosesPtr <- (peekByteOff ptr 16 :: IO (Ptr (Ptr Transform))) + c'free . castPtr =<< peek (p'modelAnimation'bones ptr) + framePosesPtr <- peek (p'modelAnimation'framePoses ptr) framePosesPtrArr <- peekArray (modelAnimation'frameCount val) framePosesPtr forM_ framePosesPtrArr (c'free . castPtr) c'free $ castPtr framePosesPtr @@ -561,14 +738,20 @@ instance Storable Ray where sizeOf _ = 24 alignment _ = 4 peek _p = do - position <- peekByteOff _p 0 - direction <- peekByteOff _p 12 + position <- peek (p'ray'position _p) + direction <- peek (p'ray'direction _p) return $ Ray position direction poke _p (Ray position direction) = do - pokeByteOff _p 0 position - pokeByteOff _p 12 direction + poke (p'ray'position _p) position + poke (p'ray'direction _p) direction return () +p'ray'position :: Ptr Ray -> Ptr Vector3 +p'ray'position = (`plusPtr` 0) + +p'ray'direction :: Ptr Ray -> Ptr Vector3 +p'ray'direction = (`plusPtr` 12) + data RayCollision = RayCollision { rayCollision'hit :: Bool, rayCollision'distance :: Float, @@ -581,18 +764,30 @@ instance Storable RayCollision where sizeOf _ = 32 alignment _ = 4 peek _p = do - hit <- toBool <$> (peekByteOff _p 0 :: IO CBool) - distance <- realToFrac <$> (peekByteOff _p 4 :: IO CFloat) - point <- peekByteOff _p 8 - normal <- peekByteOff _p 20 + hit <- toBool <$> peek (p'rayCollision'hit _p) + distance <- realToFrac <$> peek (p'rayCollision'distance _p) + point <- peek (p'rayCollision'point _p) + normal <- peek (p'rayCollision'normal _p) return $ RayCollision hit distance point normal poke _p (RayCollision hit distance point normal) = do - pokeByteOff _p 0 (fromBool hit :: CInt) - pokeByteOff _p 4 (realToFrac distance :: CFloat) - pokeByteOff _p 8 point - pokeByteOff _p 20 normal + poke (p'rayCollision'hit _p) (fromBool hit) + poke (p'rayCollision'distance _p) (realToFrac distance) + poke (p'rayCollision'point _p) point + poke (p'rayCollision'normal _p) normal return () +p'rayCollision'hit :: Ptr RayCollision -> Ptr CBool +p'rayCollision'hit = (`plusPtr` 0) + +p'rayCollision'distance :: Ptr RayCollision -> Ptr CFloat +p'rayCollision'distance = (`plusPtr` 4) + +p'rayCollision'point :: Ptr RayCollision -> Ptr Vector3 +p'rayCollision'point = (`plusPtr` 8) + +p'rayCollision'normal :: Ptr RayCollision -> Ptr Vector3 +p'rayCollision'normal = (`plusPtr` 20) + data BoundingBox = BoundingBox { boundingBox'min :: Vector3, boundingBox'max :: Vector3 @@ -603,10 +798,16 @@ instance Storable BoundingBox where sizeOf _ = 24 alignment _ = 4 peek _p = do - bMin <- peekByteOff _p 0 - bMax <- peekByteOff _p 12 + bMin <- peek (p'boundingBox'min _p) + bMax <- peek (p'boundingBox'max _p) return $ BoundingBox bMin bMax poke _p (BoundingBox bMin bMax) = do - pokeByteOff _p 0 bMin - pokeByteOff _p 12 bMax + poke (p'boundingBox'min _p) bMin + poke (p'boundingBox'max _p) bMax return () + +p'boundingBox'min :: Ptr BoundingBox -> Ptr Vector3 +p'boundingBox'min = (`plusPtr` 0) + +p'boundingBox'max :: Ptr BoundingBox -> Ptr Vector3 +p'boundingBox'max = (`plusPtr` 12) diff --git a/src/Raylib/Types/Core/Text.hs b/src/Raylib/Types/Core/Text.hs index 275af9b..65a3ec1 100644 --- a/src/Raylib/Types/Core/Text.hs +++ b/src/Raylib/Types/Core/Text.hs @@ -4,22 +4,36 @@ module Raylib.Types.Core.Text ( -- * Enumerations FontType (..), + -- * Structures GlyphInfo (..), Font (..), + + -- * Pointer utilities + p'glyphInfo'value, + p'glyphInfo'offsetX, + p'glyphInfo'offsetY, + p'glyphInfo'advanceX, + p'glyphInfo'image, + p'font'baseSize, + p'font'glyphCount, + p'font'glyphPadding, + p'font'texture, + p'font'recs, + p'font'glyphs, ) where import Foreign ( Ptr, - Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + Storable (alignment, peek, poke, sizeOf), castPtr, newArray, peekArray, + plusPtr, ) import Foreign.C ( CInt (..), - CUChar, ) import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, rlFreeArray) import Raylib.Types.Core (Rectangle) @@ -48,24 +62,39 @@ instance Storable GlyphInfo where sizeOf _ = 40 alignment _ = 4 peek _p = do - value <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - offsetX <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - offsetY <- fromIntegral <$> (peekByteOff _p 8 :: IO CInt) - advanceX <- fromIntegral <$> (peekByteOff _p 12 :: IO CInt) - image <- peekByteOff _p 16 + value <- fromIntegral <$> peek (p'glyphInfo'value _p) + offsetX <- fromIntegral <$> peek (p'glyphInfo'offsetX _p) + offsetY <- fromIntegral <$> peek (p'glyphInfo'offsetY _p) + advanceX <- fromIntegral <$> peek (p'glyphInfo'advanceX _p) + image <- peek (p'glyphInfo'image _p) return $ GlyphInfo value offsetX offsetY advanceX image poke _p (GlyphInfo value offsetX offsetY advanceX image) = do - pokeByteOff _p 0 (fromIntegral value :: CInt) - pokeByteOff _p 4 (fromIntegral offsetX :: CInt) - pokeByteOff _p 8 (fromIntegral offsetY :: CInt) - pokeByteOff _p 12 (fromIntegral advanceX :: CInt) - pokeByteOff _p 16 image + poke (p'glyphInfo'value _p) (fromIntegral value) + poke (p'glyphInfo'offsetX _p) (fromIntegral offsetX) + poke (p'glyphInfo'offsetY _p) (fromIntegral offsetY) + poke (p'glyphInfo'advanceX _p) (fromIntegral advanceX) + poke (p'glyphInfo'image _p) image return () +p'glyphInfo'value :: Ptr GlyphInfo -> Ptr CInt +p'glyphInfo'value = (`plusPtr` 0) + +p'glyphInfo'offsetX :: Ptr GlyphInfo -> Ptr CInt +p'glyphInfo'offsetX = (`plusPtr` 4) + +p'glyphInfo'offsetY :: Ptr GlyphInfo -> Ptr CInt +p'glyphInfo'offsetY = (`plusPtr` 8) + +p'glyphInfo'advanceX :: Ptr GlyphInfo -> Ptr CInt +p'glyphInfo'advanceX = (`plusPtr` 12) + +p'glyphInfo'image :: Ptr GlyphInfo -> Ptr Image +p'glyphInfo'image = (`plusPtr` 16) + instance Freeable GlyphInfo where rlFreeDependents _ ptr = do - dataPtr <- (peekByteOff ptr 16 :: IO (Ptr CUChar)) - c'free $ castPtr dataPtr + dataPtr <- peek (castPtr (p'glyphInfo'image ptr) :: Ptr (Ptr ())) -- TODO: Use p'image'data + c'free dataPtr data Font = Font { font'baseSize :: Int, @@ -81,27 +110,43 @@ instance Storable Font where sizeOf _ = 48 alignment _ = 4 peek _p = do - baseSize <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - glyphCount <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - glyphPadding <- fromIntegral <$> (peekByteOff _p 8 :: IO CInt) - texture <- peekByteOff _p 12 - recPtr <- (peekByteOff _p 32 :: IO (Ptr Rectangle)) - recs <- peekArray glyphCount recPtr - glyphPtr <- (peekByteOff _p 40 :: IO (Ptr GlyphInfo)) - glyphs <- peekArray glyphCount glyphPtr + baseSize <- fromIntegral <$> peek (p'font'baseSize _p) + glyphCount <- fromIntegral <$> peek (p'font'glyphCount _p) + glyphPadding <- fromIntegral <$> peek (p'font'glyphPadding _p) + texture <- peek (p'font'texture _p) + recs <- peekArray glyphCount =<< peek (p'font'recs _p) + glyphs <- peekArray glyphCount =<< peek (p'font'glyphs _p) return $ Font baseSize glyphCount glyphPadding texture recs glyphs poke _p (Font baseSize glyphCount glyphPadding texture recs glyphs) = do - pokeByteOff _p 0 (fromIntegral baseSize :: CInt) - pokeByteOff _p 4 (fromIntegral glyphCount :: CInt) - pokeByteOff _p 8 (fromIntegral glyphPadding :: CInt) - pokeByteOff _p 12 texture - pokeByteOff _p 32 =<< newArray recs - pokeByteOff _p 40 =<< newArray glyphs + poke (p'font'baseSize _p) (fromIntegral baseSize) + poke (p'font'glyphCount _p) (fromIntegral glyphCount) + poke (p'font'glyphPadding _p) (fromIntegral glyphPadding) + poke (p'font'texture _p) texture + poke (p'font'recs _p) =<< newArray recs + poke (p'font'glyphs _p) =<< newArray glyphs return () +p'font'baseSize :: Ptr Font -> Ptr CInt +p'font'baseSize = (`plusPtr` 0) + +p'font'glyphCount :: Ptr Font -> Ptr CInt +p'font'glyphCount = (`plusPtr` 4) + +p'font'glyphPadding :: Ptr Font -> Ptr CInt +p'font'glyphPadding = (`plusPtr` 8) + +p'font'texture :: Ptr Font -> Ptr Texture +p'font'texture = (`plusPtr` 12) + +-- array (font'glyphCount) +p'font'recs :: Ptr Font -> Ptr (Ptr Rectangle) +p'font'recs = (`plusPtr` 32) + +-- array (font'glyphCount) +p'font'glyphs :: Ptr Font -> Ptr (Ptr GlyphInfo) +p'font'glyphs = (`plusPtr` 40) + instance Freeable Font where rlFreeDependents val ptr = do - recsPtr <- (peekByteOff ptr 32 :: IO (Ptr Rectangle)) - c'free $ castPtr recsPtr - glyphsPtr <- (peekByteOff ptr 40 :: IO (Ptr GlyphInfo)) - rlFreeArray (font'glyphs val) glyphsPtr + c'free . castPtr =<< peek (p'font'recs ptr) + rlFreeArray (font'glyphs val) =<< peek (p'font'glyphs ptr) diff --git a/src/Raylib/Types/Core/Textures.hs b/src/Raylib/Types/Core/Textures.hs index eb55b91..1d1e9c8 100644 --- a/src/Raylib/Types/Core/Textures.hs +++ b/src/Raylib/Types/Core/Textures.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} + {-# OPTIONS -Wall #-} -- | Bindings for types used mainly in @rtextures@ @@ -9,6 +10,7 @@ module Raylib.Types.Core.Textures TextureWrap (..), CubemapLayout (..), NPatchLayout (..), + -- * Structures Image (..), Texture (..), @@ -17,24 +19,46 @@ module Raylib.Types.Core.Textures Texture2D, TextureCubemap, RenderTexture2D, + + -- * Pointer utilities + p'image'data, + p'image'width, + p'image'height, + p'image'mipmaps, + p'image'format, + p'texture'id, + p'texture'width, + p'texture'height, + p'texture'mipmaps, + p'texture'format, + p'renderTexture'id, + p'renderTexture'texture, + p'renderTexture'depth, + p'nPatchInfo'source, + p'nPatchInfo'left, + p'nPatchInfo'top, + p'nPatchInfo'right, + p'nPatchInfo'bottom, + p'nPatchInfo'layout, ) where import Foreign ( Ptr, - Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + Storable (alignment, peek, poke, sizeOf), Word8, castPtr, newArray, peekArray, + plusPtr, ) import Foreign.C ( CInt (..), CUChar, CUInt, ) -import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free) import Raylib.Internal (getPixelDataSize) +import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free) import Raylib.Types.Core (Rectangle) --------------------------------------- @@ -186,25 +210,39 @@ instance Storable Image where sizeOf _ = 24 alignment _ = 4 peek _p = do - width <- fromIntegral <$> (peekByteOff _p 8 :: IO CInt) - height <- fromIntegral <$> (peekByteOff _p 12 :: IO CInt) - mipmaps <- fromIntegral <$> (peekByteOff _p 16 :: IO CInt) - format <- peekByteOff _p 20 - ptr <- (peekByteOff _p 0 :: IO (Ptr CUChar)) - arr <- peekArray (getPixelDataSize width height (fromEnum format)) ptr - return $ Image (map fromIntegral arr) width height mipmaps format + width <- fromIntegral <$> peek (p'image'width _p) + height <- fromIntegral <$> peek (p'image'height _p) + mipmaps <- fromIntegral <$> peek (p'image'mipmaps _p) + format <- peek (p'image'format _p) + iData <- map fromIntegral <$> (peekArray (getPixelDataSize width height (fromEnum format)) =<< peek (p'image'data _p)) + return $ Image iData width height mipmaps format poke _p (Image arr width height mipmaps format) = do - pokeByteOff _p 0 =<< newArray (map fromIntegral arr :: [CUChar]) - pokeByteOff _p 8 (fromIntegral width :: CInt) - pokeByteOff _p 12 (fromIntegral height :: CInt) - pokeByteOff _p 16 (fromIntegral mipmaps :: CInt) - pokeByteOff _p 20 format + poke (p'image'data _p) =<< newArray (map fromIntegral arr) + poke (p'image'width _p) (fromIntegral width) + poke (p'image'height _p) (fromIntegral height) + poke (p'image'mipmaps _p) (fromIntegral mipmaps) + poke (p'image'format _p) format return () +-- array (getPixelDataSize image'width image'height (fromEnum image'format)) +p'image'data :: Ptr Image -> Ptr (Ptr CUChar) +p'image'data = (`plusPtr` 0) + +p'image'width :: Ptr Image -> Ptr CInt +p'image'width = (`plusPtr` 8) + +p'image'height :: Ptr Image -> Ptr CInt +p'image'height = (`plusPtr` 12) + +p'image'mipmaps :: Ptr Image -> Ptr CInt +p'image'mipmaps = (`plusPtr` 16) + +p'image'format :: Ptr Image -> Ptr PixelFormat +p'image'format = (`plusPtr` 20) + instance Freeable Image where rlFreeDependents _ ptr = do - dataPtr <- (peekByteOff ptr 0 :: IO (Ptr CUChar)) - c'free $ castPtr dataPtr + c'free . castPtr =<< peek (p'image'data ptr) data Texture = Texture { texture'id :: Integer, @@ -219,20 +257,35 @@ instance Storable Texture where sizeOf _ = 20 alignment _ = 4 peek _p = do - tId <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - width <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - height <- fromIntegral <$> (peekByteOff _p 8 :: IO CInt) - mipmaps <- fromIntegral <$> (peekByteOff _p 12 :: IO CInt) - format <- peekByteOff _p 16 + tId <- fromIntegral <$> peek (p'texture'id _p) + width <- fromIntegral <$> peek (p'texture'width _p) + height <- fromIntegral <$> peek (p'texture'height _p) + mipmaps <- fromIntegral <$> peek (p'texture'mipmaps _p) + format <- peek (p'texture'format _p) return $ Texture tId width height mipmaps format poke _p (Texture tId width height mipmaps format) = do - pokeByteOff _p 0 (fromIntegral tId :: CUInt) - pokeByteOff _p 4 (fromIntegral width :: CInt) - pokeByteOff _p 8 (fromIntegral height :: CInt) - pokeByteOff _p 12 (fromIntegral mipmaps :: CInt) - pokeByteOff _p 16 format + poke (p'texture'id _p) (fromIntegral tId) + poke (p'texture'width _p) (fromIntegral width) + poke (p'texture'height _p) (fromIntegral height) + poke (p'texture'mipmaps _p) (fromIntegral mipmaps) + poke (p'texture'format _p) format return () +p'texture'id :: Ptr Texture -> Ptr CUInt +p'texture'id = (`plusPtr` 0) + +p'texture'width :: Ptr Texture -> Ptr CInt +p'texture'width = (`plusPtr` 4) + +p'texture'height :: Ptr Texture -> Ptr CInt +p'texture'height = (`plusPtr` 8) + +p'texture'mipmaps :: Ptr Texture -> Ptr CInt +p'texture'mipmaps = (`plusPtr` 12) + +p'texture'format :: Ptr Texture -> Ptr PixelFormat +p'texture'format = (`plusPtr` 16) + type Texture2D = Texture type TextureCubemap = Texture @@ -248,16 +301,25 @@ instance Storable RenderTexture where sizeOf _ = 44 alignment _ = 4 peek _p = do - rtId <- fromIntegral <$> (peekByteOff _p 0 :: IO CUInt) - texture <- peekByteOff _p 4 - depth <- peekByteOff _p 24 + rtId <- fromIntegral <$> peek (p'renderTexture'id _p) + texture <- peek (p'renderTexture'texture _p) + depth <- peek (p'renderTexture'depth _p) return $ RenderTexture rtId texture depth poke _p (RenderTexture rtId texture depth) = do - pokeByteOff _p 0 (fromIntegral rtId :: CUInt) - pokeByteOff _p 4 texture - pokeByteOff _p 24 depth + poke (p'renderTexture'id _p) (fromIntegral rtId) + poke (p'renderTexture'texture _p) texture + poke (p'renderTexture'depth _p) depth return () +p'renderTexture'id :: Ptr RenderTexture -> Ptr CUInt +p'renderTexture'id = (`plusPtr` 0) + +p'renderTexture'texture :: Ptr RenderTexture -> Ptr Texture +p'renderTexture'texture = (`plusPtr` 4) + +p'renderTexture'depth :: Ptr RenderTexture -> Ptr Texture +p'renderTexture'depth = (`plusPtr` 24) + type RenderTexture2D = RenderTexture data NPatchInfo = NPatchInfo @@ -274,18 +336,36 @@ instance Storable NPatchInfo where sizeOf _ = 36 alignment _ = 4 peek _p = do - source <- peekByteOff _p 0 - left <- fromIntegral <$> (peekByteOff _p 16 :: IO CInt) - top <- fromIntegral <$> (peekByteOff _p 20 :: IO CInt) - right <- fromIntegral <$> (peekByteOff _p 24 :: IO CInt) - bottom <- fromIntegral <$> (peekByteOff _p 28 :: IO CInt) - layout <- peekByteOff _p 32 + source <- peek (p'nPatchInfo'source _p) + left <- fromIntegral <$> peek (p'nPatchInfo'left _p) + top <- fromIntegral <$> peek (p'nPatchInfo'top _p) + right <- fromIntegral <$> peek (p'nPatchInfo'right _p) + bottom <- fromIntegral <$> peek (p'nPatchInfo'bottom _p) + layout <- peek (p'nPatchInfo'layout _p) return $ NPatchInfo source left right top bottom layout poke _p (NPatchInfo source left right top bottom layout) = do - pokeByteOff _p 0 source - pokeByteOff _p 16 (fromIntegral left :: CInt) - pokeByteOff _p 20 (fromIntegral right :: CInt) - pokeByteOff _p 24 (fromIntegral top :: CInt) - pokeByteOff _p 28 (fromIntegral bottom :: CInt) - pokeByteOff _p 32 layout + poke (p'nPatchInfo'source _p) source + poke (p'nPatchInfo'left _p) (fromIntegral left) + poke (p'nPatchInfo'right _p) (fromIntegral right) + poke (p'nPatchInfo'top _p) (fromIntegral top) + poke (p'nPatchInfo'bottom _p) (fromIntegral bottom) + poke (p'nPatchInfo'layout _p) layout return () + +p'nPatchInfo'source :: Ptr NPatchInfo -> Ptr Rectangle +p'nPatchInfo'source = (`plusPtr` 0) + +p'nPatchInfo'left :: Ptr NPatchInfo -> Ptr CInt +p'nPatchInfo'left = (`plusPtr` 16) + +p'nPatchInfo'top :: Ptr NPatchInfo -> Ptr CInt +p'nPatchInfo'top = (`plusPtr` 20) + +p'nPatchInfo'right :: Ptr NPatchInfo -> Ptr CInt +p'nPatchInfo'right = (`plusPtr` 24) + +p'nPatchInfo'bottom :: Ptr NPatchInfo -> Ptr CInt +p'nPatchInfo'bottom = (`plusPtr` 28) + +p'nPatchInfo'layout :: Ptr NPatchInfo -> Ptr NPatchLayout +p'nPatchInfo'layout = (`plusPtr` 32) diff --git a/src/Raylib/Types/Util/GUI.hs b/src/Raylib/Types/Util/GUI.hs index 8f51f06..f16180a 100644 --- a/src/Raylib/Types/Util/GUI.hs +++ b/src/Raylib/Types/Util/GUI.hs @@ -23,15 +23,23 @@ module Raylib.Types.Util.GUI GuiListViewProperty (..), GuiColorPickerProperty (..), GuiIconName (..), + -- * Structures GuiStyleProp (..), + + -- * Pointer utilities + p'guiStyleProp'controlId, + p'guiStyleProp'propertyId, + p'guiStyleProp'propertyValue, ) where import Foreign - ( Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + ( Ptr, + Storable (alignment, peek, poke, sizeOf), Word16, castPtr, + plusPtr, ) import Foreign.C ( CInt (..), @@ -1441,12 +1449,21 @@ instance Storable GuiStyleProp where sizeOf _ = 8 alignment _ = 4 peek _p = do - controlId <- fromIntegral <$> (peekByteOff _p 0 :: IO CUShort) - propertyId <- fromIntegral <$> (peekByteOff _p 2 :: IO CUShort) - propertyValue <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) + controlId <- fromIntegral <$> peek (p'guiStyleProp'controlId _p) + propertyId <- fromIntegral <$> peek (p'guiStyleProp'propertyId _p) + propertyValue <- fromIntegral <$> peek (p'guiStyleProp'propertyValue _p) return $ GuiStyleProp controlId propertyId propertyValue poke _p (GuiStyleProp controlId propertyId propertyValue) = do - pokeByteOff _p 0 (fromIntegral controlId :: CUShort) - pokeByteOff _p 2 (fromIntegral propertyId :: CUShort) - pokeByteOff _p 4 (fromIntegral propertyValue :: CInt) + poke (p'guiStyleProp'controlId _p) (fromIntegral controlId) + poke (p'guiStyleProp'propertyId _p) (fromIntegral propertyId) + poke (p'guiStyleProp'propertyValue _p) (fromIntegral propertyValue) return () + +p'guiStyleProp'controlId :: Ptr GuiStyleProp -> Ptr CUShort +p'guiStyleProp'controlId = (`plusPtr` 0) + +p'guiStyleProp'propertyId :: Ptr GuiStyleProp -> Ptr CUShort +p'guiStyleProp'propertyId = (`plusPtr` 2) + +p'guiStyleProp'propertyValue :: Ptr GuiStyleProp -> Ptr CInt +p'guiStyleProp'propertyValue = (`plusPtr` 4) diff --git a/src/Raylib/Types/Util/RLGL.hs b/src/Raylib/Types/Util/RLGL.hs index 2f9aa8d..2b9bd26 100644 --- a/src/Raylib/Types/Util/RLGL.hs +++ b/src/Raylib/Types/Util/RLGL.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} + {-# OPTIONS -Wall #-} -- | Bindings for types used in @rlgl@ @@ -21,26 +22,47 @@ module Raylib.Types.Util.RLGL RLShaderType (..), RLBufferHint (..), RLBitField (..), + -- * Structures RLVertexBuffer (..), RLDrawCall (..), RLRenderBatch (..), + + -- * Pointer utilities + p'rlVertexBuffer'elementCount, + p'rlVertexBuffer'vertices, + p'rlVertexBuffer'texcoords, + p'rlVertexBuffer'colors, + p'rlVertexBuffer'indices, + p'rlVertexBuffer'vaoId, + p'rlVertexBuffer'vboId, + p'rlDrawCall'mode, + p'rlDrawCall'vertexCount, + p'rlDrawCall'vertexAlignment, + p'rlDrawCall'textureId, + p'rlRenderBatch'bufferCount, + p'rlRenderBatch'currentBuffer, + p'rlRenderBatch'vertexBuffers, + p'rlRenderBatch'draws, + p'rlRenderBatch'drawCounter, + p'rlRenderBatch'currentDepth, ) where import Foreign ( Ptr, - Storable (alignment, peek, peekByteOff, poke, pokeByteOff, sizeOf), + Storable (alignment, peek, poke, sizeOf), castPtr, newArray, peekArray, + plusPtr, ) import Foreign.C ( CFloat, CInt (..), CUInt, ) -import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArrayOff, pokeStaticArrayOff, rlFreeArray) +import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArray, pokeStaticArray, rlFreeArray) import Raylib.Types.Core (Color, Vector2, Vector3) --------------------------------------- @@ -786,40 +808,59 @@ instance Storable RLVertexBuffer where sizeOf _ = 64 alignment _ = 8 peek _p = do - elementCount <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - verticesPtr <- (peekByteOff _p 8 :: IO (Ptr Vector3)) - vertices <- peekArray elementCount verticesPtr - texcoordsPtr <- (peekByteOff _p 16 :: IO (Ptr Vector2)) - texcoords <- peekArray elementCount texcoordsPtr - colorsPtr <- (peekByteOff _p 24 :: IO (Ptr Color)) - colors <- peekArray elementCount colorsPtr - indicesPtr <- (peekByteOff _p 32 :: IO (Ptr CUInt)) - indices <- map fromIntegral <$> peekArray elementCount indicesPtr - vaoId <- fromIntegral <$> (peekByteOff _p 40 :: IO CUInt) - vboId <- map fromIntegral <$> peekStaticArrayOff 4 (castPtr _p :: Ptr CUInt) 44 + elementCount <- fromIntegral <$> peek (p'rlVertexBuffer'elementCount _p) + vertices <- peekArray elementCount =<< peek (p'rlVertexBuffer'vertices _p) + texcoords <- peekArray elementCount =<< peek (p'rlVertexBuffer'texcoords _p) + colors <- peekArray elementCount =<< peek (p'rlVertexBuffer'colors _p) + indices <- map fromIntegral <$> (peekArray elementCount =<< peek (p'rlVertexBuffer'indices _p)) + vaoId <- fromIntegral <$> peek (p'rlVertexBuffer'vaoId _p) + vboId <- map fromIntegral <$> peekStaticArray 4 (p'rlVertexBuffer'vboId _p) return $ RLVertexBuffer elementCount vertices texcoords colors indices vaoId vboId poke _p (RLVertexBuffer elementCount vertices texcoords colors indices vaoId vboId) = do - pokeByteOff _p 0 (fromIntegral elementCount :: CInt) - pokeByteOff _p 8 =<< newArray vertices - pokeByteOff _p 16 =<< newArray texcoords - pokeByteOff _p 24 =<< newArray colors - pokeByteOff _p 32 =<< newArray (map fromIntegral indices :: [CUInt]) - pokeByteOff _p 40 (fromIntegral vaoId :: CUInt) - pokeStaticArrayOff (castPtr _p) 44 (map fromIntegral vboId :: [CUInt]) + poke (p'rlVertexBuffer'elementCount _p) (fromIntegral elementCount) + poke (p'rlVertexBuffer'vertices _p) =<< newArray vertices + poke (p'rlVertexBuffer'texcoords _p) =<< newArray texcoords + poke (p'rlVertexBuffer'colors _p) =<< newArray colors + poke (p'rlVertexBuffer'indices _p) =<< newArray (map fromIntegral indices) + poke (p'rlVertexBuffer'vaoId _p) (fromIntegral vaoId) + pokeStaticArray (p'rlVertexBuffer'vboId _p) (map fromIntegral vboId) return () +p'rlVertexBuffer'elementCount :: Ptr RLVertexBuffer -> Ptr CInt +p'rlVertexBuffer'elementCount = (`plusPtr` 0) + +-- array (rlVertexBuffer'elementCount) +p'rlVertexBuffer'vertices :: Ptr RLVertexBuffer -> Ptr (Ptr Vector3) +p'rlVertexBuffer'vertices = (`plusPtr` 8) + +-- array (rlVertexBuffer'elementCount) +p'rlVertexBuffer'texcoords :: Ptr RLVertexBuffer -> Ptr (Ptr Vector2) +p'rlVertexBuffer'texcoords = (`plusPtr` 16) + +-- array (rlVertexBuffer'elementCount) +p'rlVertexBuffer'colors :: Ptr RLVertexBuffer -> Ptr (Ptr Color) +p'rlVertexBuffer'colors = (`plusPtr` 24) + +-- array (rlVertexBuffer'elementCount) +p'rlVertexBuffer'indices :: Ptr RLVertexBuffer -> Ptr (Ptr CUInt) +p'rlVertexBuffer'indices = (`plusPtr` 32) + +p'rlVertexBuffer'vaoId :: Ptr RLVertexBuffer -> Ptr CUInt +p'rlVertexBuffer'vaoId = (`plusPtr` 40) + +-- static array (4) +p'rlVertexBuffer'vboId :: Ptr RLVertexBuffer -> Ptr CUInt +p'rlVertexBuffer'vboId = (`plusPtr` 44) + instance Freeable RLVertexBuffer where rlFreeDependents _ ptr = do - verticesPtr <- (peekByteOff ptr 8 :: IO (Ptr Vector3)) - c'free $ castPtr verticesPtr - texcoordsPtr <- (peekByteOff ptr 16 :: IO (Ptr Vector2)) - c'free $ castPtr texcoordsPtr - colorsPtr <- (peekByteOff ptr 24 :: IO (Ptr Color)) - c'free $ castPtr colorsPtr - indicesPtr <- (peekByteOff ptr 32 :: IO (Ptr CUInt)) - c'free $ castPtr indicesPtr + c'free . castPtr =<< peek (p'rlVertexBuffer'vertices ptr) + c'free . castPtr =<< peek (p'rlVertexBuffer'texcoords ptr) + c'free . castPtr =<< peek (p'rlVertexBuffer'colors ptr) + c'free . castPtr =<< peek (p'rlVertexBuffer'indices ptr) -- | Draw call type. +-- -- NOTE: Only texture changes register a new draw, other state-change-related elements are not -- used at this moment (vaoId, shaderId, matrices), raylib just forces a batch draw call if any -- of those state changes happen (this is done in the core module). @@ -839,18 +880,30 @@ instance Storable RLDrawCall where sizeOf _ = 16 alignment _ = 8 peek _p = do - mode <- peekByteOff _p 0 - vertexCount <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - vertexAlignment <- fromIntegral <$> (peekByteOff _p 8 :: IO CInt) - textureId <- fromIntegral <$> (peekByteOff _p 12 :: IO CUInt) + mode <- peek (p'rlDrawCall'mode _p) + vertexCount <- fromIntegral <$> peek (p'rlDrawCall'vertexCount _p) + vertexAlignment <- fromIntegral <$> peek (p'rlDrawCall'vertexAlignment _p) + textureId <- fromIntegral <$> peek (p'rlDrawCall'textureId _p) return $ RLDrawCall mode vertexCount vertexAlignment textureId poke _p (RLDrawCall mode vertexCount vertexAlignment textureId) = do - pokeByteOff _p 0 mode - pokeByteOff _p 4 (fromIntegral vertexCount :: CInt) - pokeByteOff _p 8 (fromIntegral vertexAlignment :: CInt) - pokeByteOff _p 12 (fromIntegral textureId :: CUInt) + poke (p'rlDrawCall'mode _p) mode + poke (p'rlDrawCall'vertexCount _p) (fromIntegral vertexCount) + poke (p'rlDrawCall'vertexAlignment _p) (fromIntegral vertexAlignment) + poke (p'rlDrawCall'textureId _p) (fromIntegral textureId) return () +p'rlDrawCall'mode :: Ptr RLDrawCall -> Ptr RLDrawMode +p'rlDrawCall'mode = (`plusPtr` 0) + +p'rlDrawCall'vertexCount :: Ptr RLDrawCall -> Ptr CInt +p'rlDrawCall'vertexCount = (`plusPtr` 4) + +p'rlDrawCall'vertexAlignment :: Ptr RLDrawCall -> Ptr CInt +p'rlDrawCall'vertexAlignment = (`plusPtr` 8) + +p'rlDrawCall'textureId :: Ptr RLDrawCall -> Ptr CUInt +p'rlDrawCall'textureId = (`plusPtr` 12) + -- rlRenderBatch type data RLRenderBatch = RLRenderBatch { -- | Number of vertex buffers (multi-buffering support) @@ -872,27 +925,43 @@ instance Storable RLRenderBatch where sizeOf _ = 32 alignment _ = 8 peek _p = do - bufferCount <- fromIntegral <$> (peekByteOff _p 0 :: IO CInt) - currentBuffer <- fromIntegral <$> (peekByteOff _p 4 :: IO CInt) - vertexBuffersPtr <- (peekByteOff _p 8 :: IO (Ptr RLVertexBuffer)) - vertexBuffers <- peekArray bufferCount vertexBuffersPtr - drawsPtr <- (peekByteOff _p 16 :: IO (Ptr RLDrawCall)) - draws <- peekArray 256 drawsPtr - drawCounter <- fromIntegral <$> (peekByteOff _p 24 :: IO CInt) - currentDepth <- realToFrac <$> (peekByteOff _p 28 :: IO CFloat) + bufferCount <- fromIntegral <$> peek (p'rlRenderBatch'bufferCount _p) + currentBuffer <- fromIntegral <$> peek (p'rlRenderBatch'currentBuffer _p) + vertexBuffers <- peekArray bufferCount =<< peek (p'rlRenderBatch'vertexBuffers _p) + draws <- peekArray 256 =<< peek (p'rlRenderBatch'draws _p) + drawCounter <- fromIntegral <$> peek (p'rlRenderBatch'drawCounter _p) + currentDepth <- realToFrac <$> peek (p'rlRenderBatch'currentDepth _p) return $ RLRenderBatch bufferCount currentBuffer vertexBuffers draws drawCounter currentDepth poke _p (RLRenderBatch bufferCount currentBuffer vertexBuffers draws drawCounter currentDepth) = do - pokeByteOff _p 0 (fromIntegral bufferCount :: CInt) - pokeByteOff _p 4 (fromIntegral currentBuffer :: CInt) - pokeByteOff _p 8 =<< newArray vertexBuffers - pokeByteOff _p 16 =<< newArray draws - pokeByteOff _p 24 (fromIntegral drawCounter :: CInt) - pokeByteOff _p 28 (realToFrac currentDepth :: CFloat) + poke (p'rlRenderBatch'bufferCount _p) (fromIntegral bufferCount) + poke (p'rlRenderBatch'currentBuffer _p) (fromIntegral currentBuffer) + poke (p'rlRenderBatch'vertexBuffers _p) =<< newArray vertexBuffers + poke (p'rlRenderBatch'draws _p) =<< newArray draws + poke (p'rlRenderBatch'drawCounter _p) (fromIntegral drawCounter) + poke (p'rlRenderBatch'currentDepth _p) (realToFrac currentDepth) return () +p'rlRenderBatch'bufferCount :: Ptr RLRenderBatch -> Ptr CInt +p'rlRenderBatch'bufferCount = (`plusPtr` 0) + +p'rlRenderBatch'currentBuffer :: Ptr RLRenderBatch -> Ptr CInt +p'rlRenderBatch'currentBuffer = (`plusPtr` 4) + +-- array (rlRenderBatch'bufferCount) +p'rlRenderBatch'vertexBuffers :: Ptr RLRenderBatch -> Ptr (Ptr RLVertexBuffer) +p'rlRenderBatch'vertexBuffers = (`plusPtr` 8) + +-- array (256) +p'rlRenderBatch'draws :: Ptr RLRenderBatch -> Ptr (Ptr RLDrawCall) +p'rlRenderBatch'draws = (`plusPtr` 16) + +p'rlRenderBatch'drawCounter :: Ptr RLRenderBatch -> Ptr CInt +p'rlRenderBatch'drawCounter = (`plusPtr` 24) + +p'rlRenderBatch'currentDepth :: Ptr RLRenderBatch -> Ptr CFloat +p'rlRenderBatch'currentDepth = (`plusPtr` 28) + instance Freeable RLRenderBatch where rlFreeDependents val ptr = do - vertexBuffersPtr <- (peekByteOff ptr 8 :: IO (Ptr RLVertexBuffer)) - rlFreeArray (rlRenderBatch'vertexBuffers val) vertexBuffersPtr - drawsPtr <- (peekByteOff ptr 16 :: IO (Ptr RLDrawCall)) - c'free $ castPtr drawsPtr + rlFreeArray (rlRenderBatch'vertexBuffers val) =<< peek (p'rlRenderBatch'vertexBuffers ptr) + c'free . castPtr =<< peek (p'rlRenderBatch'draws ptr)