{-# OPTIONS -Wall #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- | Utility functions that may be useful for an h-raylib application
module Raylib.Util
  ( -- * Bracket functions
    withWindow,
    drawing,
    mode2D,
    mode3D,
    textureMode,
    shaderMode,
    blendMode,
    scissorMode,
    vrStereoMode,

    -- * Game loop functions
    raylibApplication,
    whileWindowOpen,
    whileWindowOpen_,
    whileWindowOpen0,

    -- * Miscellaneous
    cameraDirectionRay,
    setMaterialShader,
    inGHCi,
    inWeb,
    WindowResources,
    Freeable (..),
  )
where

import Control.Monad (void)
import Control.Monad.Catch (MonadMask, bracket, bracket_)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Raylib.Core (beginBlendMode, beginDrawing, beginMode2D, beginMode3D, beginScissorMode, beginShaderMode, beginTextureMode, beginVrStereoMode, closeWindow, endBlendMode, endDrawing, endMode2D, endMode3D, endScissorMode, endShaderMode, endTextureMode, endVrStereoMode, initWindow, setTargetFPS, windowShouldClose)
import Raylib.Internal (WindowResources)
import Raylib.Internal.Foreign (Freeable (..))
import Raylib.Types
  ( BlendMode,
    Camera2D,
    Camera3D (camera3D'position, camera3D'target),
    Material (material'shader),
    Model (model'materials),
    Ray (Ray),
    RenderTexture,
    Shader,
    VrStereoConfig,
  )
import Raylib.Util.Math (Vector (vectorNormalize, (|-|)))

#ifdef WEB_FFI

import Foreign (Ptr, castPtrToStablePtr, castStablePtrToPtr, deRefStablePtr, freeStablePtr, newStablePtr)
import Language.Haskell.TH (Body (NormalB), Callconv (CCall), Clause (Clause), Dec (ForeignD, FunD, SigD), DecsQ, Exp (AppE, VarE), Foreign (ExportF), Name, Pat (VarP), Q, Type (AppT, ArrowT, ConT, TupleT), mkName, ppr, reifyType)
import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName))

#else

import Language.Haskell.TH (Name, DecsQ, Type (AppT, ConT, ArrowT, TupleT), Q, reifyType, mkName, ppr, Dec (SigD, FunD), Clause (Clause), Body (NormalB), Exp (VarE, AppE))
import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName))

#endif

-- | NOTE: Only for native targets. If your program is intended to
--         run on the web, use `raylibApplication` instead.
withWindow ::
  (MonadIO m, MonadMask m) =>
  -- | Window width
  Int ->
  -- | Window height
  Int ->
  -- | Window title
  String ->
  -- | Target FPS
  Int ->
  (WindowResources -> m b) ->
  m b
withWindow :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
Int -> Int -> String -> Int -> (WindowResources -> m b) -> m b
withWindow Int
w Int
h String
title Int
fps = m WindowResources
-> (WindowResources -> m ()) -> (WindowResources -> m b) -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO WindowResources -> m WindowResources
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WindowResources -> m WindowResources)
-> IO WindowResources -> m WindowResources
forall a b. (a -> b) -> a -> b
$ Int -> Int -> String -> IO WindowResources
initWindow Int
w Int
h String
title IO WindowResources -> IO () -> IO WindowResources
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> IO ()
setTargetFPS Int
fps) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (WindowResources -> IO ()) -> WindowResources -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowResources -> IO ()
closeWindow)

drawing :: (MonadIO m, MonadMask m) => m b -> m b
drawing :: forall (m :: * -> *) b. (MonadIO m, MonadMask m) => m b -> m b
drawing = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
beginDrawing) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endDrawing)

mode2D :: (MonadIO m, MonadMask m) => Camera2D -> m b -> m b
mode2D :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
Camera2D -> m b -> m b
mode2D Camera2D
camera = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Camera2D -> IO ()
beginMode2D Camera2D
camera)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endMode2D)

