{-# LANGUAGE FlexibleInstances #-}

module Gamgine.Utils where
#include "Gamgine/Utils.cpp"
import Gamgine.Control ((?))
import Prelude hiding (catch)
import qualified Data.ByteString.Lazy   as BL
import qualified Data.ByteString.Unsafe as BU
import qualified Data.List as L
import System.IO (hPutStrLn, stderr)
import Control.Exception (catch, SomeException)
import Data.Array.Storable
import Data.List
import Data.Bits ((.|.), shiftL)
import Data.Word
import Foreign.Ptr
import Gamgine.System
import Debug.Trace

count :: Eq a => a -> [a] -> Int
count :: forall a. Eq a => a -> [a] -> Int
count a
x [a]
ys = a -> Int -> [a] -> Int
forall {a} {t}. (Eq a, Num t) => a -> t -> [a] -> t
go a
x Int
0 [a]
ys
   where
      go :: a -> t -> [a] -> t
go a
x t
num []     = t
num
      go a
x t
num (a
y:[a]
ys) = a -> t -> [a] -> t
go a
x (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> t -> t -> t
forall a. Bool -> a -> a -> a
? t
num t -> t -> t
forall a. Num a => a -> a -> a
+ t
1 (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ t
num) [a]
ys

-- | replace all entries in 'as' by 'new' for which 'f' returns true
replaceBy :: (a -> Bool) -> a -> [a] -> [a]
replaceBy :: forall a. (a -> Bool) -> a -> [a] -> [a]
replaceBy a -> Bool
f a
new [a]
as = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> if a -> Bool
f a
a then a
new else a
a) [a]
as


errorsToStderr :: IO () -> IO ()
errorsToStderr :: IO () -> IO ()
errorsToStderr IO ()
action =
   IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
action (\SomeException
e -> do String
pn <- IO String
normalizedProgName
                          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException)))

showValue :: Show a => String -> a -> String
showValue :: forall a. Show a => String -> a -> String
showValue String
name a
value = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
value) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

sv :: Show a => String -> a -> String
sv :: forall a. Show a => String -> a -> String
sv = String -> a -> String
forall a. Show a => String -> a -> String
showValue

for_ :: [a] -> (a -> b) -> [b]
for_ :: forall a b. [a] -> (a -> b) -> [b]
for_ [a]
as a -> b
f = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
as

maybe_ :: Maybe a -> b -> (a -> b) -> b
maybe_ :: forall a b. Maybe a -> b -> (a -> b) -> b
maybe_ Maybe a
m b
dflt a -> b
f = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
dflt a -> b
f Maybe a
m

-- both lists have to be sorted ascending
firstFreeId :: Eq a => [a] -> [a] -> a
firstFreeId :: forall a. Eq a => [a] -> [a] -> a
firstFreeId [a]
usedIds [a]
allIds = [a] -> [a] -> a
forall a. Eq a => [a] -> [a] -> a
go [a]
usedIds [a]
allIds
   where
      go :: [a] -> [a] -> a
go      [a]
_ []     = String -> a
forall a. HasCallStack => String -> a
ERROR "Ups, all ids used!"
      go     [] (a
a:[a]
as) = a
a
      go (a
u:[a]
us) (a
a:[a]
as) = a
u a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
? a
a (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> a
go [a]
us [a]
as


word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word Word8
a Word8
b Word8
c Word8
d =  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)
                Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d            )


bytesFromPointer :: Int -> Ptr Word8 -> IO BL.ByteString
bytesFromPointer :: Int -> Ptr Word8 -> IO ByteString
bytesFromPointer Int
n Ptr Word8
ptr = do
    ByteString
s <- CStringLen -> IO ByteString
BU.unsafePackCStringLen (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Int
n)
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
BL.fromChunks [ByteString
s]


bytesFromStorableArray :: Int -> StorableArray (Int, Int) Word8 -> IO BL.ByteString
bytesFromStorableArray :: Int -> StorableArray (Int, Int) Word8 -> IO ByteString
bytesFromStorableArray Int
n StorableArray (Int, Int) Word8
array = do
   ByteString
bytes <- StorableArray (Int, Int) Word8
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall i e a. StorableArray i e -> (Ptr e -> IO a) -> IO a
withStorableArray StorableArray (Int, Int) Word8
array (Int -> Ptr Word8 -> IO ByteString
bytesFromPointer Int
n)
   ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes


#if (MIN_VERSION_base(4,9,0))
instance MonadFail (Either String) where
   fail :: forall a. String -> Either String a
fail = String -> Either String a
forall a b. a -> Either a b
Left
#endif