diff --git a/minipat-live/src/Minipat/Live/Attrs.hs b/minipat-live/src/Minipat/Live/Attrs.hs index 53f4c92..83fae9c 100644 --- a/minipat-live/src/Minipat/Live/Attrs.hs +++ b/minipat-live/src/Minipat/Live/Attrs.hs @@ -22,7 +22,7 @@ module Minipat.Live.Attrs , attrsTryLookup , attrsUnalias , Attr (..) - , IsAttrs (..) + , ToAttrs (..) , attrsMerge ) where @@ -110,24 +110,24 @@ attrsUnalias as m0 = foldM go m0 as Nothing -> pure m Just v -> attrsTryInsert y v (attrsDelete x m) --- | For when you need something anonymous with an 'IsAttrs' instance. +-- | For when you need something anonymous with an 'ToAttrs' instance. data Attr a = Attr { attrKey :: !Text , attrVal :: !a } deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) -class IsAttrs a where +class ToAttrs a where toAttrs :: a -> Attrs -instance (IsDatum a) => IsAttrs (Attr a) where +instance (IsDatum a) => ToAttrs (Attr a) where toAttrs (Attr k v) = attrsSingleton k (toDatum v) -instance IsAttrs Attrs where +instance ToAttrs Attrs where toAttrs = id -instance (IsAttrs a) => IsAttrs (Maybe a) where +instance (ToAttrs a) => ToAttrs (Maybe a) where toAttrs = maybe mempty toAttrs -attrsMerge :: (IsAttrs a, IsAttrs b) => a -> b -> Attrs +attrsMerge :: (ToAttrs a, ToAttrs b) => a -> b -> Attrs attrsMerge a b = toAttrs a <> toAttrs b diff --git a/minipat-live/src/Minipat/Live/Boot.hs b/minipat-live/src/Minipat/Live/Boot.hs index 827f90e..558638a 100644 --- a/minipat-live/src/Minipat/Live/Boot.hs +++ b/minipat-live/src/Minipat/Live/Boot.hs @@ -47,7 +47,7 @@ import Data.Default (Default (..)) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Kind (Type) import Minipat.EStream (EStream) -import Minipat.Live.Attrs (Attrs, IsAttrs) +import Minipat.Live.Attrs (Attrs, ToAttrs) import Minipat.Live.Backend qualified as B import Minipat.Live.Combinators import Minipat.Live.Core qualified as C @@ -116,7 +116,7 @@ setCycle x = readLiveSt >>= \st -> C.setCycle st x setTempo :: (LiveSt) => Rational -> IO () setTempo x = readLiveSt >>= \st -> C.setTempo st x -setOrbit :: (LiveSt, IsAttrs a) => Integer -> EStream a -> IO () +setOrbit :: (LiveSt, ToAttrs a) => Integer -> EStream a -> IO () setOrbit x y = readLiveSt >>= \st -> C.setOrbit st x y clearOrbit :: (LiveSt) => Integer -> IO () @@ -147,10 +147,10 @@ checkTasks = readLiveSt >>= void . C.checkTasks peek :: (LiveSt, Pretty a) => EStream a -> IO () peek x = readLiveSt >>= \st -> C.peek st x -d :: (LiveSt, IsAttrs a) => Integer -> EStream a -> IO () +d :: (LiveSt, ToAttrs a) => Integer -> EStream a -> IO () d = setOrbit -d0, d1, d2, d3, d4, d5, d6, d7 :: (LiveSt, IsAttrs a) => EStream a -> IO () +d0, d1, d2, d3, d4, d5, d6, d7 :: (LiveSt, ToAttrs a) => EStream a -> IO () d0 = d 0 d1 = d 1 d2 = d 2 diff --git a/minipat-live/src/Minipat/Live/Combinators.hs b/minipat-live/src/Minipat/Live/Combinators.hs index 7ea2130..bf19bd9 100644 --- a/minipat-live/src/Minipat/Live/Combinators.hs +++ b/minipat-live/src/Minipat/Live/Combinators.hs @@ -28,12 +28,12 @@ import Data.Sequence qualified as Seq import Minipat.Classes (Flow (..)) import Minipat.EStream (EStream) import Minipat.EStream qualified as E -import Minipat.Live.Attrs (Attrs, IsAttrs, attrsMerge) +import Minipat.Live.Attrs (Attrs, ToAttrs, attrsMerge) import Minipat.Time (CycleDelta, CycleTime) type S = EStream -setIn, (#) :: (IsAttrs a, IsAttrs b) => S a -> S b -> S Attrs +setIn, (#) :: (ToAttrs a, ToAttrs b) => S a -> S b -> S Attrs setIn = flowInnerApply attrsMerge (#) = setIn diff --git a/minipat-live/src/Minipat/Live/Core.hs b/minipat-live/src/Minipat/Live/Core.hs index cad529f..e8d9079 100644 --- a/minipat-live/src/Minipat/Live/Core.hs +++ b/minipat-live/src/Minipat/Live/Core.hs @@ -58,7 +58,7 @@ import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as T import Minipat.EStream (EStream (..)) -import Minipat.Live.Attrs (Attrs, IsAttrs (..)) +import Minipat.Live.Attrs (Attrs, ToAttrs (..)) import Minipat.Live.Backend (Backend (..), Callback (..), UninitErr (..), WithPlayMeta) import Minipat.Live.Exception (catchUserErr) import Minipat.Live.Logger (LogAction, logDebug, logException, logInfo, logWarn, nullLogger) @@ -273,13 +273,13 @@ updateOrbits st f = atomically $ do let z = foldl' (\x (o, y) -> x <> fmap (WithOrbit o) y) mempty (Map.toList m') writeTVar (domStream dom) z -setOrbit :: (IsAttrs a) => St i -> Integer -> EStream a -> IO () +setOrbit :: (ToAttrs a) => St i -> Integer -> EStream a -> IO () setOrbit st o es = case unEStream es of Left e -> logException (stLogger st) ("Error setting orbit " <> T.pack (show o)) e Right s -> setOrbit' st o s -setOrbit' :: (IsAttrs a) => St i -> Integer -> Stream a -> IO () +setOrbit' :: (ToAttrs a) => St i -> Integer -> Stream a -> IO () setOrbit' st o s = updateOrbits st (Map.insert o (fmap toAttrs s)) clearOrbit :: St i -> Integer -> IO () diff --git a/minipat-live/src/Minipat/Live/Extra.hs b/minipat-live/src/Minipat/Live/Extra.hs index 200812f..aa684b0 100644 --- a/minipat-live/src/Minipat/Live/Extra.hs +++ b/minipat-live/src/Minipat/Live/Extra.hs @@ -33,7 +33,7 @@ import Looksee qualified as L import Minipat.Ast (Ident (..), Select (..)) import Minipat.EStream (EStream (..)) import Minipat.Eval (evalPat) -import Minipat.Live.Attrs (Attr (..), IsAttrs (..), attrsInsert, attrsSingleton) +import Minipat.Live.Attrs (Attr (..), ToAttrs (..), attrsInsert, attrsSingleton) import Minipat.Live.Combinators (S) import Minipat.Live.Datum (DatumProxy (..)) import Minipat.Live.Notes @@ -108,7 +108,7 @@ data Sound = Sound instance Pretty Sound where pretty (Sound so mn) = pretty so <> maybe mempty ((":" <>) . pretty) mn -instance IsAttrs Sound where +instance ToAttrs Sound where toAttrs (Sound so mn) = attrsInsert "sound" (DatumString (unIdent so)) (toAttrs mn) soundP :: P Sound @@ -125,7 +125,7 @@ newtype Note = Note {unNote :: Int32} deriving stock (Show) deriving newtype (Eq, Ord, Pretty) -instance IsAttrs Note where +instance ToAttrs Note where toAttrs (Note x) = attrsSingleton "note" (DatumInt32 x) noteLinOffset :: Integer diff --git a/minipat-live/src/Minipat/Live/OscRpc.hs b/minipat-live/src/Minipat/Live/OscRpc.hs index 6e4abea..92f03ec 100644 --- a/minipat-live/src/Minipat/Live/OscRpc.hs +++ b/minipat-live/src/Minipat/Live/OscRpc.hs @@ -39,7 +39,7 @@ import Data.Sequence (Seq (..)) import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as T -import Minipat.Live.Attrs (Attrs, IsAttrs (..), attrsSingleton, attrsToList) +import Minipat.Live.Attrs (Attrs, ToAttrs (..), attrsSingleton, attrsToList) import Minipat.Live.Convert (ConvErr, ConvM, runConvM) import Minipat.Live.EnumString (EnumString, allEnumStrings) import Nanotime (PosixTime, TimeDelta) @@ -77,18 +77,24 @@ newtype RequestId = RequestId {unRequestId :: Int32} deriving stock (Show) deriving newtype (Eq, Ord, Num, Enum) -instance IsAttrs RequestId where +instance ToAttrs RequestId where toAttrs (RequestId x) = attrsSingleton "!requestId" (DatumInt32 x) +lookupRequestId :: Attrs -> Maybe RequestId +lookupRequestId = error "TODO" + newtype RemoteErr = RemoteErr {unRemoteErr :: Text} deriving stock (Show) deriving newtype (Eq, Ord) instance Exception RemoteErr -instance IsAttrs RemoteErr where +instance ToAttrs RemoteErr where toAttrs (RemoteErr x) = attrsSingleton "!error" (DatumString x) +lookupRemoteErr :: Attrs -> Maybe RemoteErr +lookupRemoteErr = undefined + data RpcErr = -- | Remote side signaled an error RpcErrRemote !RemoteErr @@ -130,13 +136,13 @@ data Waiter c where Waiter :: RequestId -> c r -> RawAddrPat -> PosixTime -> WaitVar r -> Waiter c waiterMatches :: Msg -> Waiter c -> Bool -waiterMatches = error "TODO" +waiterMatches m w = error "TODO" waiterExpired :: PosixTime -> Waiter c -> Bool -waiterExpired = error "TODO" +waiterExpired t w = error "TODO" waiterRun :: Msg -> Waiter c -> IO (Either RpcErr ()) -waiterRun = error "TODO" +waiterRun m w = error "TODO" data OscProtoEnv c = OscProtoEnv { opeTimeout :: !TimeDelta @@ -147,16 +153,16 @@ data OscProtoEnv c = OscProtoEnv newOscProtoEnvIO :: TimeDelta -> RequestId -> IO (OscProtoEnv c) newOscProtoEnvIO to rid = OscProtoEnv to <$> newTVarIO rid <*> newTVarIO Empty --- TODO finish implementing +expireWaiters :: OscProtoEnv c -> PosixTime -> IO () +expireWaiters (OscProtoEnv _to _ _wes) _now = error "TODO" --- expireWaiters :: OscProtoEnv c -> PosixTime -> IO Int --- expireWaiters (OscProtoEnv _to _ _wes) _now = error "TODO" +handleRecvMsg :: OscProtoEnv c -> Msg -> IO (Either RpcErr a) +handleRecvMsg = error "TODO" --- handleRecvMsg :: OscProtoEnv c -> Msg -> IO (Either RpcErr a) --- handleRecvMsg = error "TODO" +sendMsgWith :: (RpcCmd t c) => (Msg -> IO ()) -> OscProtoEnv c -> c r -> IO (WaitVar r) +sendMsgWith _send _ope _cmd = error "TODO" --- sendMsgWith :: (RpcCmd t c) => (Msg -> IO ()) -> OscProtoEnv c -> c r -> IO (WaitVar r) --- sendMsgWith send ope cmd = error "TODO" +-- TODO finish implementing -- data OscTaskEnv c a = OscTaskEnv -- { oteSend :: !(Msg -> IO ()) diff --git a/minipat-midi/src/Minipat/Midi/Convert.hs b/minipat-midi/src/Minipat/Midi/Convert.hs index db83f31..85b38e8 100644 --- a/minipat-midi/src/Minipat/Midi/Convert.hs +++ b/minipat-midi/src/Minipat/Midi/Convert.hs @@ -8,7 +8,7 @@ import Dahdit.Midi.Osc (Datum (..)) import Data.Default (def) import Data.Functor ((<&>)) import Data.Int (Int32) -import Minipat.Live.Attrs (Attrs, IsAttrs (..), attrsSingleton) +import Minipat.Live.Attrs (Attrs, ToAttrs (..), attrsSingleton) import Minipat.Live.Convert (Branch (..), ConvErr, ConvM, branchM, defaultM, lookupM, runConvM) import Minipat.Live.Datum (DatumProxy (..)) import Minipat.Midi.Midi (PortData (..), psFromText) @@ -17,7 +17,7 @@ newtype Vel = Vel {unVel :: Int32} deriving stock (Show) deriving newtype (Eq, Ord, Num, Integral, Real, Enum) -instance IsAttrs Vel where +instance ToAttrs Vel where toAttrs (Vel x) = attrsSingleton "vel" (DatumInt32 x) -- TODO support more: diff --git a/minipat-midi/src/Minipat/Midi/Midi.hs b/minipat-midi/src/Minipat/Midi/Midi.hs index c00fe6a..e2dc2c6 100644 --- a/minipat-midi/src/Minipat/Midi/Midi.hs +++ b/minipat-midi/src/Minipat/Midi/Midi.hs @@ -72,7 +72,7 @@ import Libremidi.Common ) import Libremidi.Foreign qualified as LMF import Libremidi.Simple qualified as LMS -import Minipat.Live.Attrs (IsAttrs (..), attrsSingleton) +import Minipat.Live.Attrs (ToAttrs (..), attrsSingleton) import Minipat.Live.Logger (LogAction, logError, logWarn) import Minipat.Midi.Count (CountM, throwErrM) import Nanotime (PosixTime, TimeDelta, threadDelayDelta) @@ -110,7 +110,7 @@ psFromText t = instance Pretty PortSel where pretty = pretty . psToText -instance IsAttrs PortSel where +instance ToAttrs PortSel where toAttrs = attrsSingleton "port" . DatumString . psToText instance Default PortSel where diff --git a/minipat-rns/minipat-rns.cabal b/minipat-rns/minipat-rns.cabal index 4410d5d..2d06598 100644 --- a/minipat-rns/minipat-rns.cabal +++ b/minipat-rns/minipat-rns.cabal @@ -25,6 +25,7 @@ source-repository head library exposed-modules: Minipat.Rns + Minipat.Rns.Song other-modules: Paths_minipat_rns hs-source-dirs: diff --git a/minipat-rns/src/Minipat/Rns/Song.hs b/minipat-rns/src/Minipat/Rns/Song.hs new file mode 100644 index 0000000..fd1cba2 --- /dev/null +++ b/minipat-rns/src/Minipat/Rns/Song.hs @@ -0,0 +1,309 @@ +module Minipat.Rns.Song where +import Control.Monad.Identity (Identity) +import Data.Kind (Type) +import GHC.Generics (Generic) +import Minipat.Live.Attrs (Attrs) + +newtype TrackId = TrackId { unTrackId :: Int } deriving stock (Eq, Ord, Show) +newtype GroupId = GroupId { unGroupId :: Int } deriving stock (Eq, Ord, Show) +newtype InstId = InstId { unInstId :: Int } deriving stock (Eq, Ord, Show) + +newtype PatIx = PatIx { unPatIx :: Int } deriving stock (Eq, Ord, Show) +newtype SeqIx = SeqIx { unSeqIx :: Int } deriving stock (Eq, Ord, Show) +newtype LineIx = LineIx { unLineIx :: Int } deriving stock (Eq, Ord, Show) +newtype TrackIx = TrackIx { unTrackIx :: Int } deriving stock (Eq, Ord, Show) +newtype ColIx = ColIx { unColIx :: Int } deriving stock (Eq, Ord, Show) + +data SongPos = SongPos + { spSeq :: !SeqIx + , spLine :: !LineIx + } deriving stock (Eq, Ord, Show) + +data PatSelPos = PatSelPos + { pssLine :: !LineIx + , pssTrack :: !TrackIx + , pssCol :: !ColIx + } deriving stock (Eq, Ord, Show) + +data PatSel = PatSel + { pasStart :: !(Maybe PatSelPos) + , pasEnd :: !(Maybe PatSelPos) + } deriving stock (Eq, Ord, Show) + +data PhraseSelPos = PhraseSelPos + { pspLine :: !LineIx + , pspCol :: !ColIx + } deriving stock (Eq, Ord, Show) + +data PhraseSel = PhraseSel + { phsStart :: !(Maybe PhraseSelPos) + , phsEnd :: !(Maybe PhraseSelPos) + } deriving stock (Eq, Ord, Show) + +maxNumberOfInstruments :: Int +maxNumberOfInstruments = 255 + +data SubCol = + SubColNote + | SubColInst + | SubColVol + | SubColPan + | SubColDel + | SubColSampEffNum + | SubColSampEffAmt + | SubColEffNum + | SubColEffAmt + deriving stock (Eq, Ord, Show, Enum, Bounded) + +scFromInt :: Int -> SubCol +scFromInt = \case + 1 -> SubColNote + 2 -> SubColInst + 3 -> SubColVol + 4 -> SubColPan + 5 -> SubColDel + 6 -> SubColSampEffNum + 7 -> SubColSampEffAmt + 8 -> SubColEffNum + 9 -> SubColEffAmt + _ -> undefined + +-- data Song = Song +-- { songFn :: !String +-- } deriving stock (Eq, Ord, Show) + +-- ---@field file_name string +-- ---@field artist string +-- ---@field artist_observable renoise.Document.Observable +-- ---@field name string +-- ---@field name_observable renoise.Document.Observable +-- ---@field comments string[] +-- ---@field comments_observable renoise.Document.ObservableList +-- ---@field comments_assignment_observable renoise.Document.Observable +-- ---@field show_comments_after_loading boolean +-- ---@field show_comments_after_loading_observable renoise.Document.Observable +-- ---@field tool_data string? +-- ---@field rendering_progress number Range: (0.0 - 1.0) +-- ---@field transport renoise.Transport +-- ---@field sequencer renoise.PatternSequencer +-- ---@field pattern_iterator renoise.PatternIterator +-- ---@field sequencer_track_count integer +-- ---@field send_track_count integer +-- --- +-- ---@field instruments renoise.Instrument[] +-- ---@field instruments_observable renoise.Document.ObservableList +-- ---@field patterns renoise.Pattern[] +-- ---@field patterns_observable renoise.Document.ObservableList +-- ---@field tracks renoise.Track[] +-- ---@field tracks_observable renoise.Document.ObservableList +-- --- +-- ---@field selected_instrument renoise.Instrument +-- ---@field selected_instrument_observable renoise.Document.Observable +-- ---@field selected_instrument_index integer +-- ---@field selected_instrument_index_observable renoise.Document.Observable +-- --- +-- ---@field selected_phrase renoise.InstrumentPhrase? +-- ---@field selected_phrase_observable renoise.Document.Observable +-- ---@field selected_phrase_index integer +-- --- +-- ---@field selected_sample renoise.Sample? +-- ---@field selected_sample_observable renoise.Document.Observable +-- ---@field selected_sample_index integer +-- --- +-- ---@field selected_sample_modulation_set renoise.SampleModulationSet? +-- ---@field selected_sample_modulation_set_observable renoise.Document.Observable +-- ---@field selected_sample_modulation_set_index integer +-- +-- ---@field selected_sample_device_chain renoise.SampleDeviceChain? +-- ---@field selected_sample_device_chain_observable renoise.Document.Observable +-- ---@field selected_sample_device_chain_index integer +-- --- +-- ---@field selected_sample_device renoise.AudioDevice? +-- ---@field selected_sample_device_observable renoise.Document.Observable +-- ---@field selected_sample_device_index integer +-- --- +-- ---@field selected_track renoise.Track +-- ---@field selected_track_observable renoise.Document.Observable +-- ---@field selected_track_index integer +-- ---@field selected_track_index_observable renoise.Document.Observable +-- --- +-- ---@field selected_track_device renoise.AudioDevice? +-- ---@field selected_track_device_observable renoise.Document.Observable +-- ---@field selected_track_device_index integer +-- --- +-- ---@field selected_device renoise.AudioDevice? +-- ---@field selected_device_observable renoise.Document.Observable +-- ---@field selected_device_index integer +-- --- +-- ---@field selected_parameter renoise.DeviceParameter? +-- ---@field selected_parameter_observable renoise.Document.Observable +-- --- +-- ---@field selected_automation_parameter renoise.DeviceParameter? +-- ---@field selected_automation_parameter_observable renoise.Document.Observable +-- ---@field selected_automation_device renoise.AudioDevice? +-- ---@field selected_automation_device_observable renoise.Document.Observable +-- --- +-- ---@field selected_pattern renoise.Pattern +-- ---@field selected_pattern_observable renoise.Document.Observable +-- ---@field selected_pattern_index integer +-- ---@field selected_pattern_index_observable renoise.Document.Observable +-- --- +-- ---@field selected_pattern_track renoise.PatternTrack +-- ---@field selected_pattern_track_observable renoise.Document.Observable +-- --- +-- ---@field selected_sequence_index integer +-- ---@field selected_sequence_index_observable renoise.Document.Observable +-- --- +-- ---@field selected_line renoise.PatternLine +-- ---@field selected_line_index integer +-- --- +-- ---@field selected_note_column renoise.NoteColumn? +-- ---@field selected_note_column_index integer +-- ---@field selected_effect_column renoise.EffectColumn? +-- ---@field selected_effect_column_index integer +-- ---@field selected_sub_column_type renoise.Song.SubColumnType + +type M = Identity + +songCanUndo :: M Bool +songCanUndo = undefined + +songUndo :: M () +songUndo = undefined + +songCanRedo :: M Bool +songCanRedo = undefined + +songRedo :: M () +songRedo = undefined + +data SongFn :: Type -> Type where + SFCanUndo :: SongFn Bool + SFUndo :: SongFn () + SFCanRedo :: SongFn Bool + SFRedo :: SongFn () + SFDescribeUndo :: String -> SongFn () + SFInsertTrackAt :: Int -> SongFn () + SFDeleteTrackAt :: Int -> SongFn () + SFSwapTracksAt :: Int -> Int -> SongFn () + SFSelectPrevTrack :: SongFn () + SFSelectNextTrack :: SongFn () + SFInsertInstrumentAt :: Int -> SongFn InstId + +deriving stock instance (Eq (SongFn a)) + +-- songFnReq :: SongFn a -> Attrs +-- songFnReq = undefined +-- +-- songFnRes :: SongFn a -> Attrs -> Maybe a +-- songFnRes = undefined + +-- ---Insert a new instrument at the given index. This will remap all existing +-- ---notes in all patterns, if needed, and also update all other instrument links +-- ---in the song. Can't have more than MAX_NUMBER_OF_INSTRUMENTS in a song. +-- ---@param index integer +-- ---@return renoise.Instrument +-- function renoise.Song:insert_instrument_at(index) end +-- +-- ---Delete an existing instrument at the given index. Renoise needs at least one +-- ---instrument, thus trying to completely remove all instruments is not allowed. +-- ---This will remap all existing notes in all patterns and update all other +-- ---instrument links in the song. +-- ---@param index integer +-- function renoise.Song:delete_instrument_at(index) end +-- +-- ---Swap the position of two instruments. Will remap all existing notes in all +-- ---patterns and update all other instrument links in the song. +-- ---@param index1 integer +-- ---@param index2 integer +-- function renoise.Song:swap_instruments_at(index1, index2) end +-- +-- ---Access to a single instrument by index. Use properties 'instruments' to iterate +-- ---over all instruments and to query the instrument count. +-- ---@param index integer +-- ---@return renoise.Instrument +-- function renoise.Song:instrument(index) end +-- +-- ---Captures the current instrument (selects the instrument) from the current +-- ---note column at the current cursor pos. Changes the selected instrument +-- ---accordingly, but does not return the result. When no instrument is present at +-- ---the current cursor pos, nothing will be done. +-- function renoise.Song:capture_instrument_from_pattern() end +-- +-- ---Tries to captures the nearest instrument from the current pattern track, +-- ---starting to look at the cursor pos, then advancing until an instrument is +-- ---found. Changes the selected instrument accordingly, but does not return +-- ---the result. When no instruments (notes) are present in the current pattern +-- ---track, nothing will be done. +-- function renoise.Song:capture_nearest_instrument_from_pattern() end +-- +-- ---Access to a single pattern by index. Use properties 'patterns' to iterate +-- ---over all patterns and to query the pattern count. +-- ---@param index integer +-- ---@return renoise.Pattern +-- function renoise.Song:pattern(index) end +-- +-- ---When rendering (see rendering, renoise.song().rendering_progress), +-- ---the current render process is canceled. Otherwise, nothing is done. +-- function renoise.Song:cancel_rendering() end +-- +-- ---@class RenderOptions +-- ---by default the song start. +-- ---@field start_pos renoise.SongPos? +-- ---by default the song end. +-- ---@field end_pos renoise.SongPos? +-- ---by default the players current rate. +-- ---@field sample_rate (22050|44100|48000|88200|96000|192000)? +-- ---by default 32. +-- ---@field bit_depth (16|24|32)? +-- ---by default "default". +-- ---@field interpolation ("default"|"precise")? +-- ---by default "high". +-- ---@field priority ("low"|"realtime"|"high")? +-- +-- ---Start rendering a section of the song or the whole song to a WAV file. +-- --- +-- ---Rendering job will be done in the background and the call will return +-- ---back immediately, but the Renoise GUI will be blocked during rendering. The +-- ---passed `rendering_done_callback` function is called as soon as rendering is +-- ---done, e.g. successfully completed. +-- --- +-- ---While rendering, the rendering status can be polled with the `song().rendering` +-- ---and `song().rendering_progress` properties, for example, in idle notifier +-- ---loops. If starting the rendering process fails (because of file IO errors for +-- ---example), the render function will return false and the error message is set +-- ---as the second return value. On success, only a single `true` value is +-- ---returned. +-- --- +-- ---To render only specific tracks or columns, mute the undesired tracks/columns +-- ---before starting to render. +-- --- +-- ---Parameter `file_name` must point to a valid, maybe already existing file. If it +-- ---already exists, the file will be silently overwritten. The renderer will +-- ---automatically add a ".wav" extension to the file_name, if missing. +-- --- +-- ---Parameter `rendering_done_callback` is ONLY called when rendering has succeeded. +-- ---You can do something with the file you've passed to the renderer here, like +-- ---for example loading the file into a sample buffer. +-- ---@param options RenderOptions +-- ---@param filename string +-- ---@param rendering_done_callback fun() +-- ---@return boolean success, string error? +-- ---@overload fun(self, filename: string, rendering_done_callback: fun()): boolean, string? +-- function renoise.Song:render(options, filename, rendering_done_callback) end +-- +-- ---Load all global MIDI mappings in the song into a XRNM file. +-- ---Returns true when loading/saving succeeded, else false and the error message. +-- ---@param filename string +-- ---@return boolean success, string error? +-- function renoise.Song:load_midi_mappings(filename) end +-- +-- ---Save all global MIDI mappings in the song into a XRNM file. +-- ---Returns true when loading/saving succeeded, else false and the error message. +-- ---@param filename string +-- ---@return boolean success, string error? +-- function renoise.Song:save_midi_mappings(filename) end +-- +-- ---clear all MIDI mappings in the song +-- function renoise.Song:clear_midi_mappings() end +--