mode3D :: (MonadIO m, MonadMask m) => Camera3D -> m b -> m b
mode3D :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
Camera3D -> m b -> m b
mode3D Camera3D
camera = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Camera3D -> IO ()
beginMode3D Camera3D
camera)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endMode3D)

textureMode :: (MonadIO m, MonadMask m) => RenderTexture -> m b -> m b
textureMode :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
RenderTexture -> m b -> m b
textureMode RenderTexture
rt = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (RenderTexture -> IO ()
beginTextureMode RenderTexture
rt)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endTextureMode)

shaderMode :: (MonadIO m, MonadMask m) => Shader -> m b -> m b
shaderMode :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
Shader -> m b -> m b
shaderMode Shader
shader = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Shader -> IO ()
beginShaderMode Shader
shader)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endShaderMode)

blendMode :: (MonadIO m, MonadMask m) => BlendMode -> m b -> m b
blendMode :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
BlendMode -> m b -> m b
blendMode BlendMode
bm = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BlendMode -> IO ()
beginBlendMode BlendMode
bm)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endBlendMode)

scissorMode :: (MonadIO m, MonadMask m) => Int -> Int -> Int -> Int -> m b -> m b
scissorMode :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
Int -> Int -> Int -> Int -> m b -> m b
scissorMode Int
x Int
y Int
width Int
height = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> Int -> Int -> Int -> IO ()
beginScissorMode Int
x Int
y Int
width Int
height)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endScissorMode)

vrStereoMode :: (MonadIO m, MonadMask m) => VrStereoConfig -> m b -> m b
vrStereoMode :: forall (m :: * -> *) b.
(MonadIO m, MonadMask m) =>
VrStereoConfig -> m b -> m b
vrStereoMode VrStereoConfig
config = m () -> m () -> m b -> m b
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (VrStereoConfig -> IO ()
beginVrStereoMode VrStereoConfig
config)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
endVrStereoMode)

-- | Gets the direction of a camera as a ray.
cameraDirectionRay :: Camera3D -> Ray
cameraDirectionRay :: Camera3D -> Ray
cameraDirectionRay Camera3D
camera = Vector3 -> Vector3 -> Ray
Ray (Camera3D -> Vector3
camera3D'position Camera3D
camera) (Vector3 -> Vector3
forall a. Vector a => a -> a
vectorNormalize (Vector3 -> Vector3) -> Vector3 -> Vector3
forall a b. (a -> b) -> a -> b
$ Camera3D -> Vector3
camera3D'target Camera3D
camera Vector3 -> Vector3 -> Vector3
forall a. Vector a => a -> a -> a
|-| Camera3D -> Vector3
camera3D'position Camera3D
camera)

-- | Creates a raylib application using the given program functions. Supports
--   both native and web targets, so it is recommended for all programs. If
--   your program is intended only for native use, you may manually write a
--   @main@ function.
--
--   On a native (non-web) target, it simply creates a @main@ function that
--   uses the startup, mainLoop, shouldClose, and teardown functions. When
--   building with @platform-web@ enabled, it creates four @foreign export@
--   statements (@startup@, @mainLoop@, @shouldClose@, and @teardown@), which
--   will be called through the browser.
--
--   See @raygui-suite@ for an example of how to use it.
raylibApplication ::
  -- | The startup function, should be of type @IO AppState@
  Name ->
  -- | The mainLoop function, should be of type @AppState -> IO AppState@
  Name ->
  -- | The shouldClose function, should be of type @AppState -> IO Bool@
  Name ->
  -- | The teardown function, should be of type @AppState -> IO ()@
  Name ->
  DecsQ

#ifdef WEB_FFI

