-- 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_title :: !Text
    , 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_bg :: !Color.Color
    , track_render :: !RenderConfig
    -- | If True, and this track has im notes, display the waveform on the
    -- track.
    , track_waveform :: !Bool
    } deriving (Eq, Show, Read)

instance Pretty Track where
    format (Track title events _bg render _waveform) = Pretty.record "Track"
        [ ("title", Pretty.format title)
        , ("render", Pretty.format render)
        , ("events", Pretty.format events)
        ]

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

empty :: Track
empty = track "" Events.empty

instance DeepSeq.NFData Track where
    rnf track = DeepSeq.rnf (track_events track) `seq` ()

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

set_events :: Events.Events -> Track -> Track
set_events events = modify_events (const 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 {
    _track_bg :: TrackBg
    -- | The arguments are what 'Cmd.Internal.event_style' needs to figure out
    -- a style.
    , _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 {
    render_style :: !RenderStyle
    , render_color :: !Color.Color
    } deriving (Eq, Show, Read)

no_render :: RenderConfig
no_render = RenderConfig NoRender Config.track_signal_color

line_render :: RenderConfig
line_render = RenderConfig (Line Nothing) Config.track_signal_color

instance Pretty RenderConfig where
    pretty (RenderConfig style color) = pretty (style, 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 (Eq, Read, Show)

data RenderSource = Control ScoreT.Control | Pitch ScoreT.PControl
    deriving (Eq, Read, Show)

instance Pretty RenderSource where
    pretty (Control c) = "Control " <> pretty c
    pretty (Pitch c) = "Pitch " <> pretty c
instance Pretty RenderStyle where pretty = showt

set_render_style :: RenderStyle -> Track -> Track
set_render_style style track =
    track { track_render = (track_render track) { render_style = 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 {
    ts_signal :: !Signal.Display
    , ts_shift :: !ScoreTime
    , ts_stretch :: !ScoreTime
    } deriving (Show, Eq)

empty_track_signal :: TrackSignal
empty_track_signal = TrackSignal mempty 0 1

instance Pretty TrackSignal where
    format (TrackSignal sig shift stretch) =
        Pretty.record ("TrackSignal" Pretty.<+> Pretty.format (shift, stretch))
            [("signal", Pretty.format sig)]

instance DeepSeq.NFData TrackSignal where
    rnf (TrackSignal sig _ _) = DeepSeq.rnf sig

signal_at :: ScoreTime -> TrackSignal -> Signal.Y
signal_at x (TrackSignal sig shift stretch) = Signal.at warped sig
    where warped = RealTime.from_score $ x * stretch + shift

-- * waveform

data WaveformChunk = WaveformChunk {
    _filename :: !FilePath
    , _chunknum :: Types.ChunkNum
    , _start :: !TrackTime
    , _ratios :: ![Double]
    } deriving (Show)

instance Pretty WaveformChunk where
    format (WaveformChunk filename chunknum start ratios) =
        Pretty.record "WaveformChunk"
            [ ("filename", Pretty.format filename)
            , ("chunknum", Pretty.format chunknum)
            , ("start", Pretty.format start)
            , ("ratios", Pretty.format ratios)
            ]