-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE RankNTypes #-}
-- | The 'Track' type and supporting functions.
module Ui.Track where
import qualified Control.DeepSeq as DeepSeq

import qualified Util.Pretty as Pretty
import qualified App.Config as Config
import qualified Derive.ScoreT as ScoreT
import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal
import qualified Ui.Color as Color
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Types as Types

import           Global
import           Types


-- * track

-- | An event track, which contains some configuration, and the actual
-- events that make up the score.
data Track = Track {
    Track -> Text
track_title :: !Text
    , Track -> Events
track_events :: !Events.Events
    -- | Similar to 'Event.Event.style', you can individually configure track
    -- bg color, but in practice I do it automatically at the low level with
    -- 'TrackBg'.
    , Track -> Color
track_bg :: !Color.Color
    , Track -> RenderConfig
track_render :: !RenderConfig
    -- | If True, and this track has im notes, display the waveform on the
    -- track.
    , Track -> Bool
track_waveform :: !Bool
    } deriving (Track -> Track -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Track -> Track -> Bool
$c/= :: Track -> Track -> Bool
== :: Track -> Track -> Bool
$c== :: Track -> Track -> Bool
Eq, Int -> Track -> ShowS
[Track] -> ShowS
Track -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Track] -> ShowS
$cshowList :: [Track] -> ShowS
show :: Track -> String
$cshow :: Track -> String
showsPrec :: Int -> Track -> ShowS
$cshowsPrec :: Int -> Track -> ShowS
Show)

instance Pretty Track where
    format :: Track -> Doc
format (Track Text
title Events
events Color
_bg RenderConfig
render Bool
_waveform) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"Track"
        [ (Text
"title", forall a. Pretty a => a -> Doc
Pretty.format Text
title)
        , (Text
"render", forall a. Pretty a => a -> Doc
Pretty.format RenderConfig
render)
        , (Text
"events", forall a. Pretty a => a -> Doc
Pretty.format Events
events)
        ]

-- | Construct a new Track.
track :: Text -> Events.Events -> Track
track :: Text -> Events -> Track
track Text
title Events
events = Track
    { track_title :: Text
track_title = Text
title
    , track_events :: Events
track_events = Events
events
    , track_bg :: Color
track_bg = Color
Config.track_bg
    , track_render :: RenderConfig
track_render = RenderConfig
line_render
    , track_waveform :: Bool
track_waveform = Bool
True
    }

empty :: Track
empty :: Track
empty = Text -> Events -> Track
track Text
"" Events
Events.empty

instance DeepSeq.NFData Track where
    rnf :: Track -> ()
rnf Track
track = forall a. NFData a => a -> ()
DeepSeq.rnf (Track -> Events
track_events Track
track) seq :: forall a b. a -> b -> b
`seq` ()

modify_events :: (Events.Events -> Events.Events) -> Track -> Track
modify_events :: (Events -> Events) -> Track -> Track
modify_events Events -> Events
f track :: Track
track@(Track { track_events :: Track -> Events
track_events = Events
events }) =
    Track
track { track_events :: Events
track_events = Events -> Events
f Events
events }

set_events :: Events.Events -> Track -> Track
set_events :: Events -> Track -> Track
set_events Events
events = (Events -> Events) -> Track -> Track
modify_events (forall a b. a -> b -> a
const Events
events)

type SetStyle = (TrackBg, Event.EventStyle)

-- | High level 'SetStyle', with information provided automatically.
--
-- It's a bit awkward to have two SetStyles, but some information can only be
-- supplied by "Ui.Sync".
data SetStyleHigh = SetStyleHigh {
    SetStyleHigh -> Track -> Color
_track_bg :: TrackBg
    -- | The arguments are what 'Cmd.Internal.event_style' needs to figure out
    -- a style.
    , SetStyleHigh
-> forall a.
   Namespace -> Map BlockId a -> BlockId -> Bool -> EventStyle
_set_event_style :: forall a. Id.Namespace -> Map BlockId a -> BlockId
        -> Bool -- has note track children?
        -> Event.EventStyle
    }
type TrackBg = Track -> Color.Color

-- * track signal