raylibApplication
  startup@(Name (OccName sun) _)
  mainLoop@(Name (OccName mln) _)
  shouldClose@(Name (OccName scn) _)
  teardown@(Name (OccName tdn) _) =
    do
      assertTypes startup mainLoop shouldClose teardown

      let _startupN = mkName ('_' : sun)
          _startupT = ConT ''IO `AppT` (ConT ''Ptr `AppT` TupleT 0)
          _startupS = SigD _startupN _startupT -- _startup :: IO (Ptr ())
          _startupF =
            -- _startup = startup >>= createStablePtr
            FunD
              _startupN
              [Clause [] (NormalB ((VarE '(>>=) `AppE` VarE startup) `AppE` VarE 'createStablePtr)) []]

      let _mainLoopN = mkName ('_' : mln)
          _mainLoopPtrN = mkName "ptr"
          _mainLoopT = (ArrowT `AppT` (ConT ''Ptr `AppT` TupleT 0)) `AppT` (ConT ''IO `AppT` (ConT ''Ptr `AppT` TupleT 0))
          _mainLoopS = SigD _mainLoopN _mainLoopT -- _mainLoop :: Ptr () -> IO (Ptr ())
          _mainLoopF =
            -- _mainLoop ptr = popStablePtr ptr >>= mainLoop >>= createStablePtr
            FunD
              _mainLoopN
              [ Clause
                  [VarP _mainLoopPtrN]
                  (NormalB ((VarE '(>>=) `AppE` ((VarE '(>>=) `AppE` (VarE 'popStablePtr `AppE` VarE _mainLoopPtrN)) `AppE` VarE mainLoop)) `AppE` VarE 'createStablePtr))
                  []
              ]

      let _shouldCloseN = mkName ('_' : scn)
          _shouldClosePtrN = mkName "ptr"
          _shouldCloseT = (ArrowT `AppT` (ConT ''Ptr `AppT` TupleT 0)) `AppT` (ConT ''IO `AppT` ConT ''Bool)
          _shouldCloseS = SigD _shouldCloseN _shouldCloseT -- _shouldClose :: Ptr () -> IO Bool
          _shouldCloseF =
            -- _shouldClose ptr = readStablePtr ptr >>= P.shouldClose
            FunD
              _shouldCloseN
              [ Clause
                  [VarP _shouldClosePtrN]
                  (NormalB ((VarE '(>>=) `AppE` (VarE 'readStablePtr `AppE` VarE _shouldClosePtrN)) `AppE` VarE shouldClose))
                  []
              ]

      let _teardownN = mkName ('_' : tdn)
          _teardownPtrN = mkName "ptr"
          _teardownT = (ArrowT `AppT` (ConT ''Ptr `AppT` TupleT 0)) `AppT` (ConT ''IO `AppT` TupleT 0)
          _teardownS = SigD _teardownN _teardownT -- _teardown :: Ptr () -> IO ()
          _teardownF =
            -- _teardown ptr = popStablePtr ptr >>= teardown
            FunD
              _teardownN
              [ Clause
                  [VarP _teardownPtrN]
                  (NormalB ((VarE '(>>=) `AppE` (VarE 'popStablePtr `AppE` VarE _teardownPtrN)) `AppE` VarE teardown))
                  []
              ]
      
      return
        [ _startupS,
          _startupF,
          _mainLoopS,
          _mainLoopF,
          _shouldCloseS,
          _shouldCloseF,
          _teardownS,
          _teardownF,
          ForeignD (ExportF CCall "startup" _startupN _startupT),
          ForeignD (ExportF CCall "mainLoop" _mainLoopN _mainLoopT),
          ForeignD (ExportF CCall "shouldClose" _shouldCloseN _shouldCloseT),
          ForeignD (ExportF CCall "teardown" _teardownN _teardownT)
        ]

createStablePtr :: a -> IO (Ptr ())
createStablePtr val = castStablePtrToPtr <$> newStablePtr val

readStablePtr :: Ptr () -> IO a
readStablePtr ptr = deRefStablePtr $ castPtrToStablePtr ptr

popStablePtr :: Ptr () -> IO a
popStablePtr ptr = do
  let sptr = castPtrToStablePtr ptr
  val <- deRefStablePtr sptr
  freeStablePtr sptr
  return val

#else

raylibApplication :: Name -> Name -> Name -> Name -> DecsQ
raylibApplication Name
startup Name
mainLoop Name
shouldClose Name
teardown = do
  Name -> Name -> Name -> Name -> Q ()
assertTypes Name
startup Name
mainLoop Name
shouldClose Name
teardown

  [Dec] -> DecsQ
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return
    [
      -- main :: IO ()
      Name -> Type -> Dec
SigD Name
main (Name -> Type
ConT ''IO Type -> Type -> Type
`AppT` Int -> Type
TupleT Int
0),
      -- main = runRaylibProgram startup mainLoop shouldClose teardown
      Name -> [Clause] -> Dec
FunD Name
main [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB ((((Name -> Exp
VarE 'runRaylibProgram Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
startup) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
mainLoop) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
shouldClose) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
teardown)) []]
    ]
  where main :: Name
