{-# OPTIONS -Wall #-}

module Raylib.Util (c'free, p'free, freeMaybePtr, Freeable (..), rlFreeArray, rlFreeMaybeArray, pop, popCArray, popCString, withFreeable, withArray2D, configsToBitflag, withMaybe, withMaybeCString, peekMaybe, peekMaybeOff, pokeMaybe, pokeMaybeOff, peekMaybeArray, newMaybeArray, peekStaticArray, peekStaticArrayOff, pokeStaticArray, pokeStaticArrayOff, rightPad) where

import Control.Monad (forM_, unless)
import Data.Bits ((.|.))
import Foreign (FunPtr, Ptr, Storable (peek, peekByteOff, poke, sizeOf), castPtr, free, malloc, newArray, nullPtr, peekArray, plusPtr, with)
import Foreign.C (CFloat, CInt, CString, CUChar, CUInt, peekCString, withCString)

-- Internal utility functions


foreign import ccall "stdlib.h free" c'free :: Ptr () -> IO ()

foreign import ccall "stdlib.h &free" p'free :: FunPtr (Ptr a -> IO ())

freeMaybePtr :: Ptr () -> IO ()
freeMaybePtr :: Ptr () -> IO ()
freeMaybePtr Ptr ()
ptr = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr ()
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) (Ptr () -> IO ()
c'free Ptr ()
ptr)

class Freeable a where
  rlFreeDependents :: a -> Ptr a -> IO ()
  rlFreeDependents a
_ Ptr a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

  rlFree :: a -> Ptr a -> IO ()
  rlFree a
val Ptr a
ptr = forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents a
val Ptr a
ptr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr () -> IO ()
c'free (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr)

instance Freeable CInt

instance Freeable CUInt

instance Freeable CUChar

instance Freeable CFloat

rlFreeArray :: (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray :: forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
arr forall a. Num a => a -> a -> a
- Int
1]
    ( \Int
i -> do
        let val :: a
val = [a]
arr forall a. [a] -> Int -> a
!! Int
i in forall a. Freeable a => a -> Ptr a -> IO ()
rlFreeDependents a
val (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr (Int
i forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf a
val))
    )
  Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr

rlFreeMaybeArray :: (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO ()
rlFreeMaybeArray :: forall a. (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO ()
rlFreeMaybeArray Maybe [a]
Nothing Ptr a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
rlFreeMaybeArray (Just [a]
arr) Ptr a
ptr = forall a. (Freeable a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray [a]
arr Ptr a
ptr

pop :: (Freeable a, Storable a) => Ptr a -> IO a
pop :: forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop Ptr a
ptr = do
  a
val <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
  forall a. Freeable a => a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr
  forall (m :: * -> *) a. Monad m => a -> m a
return a
val

popCArray :: (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray :: forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray Int
count Ptr a
ptr = do
  [a]
str <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr a
ptr
  Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr
  forall (m :: * -> *) a. Monad m => a -> m a
return [a]
str

popCString :: CString -> IO String
popCString :: CString -> IO String
popCString CString
ptr = do
  String
str <- CString -> IO String
peekCString CString
ptr
  Ptr () -> IO ()
c'free forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr CString
ptr
  forall (m :: * -> *) a. Monad m => a -> m a
return String
str

withFreeable :: (Freeable a, Storable a) => a -> (Ptr a -> IO b) -> IO b
withFreeable :: forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable a
val Ptr a -> IO b
f = do
  Ptr a
ptr <- forall a. Storable a => IO (Ptr a)
malloc
  forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val
  b
result <- Ptr a -> IO b
f Ptr a
ptr
  forall a. Freeable a => a -> Ptr a -> IO ()
rlFree a
val Ptr a
ptr
  forall (m :: * -> *) a. Monad m => a -> m a
return b
result

withArray2D :: (Storable a) => [[a]] -> (Ptr (Ptr a) -> IO b) -> IO b
withArray2D :: forall a b. Storable a => [[a]] -> (Ptr (Ptr a) -> IO b) -> IO b
withArray2D [[a]]
arr Ptr (Ptr a) -> IO b
func = do
  [Ptr a]
arrays <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Storable a => [a] -> IO (Ptr a)
newArray [[a]]
arr
  Ptr (Ptr a)
ptr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray [Ptr a]
arrays
  b
res <- Ptr (Ptr a) -> IO b
func Ptr (Ptr a)
ptr
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Ptr a]
arrays forall a. Ptr a -> IO ()
free
  forall a. Ptr a -> IO ()
free Ptr (Ptr a)
ptr
  forall (m :: * -> *) a. Monad m => a -> m a
return b
res

configsToBitflag :: (Enum a) => [a] -> Integer
configsToBitflag :: forall a. Enum a => [a] -> Integer
configsToBitflag = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Enum a => a -> Int -> Int
folder (forall a. Enum a => Int -> a
toEnum Int
0)
  where
    folder :: a -> Int -> Int
folder a
a Int
b = forall a. Enum a => a -> Int
fromEnum a
a forall a. Bits a => a -> a -> a
.|. Int
b

withMaybe :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe :: forall a b. Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe Maybe a
a Ptr a -> IO b
f = case Maybe a
a of
  (Just a
val) -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
val Ptr a -> IO b
f
  Maybe a
Nothing -> Ptr a -> IO b
f forall a. Ptr a
nullPtr

withMaybeCString :: Maybe String -> (CString -> IO b) -> IO b
withMaybeCString :: forall b. Maybe String -> (CString -> IO b) -> IO b
withMaybeCString Maybe String
a CString -> IO b
f = case Maybe String
a of
  (Just String
val) -> forall a. String -> (CString -> IO a) -> IO a
withCString String
val CString -> IO b
f
  Maybe String
Nothing -> CString -> IO b
f forall a. Ptr a
nullPtr

peekMaybe :: (Storable a) => Ptr (Ptr a) -> IO (Maybe a)
peekMaybe :: forall a. Storable a => Ptr (Ptr a) -> IO (Maybe a)
peekMaybe Ptr (Ptr a)
ptr = do
  Ptr a
ref <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
  if Ptr a
ref forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr a
ref

peekMaybeOff :: (Storable a) => Ptr (Ptr a) -> Int -> IO (Maybe a)
peekMaybeOff :: forall a. Storable a => Ptr (Ptr a) -> Int -> IO (Maybe a)
peekMaybeOff Ptr (Ptr a)
ptr Int
off = do
  Ptr a
ref <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr (Ptr a)
ptr Int
off
  if Ptr a
ref forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr a
ref

pokeMaybe :: (Storable a) => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe :: forall a. Storable a => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe Ptr (Ptr a)
ptr Maybe a
val = case Maybe a
val of
  Maybe a
Nothing -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr forall a. Ptr a
nullPtr
  Just a
a -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr

pokeMaybeOff :: (Storable a) => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff :: forall a. Storable a => Ptr (Ptr a) -> Int -> Maybe a -> IO ()
pokeMaybeOff Ptr (Ptr a)
ptr Int
off = forall a. Storable a => Ptr (Ptr a) -> Maybe a -> IO ()
pokeMaybe (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr (Ptr a)
ptr Int
off)

peekMaybeArray :: (Storable a) => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray :: forall a. Storable a => Int -> Ptr a -> IO (Maybe [a])
peekMaybeArray Int
size Ptr a
ptr = if Ptr a
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size Ptr a
ptr

newMaybeArray :: (Storable a) => Maybe [a] -> IO (Ptr a)
newMaybeArray :: forall a. Storable a => Maybe [a] -> IO (Ptr a)
newMaybeArray Maybe [a]
a = case Maybe [a]
a of
  (Just [a]
arr) -> forall a. Storable a => [a] -> IO (Ptr a)
newArray [a]
arr
  Maybe [a]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr

peekStaticArray :: (Storable a) => Int -> Ptr a -> IO [a]
peekStaticArray :: forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
size Ptr a
ptr = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {t} {b}.
(Eq t, Num t, Storable b) =>
t -> Ptr b -> [b] -> IO [b]
helper Int
size Ptr a
ptr []
  where
    helper :: t -> Ptr b -> [b] -> IO [b]
helper t
s Ptr b
p [b]
a =
      if t
s forall a. Eq a => a -> a -> Bool
== t
0
        then forall (m :: * -> *) a. Monad m => a -> m a
return [b]
a
        else do
          b
val <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
p
          t -> Ptr b -> [b] -> IO [b]
helper (t
s forall a. Num a => a -> a -> a
- t
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr b
p (forall a. Storable a => a -> Int
sizeOf b
val)) (b
val forall a. a -> [a] -> [a]
: [b]
a)

peekStaticArrayOff :: (Storable a) => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff :: forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
peekStaticArrayOff Int
size Ptr a
ptr Int
off = forall a. Storable a => Int -> Ptr a -> IO [a]
peekStaticArray Int
size (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr Int
off)

pokeStaticArray :: (Storable a) => Ptr a -> [a] -> IO ()
pokeStaticArray :: forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray Ptr a
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
pokeStaticArray Ptr a
ptr (a
x : [a]
xs) = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Int
sizeOf a
x) [a]
xs

pokeStaticArrayOff :: (Storable a) => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff :: forall a. Storable a => Ptr a -> Int -> [a] -> IO ()
pokeStaticArrayOff Ptr a
ptr Int
off = forall a. Storable a => Ptr a -> [a] -> IO ()
pokeStaticArray (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
ptr Int
off)

rightPad :: Int -> a -> [a] -> [a]
rightPad :: forall a. Int -> a -> [a] -> [a]
rightPad Int
size a
val [a]
arr = forall a. Int -> [a] -> [a]
take Int
size forall a b. (a -> b) -> a -> b
$ [a]
arr forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat a
val