module Engine.Sound.Device ( OpenAL.Device , allocate , create , destroy ) where import RIO import Sound.OpenAL qualified as OpenAL import UnliftIO.Resource qualified as Resource allocate :: ( Resource.MonadResource m , MonadUnliftIO m , MonadReader env m , HasLogFunc env ) => m (Resource.ReleaseKey, OpenAL.Device) allocate :: m (ReleaseKey, Device) allocate = do Device soundDevice <- m Device forall env (m :: * -> *). (MonadReader env m, HasLogFunc env, MonadUnliftIO m) => m Device create IO () soundDeviceDestroy <- m () -> m (IO ()) forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a) toIO (m () -> m (IO ())) -> m () -> m (IO ()) forall a b. (a -> b) -> a -> b $ Device -> m () forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env) => Device -> m () destroy Device soundDevice ReleaseKey soundDeviceKey <- IO () -> m ReleaseKey forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey Resource.register IO () soundDeviceDestroy pure (ReleaseKey soundDeviceKey, Device soundDevice) create :: ( MonadReader env m , HasLogFunc env , MonadUnliftIO m ) => m OpenAL.Device create :: m Device create = do Maybe String -> m (Maybe Device) forall (m :: * -> *). MonadIO m => Maybe String -> m (Maybe Device) OpenAL.openDevice Maybe String forall a. Maybe a Nothing m (Maybe Device) -> (Maybe Device -> m Device) -> m Device forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe Device Nothing -> do Utf8Builder -> m () forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError Utf8Builder "OpenAL: no devices" m Device forall (m :: * -> *) a. MonadIO m => m a exitFailure Just Device device -> do Device -> [ContextAttribute] -> m (Maybe Context) forall (m :: * -> *). MonadIO m => Device -> [ContextAttribute] -> m (Maybe Context) OpenAL.createContext Device device [] m (Maybe Context) -> (Maybe Context -> m Device) -> m Device forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe Context Nothing -> do Utf8Builder -> m () forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logError Utf8Builder "OpenAL.createContext failed" m Device forall (m :: * -> *) a. MonadIO m => m a exitFailure Just Context ctx -> do StateVar (Maybe Context) OpenAL.currentContext StateVar (Maybe Context) -> Maybe Context -> m () forall t a (m :: * -> *). (HasSetter t a, MonadIO m) => t -> a -> m () OpenAL.$=! Context -> Maybe Context forall a. a -> Maybe a Just Context ctx pure Device device destroy :: (MonadIO m, MonadReader env m, HasLogFunc env) => OpenAL.Device -> m () destroy :: Device -> m () destroy Device device = Device -> m Bool forall (m :: * -> *). MonadIO m => Device -> m Bool OpenAL.closeDevice Device device m Bool -> (Bool -> m ()) -> m () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Bool True -> () -> m () forall (f :: * -> *) a. Applicative f => a -> f a pure () Bool False -> Utf8Builder -> m () forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logWarn Utf8Builder "OpenAL: closeDevice error"