main = String -> Name
mkName String
"main"

runRaylibProgram :: IO a -> (a -> IO a) -> (a -> IO Bool) -> (a -> IO ()) -> IO ()
runRaylibProgram :: forall a.
IO a -> (a -> IO a) -> (a -> IO Bool) -> (a -> IO ()) -> IO ()
runRaylibProgram IO a
startup a -> IO a
mainLoop a -> IO Bool
shouldClose a -> IO ()
teardown = do
  a
st <- IO a
startup
  a -> IO ()
helper a
st
  where helper :: a -> IO ()
helper a
s = a -> IO Bool
shouldClose a
s IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Bool
close -> if Bool
close then a -> IO ()
teardown a
s else a -> IO a
mainLoop a
s IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO ()
helper)

#endif

assertTypes :: Name -> Name -> Name -> Name -> Q ()
assertTypes :: Name -> Name -> Name -> Name -> Q ()
assertTypes Name
startup Name
mainLoop Name
shouldClose Name
teardown = do
  Type
sut <- Name -> Q Type
reifyType Name
startup
  Type
state <-
    case Type
sut of
      Type
m `AppT` Type
st ->
        if Type
m Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Type
ConT ''IO
          then Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
st
          else Name -> Type -> Type -> Q Type
forall a. Name -> Type -> Type -> a
typeErr Name
startup (Name -> Type
ConT ''IO Type -> Type -> Type
`AppT` Name -> Type
ConT (String -> Name
mkName String
"AppState")) Type
sut
      Type
_ -> Name -> Type -> Type -> Q Type
forall a. Name -> Type -> Type -> a
typeErr Name
startup (Name -> Type
ConT ''IO Type -> Type -> Type
`AppT` Name -> Type
ConT (String -> Name
mkName String
"AppState")) Type
sut

  Type
mlt <- Name -> Q Type
reifyType Name
mainLoop
  Name -> Type -> Type -> Q ()
assertType Name
mainLoop ((Type
ArrowT Type -> Type -> Type
`AppT` Type
state) Type -> Type -> Type
`AppT` (Name -> Type
ConT ''IO Type -> Type -> Type
`AppT` Type
state)) Type
mlt

  Type
sct <- Name -> Q Type
reifyType Name
shouldClose
  Name -> Type -> Type -> Q ()
assertType Name
shouldClose ((Type
ArrowT Type -> Type -> Type
`AppT` Type
state) Type -> Type -> Type
`AppT` (Name -> Type
ConT ''IO Type -> Type -> Type
`AppT` Name -> Type
ConT ''Bool)) Type
sct

  Type
tdt <- Name -> Q Type
reifyType Name
teardown
  Name -> Type -> Type -> Q ()
assertType Name
teardown ((Type
ArrowT Type -> Type -> Type
`AppT` Type
state) Type -> Type -> Type
`AppT` (Name -> Type
ConT ''IO Type -> Type -> Type
`AppT` Int -> Type
TupleT Int
0)) Type
tdt

