content: {-# 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,
  
      -- * Resource management
      WindowResources,
      Closeable (close),
      managed,
  
      -- * Miscellaneous
      cameraDirectionRay,
      setMaterialShader,
      inGHCi,
      inWeb,
      Freeable (..),
    )
  where
  
  import Control.Monad (void)
  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, Closeable (..), managed)
  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, (|-|)))
  import Control.Exception (bracket, bracket_)
  
  #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 ::
    -- | Window width
    Int ->
    -- | Window height
    Int ->
    -- | Window title
    String ->
    -- | Target FPS
    Int ->
    (WindowResources -> IO b) ->
    IO b
  withWindow w h title fps = bracket (liftIO $ initWindow w h title <* setTargetFPS fps) (liftIO . closeWindow . Just)
  
  drawing :: IO b -> IO b
  drawing = bracket_ (liftIO beginDrawing) (liftIO endDrawing)
  
  mode2D :: Camera2D -> IO b -> IO b
  mode2D camera = bracket_ (liftIO (beginMode2D camera)) (liftIO endMode2D)
  
  mode3D :: Camera3D -> IO b -> IO b
  mode3D camera = bracket_ (liftIO (beginMode3D camera)) (liftIO endMode3D)
  
  textureMode :: RenderTexture -> IO b -> IO b
  textureMode rt = bracket_ (liftIO (beginTextureMode rt)) (liftIO endTextureMode)
  
  shaderMode :: Shader -> IO b -> IO b
  shaderMode shader = bracket_ (liftIO (beginShaderMode shader)) (liftIO endShaderMode)
  
  blendMode :: BlendMode -> IO b -> IO b
  blendMode bm = bracket_ (liftIO (beginBlendMode bm)) (liftIO endBlendMode)
  
  scissorMode :: Int -> Int -> Int -> Int -> IO b -> IO b
  scissorMode x y width height = bracket_ (liftIO (beginScissorMode x y width height)) (liftIO endScissorMode)
  
  vrStereoMode :: VrStereoConfig -> IO b -> IO b
  vrStereoMode config = bracket_ (liftIO (beginVrStereoMode config)) (liftIO endVrStereoMode)
  
  -- | Gets the direction of a camera as a ray.
  cameraDirectionRay :: Camera3D -> Ray
  cameraDirectionRay camera = Ray (camera3D'position camera) (vectorNormalize $ camera3D'target camera |-| camera3D'position 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 startup mainLoop shouldClose teardown = do
    assertTypes startup mainLoop shouldClose teardown
  
    return
      [
        -- main :: IO ()
        SigD main (ConT ''IO `AppT` TupleT 0),
        -- main = runRaylibProgram startup mainLoop shouldClose teardown
        FunD main [Clause [] (NormalB ((((VarE 'runRaylibProgram `AppE` VarE startup) `AppE` VarE mainLoop) `AppE` VarE shouldClose) `AppE` VarE teardown)) []]
      ]
    where main = mkName "main"
  
  runRaylibProgram :: IO a -> (a -> IO a) -> (a -> IO Bool) -> (a -> IO ()) -> IO ()
  runRaylibProgram startup mainLoop shouldClose teardown = do
    st <- startup
    helper st
    where helper s = shouldClose s >>= (\toClose -> if toClose then teardown s else mainLoop s >>= helper)
  
  #endif
  
  assertTypes :: Name -> Name -> Name -> Name -> Q ()
  assertTypes startup mainLoop shouldClose teardown = do
    sut <- reifyType startup
    state <-
      case sut of
        m `AppT` st ->
          if m == ConT ''IO
            then return st
            else typeErr startup (ConT ''IO `AppT` ConT (mkName "AppState")) sut
        _ -> typeErr startup (ConT ''IO `AppT` ConT (mkName "AppState")) sut
  
    mlt <- reifyType mainLoop
    assertType mainLoop ((ArrowT `AppT` state) `AppT` (ConT ''IO `AppT` state)) mlt
  
    sct <- reifyType shouldClose
    assertType shouldClose ((ArrowT `AppT` state) `AppT` (ConT ''IO `AppT` ConT ''Bool)) sct
  
    tdt <- reifyType teardown
    assertType teardown ((ArrowT `AppT` state) `AppT` (ConT ''IO `AppT` TupleT 0)) tdt
  
  assertType :: Name -> Type -> Type -> Q ()
  assertType n expected actual = if expected == actual then return () else typeErr n expected actual
  
  typeErr :: Name -> Type -> Type -> a
  typeErr (Name (OccName n) _) expected actual =
    error (n ++ " was not the expected type\n\nexpected " ++ show (ppr expected) ++ "\n\ngot " ++ show (ppr actual) ++ "\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 f state = do
    newState <- f state
    shouldClose <- liftIO windowShouldClose
    if shouldClose
      then return newState
      else whileWindowOpen f newState
  
  -- | Same as `whileWindowOpen`, but discards the final state.
  whileWindowOpen_ ::
    (MonadIO m) =>
    (a -> m a) ->
    a ->
    m ()
  whileWindowOpen_ f state = void (whileWindowOpen f state)
  
  -- | Same as `whileWindowOpen`, but without application state.
  whileWindowOpen0 ::
    (MonadIO m) =>
    m () ->
    m ()
  whileWindowOpen0 f = whileWindowOpen (const 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 matIdx shader = model {model'materials = setIdx mats matIdx newMat}
    where
      mats = model'materials model
      newMat = (mats !! matIdx) {material'shader = shader}
      setIdx l i v = take i l ++ [v] ++ drop (i + 1) l
  
  -- | True if the program is running in GHCi
  inGHCi :: Bool
  
  #ifdef GHCI
  inGHCi = True
  #else
  inGHCi = False
  #endif
  
  -- | True if the program is running in the web
  inWeb :: Bool
  
  #ifdef WEB_FFI
  inWeb = True
  #else
  inWeb = False
  #endif
  