{-# OPTIONS -Wall #-}

module Raylib.Util (c'free, p'free, freeMaybePtr, Freeable (..), rlFreeArray, pop, popCArray, 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 (CInt, CString, CUInt, 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

rlFreeArray :: (Freeable a, Show a, Storable a) => [a] -> Ptr a -> IO ()
rlFreeArray :: forall a. (Freeable a, Show 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

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

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