assertType :: Name -> Type -> Type -> Q ()
assertType :: Name -> Type -> Type -> Q ()
assertType Name
n Type
expected Type
actual = if Type
expected Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
actual then () -> Q ()
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return () else Name -> Type -> Type -> Q ()
forall a. Name -> Type -> Type -> a
typeErr Name
n Type
expected Type
actual

typeErr :: Name -> Type -> Type -> a
typeErr :: forall a. Name -> Type -> Type -> a
typeErr (Name (OccName String
n) NameFlavour
_) Type
expected Type
actual =
  String -> a
forall a. HasCallStack => String -> a
error (String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" was not the expected type\n\nexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
expected) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\ngot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
actual) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")

-- | Calls the game loop every frame as long as the window is open.
--   For larger projects, instead of using this function, consider
--   making a custom game loop for flexibility.
--
--   NOTE: Only for native targets. If your program is intended to
--         run on the web, use `raylibApplication` instead.
whileWindowOpen ::
  (MonadIO m) =>
  -- | The game loop. Its only argument should be the current application state, and it should return a new state.
  (a -> m a) ->
  -- | The initial application state.
  a ->
  -- | The application state after the last frame.
  m a
whileWindowOpen :: forall (m :: * -> *) a. MonadIO m => (a -> m a) -> a -> m a
whileWindowOpen a -> m a
f a
state = do
  a
newState <- a -> m a
f a
state
  Bool
shouldClose <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
windowShouldClose
  if Bool
shouldClose
    then a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
newState
    else (a -> m a) -> a -> m a
forall (m :: * -> *) a. MonadIO m => (a -> m a) -> a -> m a
whileWindowOpen a -> m a
f a
newState

-- | Same as `whileWindowOpen`, but discards the final state.
whileWindowOpen_ ::
  (MonadIO m) =>
  (a -> m a) ->
  a ->
  m ()
whileWindowOpen_ :: forall (m :: * -> *) a. MonadIO m => (a -> m a) -> a -> m ()
whileWindowOpen_ a -> m a
f a
state = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((a -> m a) -> a -> m a
forall (m :: * -> *) a. MonadIO m => (a -> m a) -> a -> m a
whileWindowOpen a -> m a
f a
state)

-- | Same as `whileWindowOpen`, but without application state.
whileWindowOpen0 ::
  (MonadIO m) =>
  m () ->
  m ()
whileWindowOpen0 :: forall (m :: * -> *). MonadIO m => m () -> m ()
whileWindowOpen0 m ()
f = (() -> m ()) -> () -> m ()
forall (m :: * -> *) a. MonadIO m => (a -> m a) -> a -> m a
whileWindowOpen (m () -> () -> m ()
forall a b. a -> b -> a
const m ()
f) ()

-- | Sets the shader of a material at a specific index (WARNING: This will fail
-- if the index provided is out of bounds).
setMaterialShader ::
  -- | The model to operate on
  Model ->
  -- | The index of the material
  Int ->
  -- | The shader to use
  Shader ->
  -- | The modified model
  Model
setMaterialShader :: Model -> Int -> Shader -> Model
setMaterialShader Model
model Int
matIdx Shader
shader = Model
model {model'materials = setIdx mats matIdx newMat}
  where
    mats :: [Material]
mats = Model -> [Material]
model'materials Model
model
    newMat :: Material
newMat = ([Material]
mats [Material] -> Int -> Material
forall a. HasCallStack => [a] -> Int -> a
!! Int
matIdx) {material'shader = shader}
    setIdx :: [a] -> Int -> a -> [a]
setIdx [a]
l Int
i a
v = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
v] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
l

-- | True if the program is running in GHCi
inGHCi :: Bool

#ifdef GHCI
inGHCi = True
#else
inGHCi :: Bool
inGHCi = Bool
False
#endif

-- | True if the program is running in the web
inWeb :: Bool

#ifdef WEB_FFI
inWeb = True
#else
inWeb :: Bool
inWeb = Bool
False
#endif