-- | Whether to draw a 'Signal.Display' on this track, and if so, how.
data RenderConfig = RenderConfig {
    RenderConfig -> RenderStyle
render_style :: !RenderStyle
    , RenderConfig -> Color
render_color :: !Color.Color
    } deriving (RenderConfig -> RenderConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderConfig -> RenderConfig -> Bool
$c/= :: RenderConfig -> RenderConfig -> Bool
== :: RenderConfig -> RenderConfig -> Bool
$c== :: RenderConfig -> RenderConfig -> Bool
Eq, Int -> RenderConfig -> ShowS
[RenderConfig] -> ShowS
RenderConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderConfig] -> ShowS
$cshowList :: [RenderConfig] -> ShowS
show :: RenderConfig -> String
$cshow :: RenderConfig -> String
showsPrec :: Int -> RenderConfig -> ShowS
$cshowsPrec :: Int -> RenderConfig -> ShowS
Show)

no_render :: RenderConfig
no_render :: RenderConfig
no_render = RenderStyle -> Color -> RenderConfig
RenderConfig RenderStyle
NoRender Color
Config.track_signal_color

line_render :: RenderConfig
line_render :: RenderConfig
line_render = RenderStyle -> Color -> RenderConfig
RenderConfig (Maybe RenderSource -> RenderStyle
Line forall a. Maybe a
Nothing) Color
Config.track_signal_color

instance Pretty RenderConfig where
    pretty :: RenderConfig -> Text
pretty (RenderConfig RenderStyle
style Color
color) = forall a. Pretty a => a -> Text
pretty (RenderStyle
style, Color
color)

-- | RenderStyles can take an optional source which says which control the
-- signal comes from.  This is only for note tracks, and will extract the
-- final signal from the events and display that.
--
-- Non-note tracks will ignore the RenderSource, and note tracks will ignore
-- a RenderStyle without a RenderSource.
--
-- This has no effect on the actual rendering, since it just draws a signal and
-- doesn't know where it came from, but is configuration for the code that goes
-- and looks for that signal.
data RenderStyle = NoRender | Line !(Maybe RenderSource)
    | Filled !(Maybe RenderSource)
    deriving (RenderStyle -> RenderStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderStyle -> RenderStyle -> Bool
$c/= :: RenderStyle -> RenderStyle -> Bool
== :: RenderStyle -> RenderStyle -> Bool
$c== :: RenderStyle -> RenderStyle -> Bool
Eq, Int -> RenderStyle -> ShowS
[RenderStyle] -> ShowS
RenderStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderStyle] -> ShowS
$cshowList :: [RenderStyle] -> ShowS
show :: RenderStyle -> String
$cshow :: RenderStyle -> String
showsPrec :: Int -> RenderStyle -> ShowS
$cshowsPrec :: Int -> RenderStyle -> ShowS
Show)

data RenderSource = Control ScoreT.Control | Pitch ScoreT.PControl
    deriving (RenderSource -> RenderSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderSource -> RenderSource -> Bool
$c/= :: RenderSource -> RenderSource -> Bool
== :: RenderSource -> RenderSource -> Bool
$c== :: RenderSource -> RenderSource -> Bool
Eq, Int -> RenderSource -> ShowS
[RenderSource] -> ShowS
RenderSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderSource] -> ShowS
$cshowList :: [RenderSource] -> ShowS
show :: RenderSource -> String
$cshow :: RenderSource -> String
showsPrec :: Int -> RenderSource -> ShowS
$cshowsPrec :: Int -> RenderSource -> ShowS
Show)

instance Pretty RenderSource where
    pretty :: RenderSource -> Text
pretty (Control Control
c) = Text
"Control " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Control
c
    pretty (Pitch PControl
c) = Text
"Pitch " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty PControl
c
instance Pretty RenderStyle where pretty :: RenderStyle -> Text
pretty = forall a. Show a => a -> Text
showt

set_render_style :: RenderStyle -> Track -> Track
set_render_style :: RenderStyle -> Track -> Track
set_render_style RenderStyle
style Track
track =
    Track
track { track_render :: RenderConfig
track_render = (Track -> RenderConfig
track_render Track
track) { render_style :: RenderStyle
render_style = RenderStyle
style } }

-- | Each (BlockId, TrackId) pair can have a TrackSignal associated with it.
--
-- There's no particular reason a ruler couldn't also have a signal in it,
-- except that it might look a little crowded.  But RulerId isn't supported.
-- If there's ever a need I can add it.
type TrackSignals = Map (BlockId, TrackId) TrackSignal

