module Example.Integrate where
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified System.FilePath as FilePath
import qualified Text.Read as Read
import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Integrate.Manual as Manual
import qualified Cmd.ModifyNotes as ModifyNotes
import qualified Cmd.Ruler.RulerUtil as RulerUtil
import qualified Cmd.Selection as Selection
import qualified Derive.ShowVal as ShowVal
import qualified Perform.Pitch as Pitch
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Meter.Meters as Meters
import qualified Ui.Ruler as Ruler
import qualified Ui.ScoreTime as ScoreTime
import qualified Ui.Ui as Ui
import Global
import Types
integrate_file :: Cmd.CmdT IO (Maybe BlockId)
integrate_file :: CmdT IO (Maybe BlockId)
integrate_file = do
Score
score <- FilePath -> CmdT IO Score
read_score FilePath
fname
Maybe BlockId
mb_block_id <- forall (m :: * -> *). M m => Text -> Score -> m (Maybe BlockId)
integrate_score (FilePath -> Text
txt (FilePath -> FilePath
FilePath.takeFileName FilePath
fname)) Score
score
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe BlockId
mb_block_id (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BlockId
mb_block_id
where
fname :: FilePath
fname = FilePath
"Example/integrate-score"
integrate_score :: Ui.M m => Text -> Score -> m (Maybe BlockId)
integrate_score :: forall (m :: * -> *). M m => Text -> Score -> m (Maybe BlockId)
integrate_score Text
name Score
score = do
BlockId
block_id <- forall (m :: * -> *) a. (Stack, M m) => Text -> Maybe a -> m a
Ui.require Text
"invalid name" forall a b. (a -> b) -> a -> b
$ forall a. Ident a => Id -> Maybe a
Id.make forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id.id Namespace
namespace Text
name
let end :: TrackTime
end = Double -> TrackTime
ScoreTime.from_double forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double
s forall a. Num a => a -> a -> a
+ Double
d | (Double
s, Double
d, Text
_, Double
_) <- Score
score]
RulerId
ruler_id <- forall (m :: * -> *). M m => BlockId -> ModifyRuler -> m RulerId
RulerUtil.replace BlockId
block_id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
Meter -> Ruler
Ruler.meter_ruler forall a b. (a -> b) -> a -> b
$ AbstractMeter -> TrackTime -> Int -> TrackTime -> Meter
RulerUtil.meter_until AbstractMeter
Meters.m44 TrackTime
1 Int
4 TrackTime
end
forall (m :: * -> *).
M m =>
Text -> BlockId -> RulerId -> Text -> Tracks -> m (Maybe BlockId)
Manual.block Text
source_key BlockId
block_id RulerId
ruler_id Text
block_title [(Track
note, [Track]
controls)]
where
(Track
note, [Track]
controls) = Text -> NoteTrack -> (Track, [Track])
Manual.convert_note_track Text
source_key (TrackTime -> Score -> NoteTrack
note_track TrackTime
0 Score
score)
block_title :: Text
block_title = Text
""
source_key :: Text
source_key = Text
name
namespace :: Namespace
namespace = Text -> Namespace
Id.namespace Text
"ex"
insert_at_selection :: FilePath -> Cmd.CmdT IO ()
insert_at_selection :: FilePath -> CmdT IO ()
insert_at_selection FilePath
fname = do
Score
score <- FilePath -> CmdT IO Score
read_score FilePath
fname
(BlockId
block_id, Int
_, TrackId
track_id, TrackTime
at) <- forall (m :: * -> *). M m => m (BlockId, Int, TrackId, TrackTime)
Selection.get_insert
forall (m :: * -> *).
M m =>
Score -> BlockId -> TrackId -> TrackTime -> m ()
insert Score
score BlockId
block_id TrackId
track_id TrackTime
at
insert :: Ui.M m => Score -> BlockId -> TrackId -> TrackTime -> m ()
insert :: forall (m :: * -> *).
M m =>
Score -> BlockId -> TrackId -> TrackTime -> m ()
insert Score
score BlockId
block_id TrackId
track_id TrackTime
at =
forall (m :: * -> *).
M m =>
BlockId -> [TrackId] -> [NoteTrack] -> m ()
ModifyNotes.write_tracks BlockId
block_id [TrackId
track_id] [TrackTime -> Score -> NoteTrack
note_track TrackTime
at Score
score]
note_track :: TrackTime -> Score -> ModifyNotes.NoteTrack
note_track :: TrackTime -> Score -> NoteTrack
note_track TrackTime
offset Score
score = Events -> Controls -> NoteTrack
ModifyNotes.NoteTrack ([(Double, Double, Text)] -> Events
mk_events [(Double, Double, Text)]
notes) Controls
control_tracks
where
control_tracks :: Controls
control_tracks = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (ScaleId -> Control
ModifyNotes.Pitch ScaleId
Pitch.empty_scale, [(Double, Double, Text)] -> Events
mk_events [(Double, Double, Text)]
pitches)
, (Control -> Control
ModifyNotes.Control Control
"dyn", [(Double, Double, Text)] -> Events
mk_events [(Double, Double, Text)]
dyns)
]
notes :: [(Double, Double, Text)]
notes = [(Double
start, Double
dur, Text
"") | (Double
start, Double
dur, Text
_, Double
_) <- Score
score]
pitches :: [(Double, Double, Text)]
pitches = [(Double
start, Double
0, Text
pitch) | (Double
start, Double
_, Text
pitch, Double
_) <- Score
score]
dyns :: [(Double, Double, Text)]
dyns = [(Double
start, Double
0, forall a. ShowVal a => a -> Text
ShowVal.show_val Double
dyn) | (Double
start, Double
_, Text
_, Double
dyn) <- Score
score]
mk_events :: [(Double, Double, Text)] -> Events
mk_events = [Event] -> Events
Events.from_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Real a, Real a) => (a, a, Text) -> Event
mk_event
mk_event :: (a, a, Text) -> Event
mk_event (a
start, a
dur, Text
text) =
TrackTime -> TrackTime -> Text -> Event
Event.event (TrackTime
offset forall a. Num a => a -> a -> a
+ forall a b. (Real a, Fractional b) => a -> b
realToFrac a
start) (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
dur) Text
text
type Score = [(Double, Double, Text, Double)]
score :: Score
score :: Score
score =
[ (Double
0, Double
1, Text
"4c", Double
1)
, (Double
1, Double
1, Text
"4d", Double
0.75)
]
read_score :: FilePath -> Cmd.CmdT IO Score
read_score :: FilePath -> CmdT IO Score
read_score FilePath
fname = do
Text
score <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
Text.IO.readFile FilePath
fname
forall (m :: * -> *) err a.
(Stack, M m) =>
(err -> Text) -> Either err a -> m a
Cmd.require_right forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Text -> Either Text Score
parse_score Text
score
parse_score :: Text -> Either Text Score
parse_score :: Text -> Either Text Score
parse_score = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a} {a} {a} {a}.
(Read a, Read a, Read a, Read a) =>
Text -> Either Text (a, a, a, a)
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
where
parse :: Text -> Either Text (a, a, a, a)
parse Text
line = case Text -> [Text]
Text.words Text
line of
[Text
start, Text
dur, Text
pitch, Text
dyn] -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either Text b
fail forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
(,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => Text -> Maybe a
p Text
start forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => Text -> Maybe a
p Text
dur forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => Text -> Maybe a
p Text
pitch forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => Text -> Maybe a
p Text
dyn
[Text]
_ -> forall {b}. Either Text b
fail
where
fail :: Either Text b
fail = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"can't parse: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Text
line
p :: Read a => Text -> Maybe a
p :: forall a. Read a => Text -> Maybe a
p = forall a. Read a => FilePath -> Maybe a
Read.readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
untxt