-- | Similar to "Derive.TrackWarp", the signal generated by signal
-- tracks is stashed away in TrackSignals during derivation so it can be sent
-- to the UI for display.
--
-- Signals are in real time, but the UI wants to display them in score time.
-- If the block happens to have a linear warp then the mapping is trivial, and
-- I don't have to bother generating another signal just for display.  However,
-- if there is a non-trivial warp, the signal will have to be unwarped back
-- to ScoreTime.
data TrackSignal = TrackSignal {
    TrackSignal -> Display
ts_signal :: !Signal.Display
    , TrackSignal -> ScoreTime
ts_shift :: !ScoreTime
    , TrackSignal -> ScoreTime
ts_stretch :: !ScoreTime
    } deriving (Int -> TrackSignal -> ShowS
[TrackSignal] -> ShowS
TrackSignal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrackSignal] -> ShowS
$cshowList :: [TrackSignal] -> ShowS
show :: TrackSignal -> String
$cshow :: TrackSignal -> String
showsPrec :: Int -> TrackSignal -> ShowS
$cshowsPrec :: Int -> TrackSignal -> ShowS
Show, TrackSignal -> TrackSignal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackSignal -> TrackSignal -> Bool
$c/= :: TrackSignal -> TrackSignal -> Bool
== :: TrackSignal -> TrackSignal -> Bool
$c== :: TrackSignal -> TrackSignal -> Bool
Eq)

empty_track_signal :: TrackSignal
empty_track_signal :: TrackSignal
empty_track_signal = Display -> ScoreTime -> ScoreTime -> TrackSignal
TrackSignal forall a. Monoid a => a
mempty ScoreTime
0 ScoreTime
1

instance Pretty TrackSignal where
    format :: TrackSignal -> Doc
format (TrackSignal Display
sig ScoreTime
shift ScoreTime
stretch) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record (Doc
"TrackSignal" Doc -> Doc -> Doc
Pretty.<+> forall a. Pretty a => a -> Doc
Pretty.format (ScoreTime
shift, ScoreTime
stretch))
            [(Text
"signal", forall a. Pretty a => a -> Doc
Pretty.format Display
sig)]

instance DeepSeq.NFData TrackSignal where
    rnf :: TrackSignal -> ()
rnf (TrackSignal Display
sig ScoreTime
_ ScoreTime
_) = forall a. NFData a => a -> ()
DeepSeq.rnf Display
sig

signal_at :: ScoreTime -> TrackSignal -> Signal.Y
signal_at :: ScoreTime -> TrackSignal -> Y
signal_at ScoreTime
x (TrackSignal Display
sig ScoreTime
shift ScoreTime
stretch) = forall {k} (kind :: k). Signal kind -> X -> Y
Signal.at Display
sig X
warped
    where warped :: X
warped = ScoreTime -> X
RealTime.from_score forall a b. (a -> b) -> a -> b
$ ScoreTime
x forall a. Num a => a -> a -> a
* ScoreTime
stretch forall a. Num a => a -> a -> a
+ ScoreTime
shift

-- * waveform

-- | Draw one chunk of waveform on the track.  Corresponds to
-- PeakCache::Params.
data WaveformChunk = WaveformChunk {
    WaveformChunk -> String
_filename :: !FilePath
    , WaveformChunk -> Int
_chunknum :: Types.ChunkNum
    , WaveformChunk -> ScoreTime
_start :: !TrackTime
    -- | See PeakCache::Params.
    , WaveformChunk -> [Y]
_ratios :: ![Double]
    } deriving (Int -> WaveformChunk -> ShowS
[WaveformChunk] -> ShowS
WaveformChunk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WaveformChunk] -> ShowS
$cshowList :: [WaveformChunk] -> ShowS
show :: WaveformChunk -> String
$cshow :: WaveformChunk -> String
showsPrec :: Int -> WaveformChunk -> ShowS
$cshowsPrec :: Int -> WaveformChunk -> ShowS
Show)

instance Pretty WaveformChunk where
    format :: WaveformChunk -> Doc
format (WaveformChunk String
filename Int
chunknum ScoreTime
start [Y]
ratios) =
        Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
"WaveformChunk"
            [ (Text
"filename", forall a. Pretty a => a -> Doc
Pretty.format String
filename)
            , (Text
"chunknum", forall a. Pretty a => a -> Doc
Pretty.format Int
chunknum)
            , (Text
"start", forall a. Pretty a => a -> Doc
Pretty.format ScoreTime
start)
            , (Text
"ratios", forall a. Pretty a => a -> Doc
Pretty.format [Y]
ratios)
            ]