{- | Wires up and runs the Brick application: assembles the 'App' record
from the pieces defined elsewhere ("Termtab.UI.Keybindings" for input,
"Termtab.UI.Widgets.*" for rendering, "Termtab.UI.NotationGraphics" for
image blitting), resolves terminal graphics capabilities before Brick
takes over the terminal, and tears everything down again on exit.
-}
module Termtab.UI (runUI) where

import Brick
import Brick.BChan (newBChan, writeBChan)
import Control.Exception (SomeException, try)
import Control.Monad.IO.Class (liftIO)
import Graphics.Vty qualified as V
import Graphics.Vty.CrossPlatform (mkVty)

import Termtab.Audio.PlaybackThread (destroyPlaybackEnv)
import Termtab.Graphics.Detect (detectProtocol)
import Termtab.Graphics.Font (GlyphFont, bravuraFontPath, closeGlyphFont, openGlyphFont)
import Termtab.Graphics.TermColor (foregroundOrDefault)
import Termtab.Types (Song (..), TrackIndex (..))
import Termtab.UI.Keybindings (handleEvent)
import Termtab.UI.NotationGraphics (syncNotationGraphics)
import Termtab.UI.Types
import Termtab.UI.Widgets.StatusBar (commandModeAttr, renderStatusBar, statusBarAttr)
import Termtab.UI.Widgets.Tablature (barLineAttr, cursorAttr, playheadAttr, selectionAttr, stringLabelAttr)
import Termtab.UI.Widgets.TrackPanel (focusedTrackAttr, renderTrackPanel)

{- | The Brick application definition. Every event handled by
'Termtab.UI.Keybindings.handleEvent' is followed by a call to
'syncNotationGraphics' so notation images stay in sync with whatever the
keybinding just changed, and the cursor is never drawn by Brick itself
('neverShowCursor') since the tab\/notation widgets draw their own
cursor highlighting via attributes.
-}
app :: App AppState AppEvent ResourceName
app :: App AppState AppEvent ResourceName
app =
    App
        { appDraw :: AppState -> [Widget ResourceName]
appDraw = AppState -> [Widget ResourceName]
drawUI
        , appChooseCursor :: AppState
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
appChooseCursor = AppState
-> [CursorLocation ResourceName]
-> Maybe (CursorLocation ResourceName)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
neverShowCursor
        , -- After handling an event, (re)blit the notation images so they track
          -- the current content and layout.
          appHandleEvent :: BrickEvent ResourceName AppEvent -> EventM ResourceName AppState ()
appHandleEvent = \BrickEvent ResourceName AppEvent
e -> BrickEvent ResourceName AppEvent -> EventM ResourceName AppState ()
handleEvent BrickEvent ResourceName AppEvent
e EventM ResourceName AppState ()
-> EventM ResourceName AppState ()
-> EventM ResourceName AppState ()
forall a b.
EventM ResourceName AppState a
-> EventM ResourceName AppState b -> EventM ResourceName AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM ResourceName AppState ()
syncNotationGraphics
        , -- Extents don't exist until after the first draw, so defer the initial
          -- blit to a self-posted refresh event.
          appStartEvent :: EventM ResourceName AppState ()
appStartEvent = do
            st <- EventM ResourceName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
            liftIO (writeBChan (asBChan st) GraphicsRefresh)
        , appAttrMap :: AppState -> AttrMap
appAttrMap = AttrMap -> AppState -> AttrMap
forall a b. a -> b -> a
const AttrMap
theAttrMap
        }

{- | Render one panel per track (via 'renderTrackPanel'), stacked
vertically, with the status bar pinned at the bottom.
-}
drawUI :: AppState -> [Widget ResourceName]
drawUI :: AppState -> [Widget ResourceName]
drawUI AppState
st =
    [ [Widget ResourceName] -> Widget ResourceName
forall n. [Widget n] -> Widget n
vBox ([Widget ResourceName] -> Widget ResourceName)
-> [Widget ResourceName] -> Widget ResourceName
forall a b. (a -> b) -> a -> b
$
        [ AppState -> TrackIndex -> Track -> Widget ResourceName
renderTrackPanel AppState
st (Int -> TrackIndex
TrackIndex Int
i) Track
track
        | (Int
i, Track
track) <- [Int] -> [Track] -> [(Int, Track)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (Song -> [Track]
songTracks (AppState -> Song
asSong AppState
st))
        ]
            [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [AppState -> Widget ResourceName
renderStatusBar AppState
st]
    ]

{- | Vty styling for the attribute names defined across the
"Termtab.UI.Widgets.*" modules (cursor, playhead, selection highlighting,
bar lines, focus, status bar, command-mode text).
-}
theAttrMap :: AttrMap
theAttrMap :: AttrMap
theAttrMap =
    Attr -> [(AttrName, Attr)] -> AttrMap
attrMap
        Attr
V.defAttr
        [ (AttrName
cursorAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.reverseVideo)
        , (AttrName
playheadAttr, Attr
V.defAttr Attr -> Color -> Attr
`V.withBackColor` Color
V.green Attr -> Color -> Attr
`V.withForeColor` Color
V.black)
        , (AttrName
selectionAttr, Attr
V.defAttr Attr -> Color -> Attr
`V.withBackColor` Color
V.blue Attr -> Color -> Attr
`V.withForeColor` Color
V.white)
        , (AttrName
barLineAttr, Attr
V.defAttr Attr -> Color -> Attr
`V.withForeColor` Color
V.brightBlack)
        , (AttrName
stringLabelAttr, Attr
V.defAttr Attr -> Color -> Attr
`V.withForeColor` Color
V.cyan)
        , (AttrName
focusedTrackAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
        , (AttrName
statusBarAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.reverseVideo)
        , (AttrName
commandModeAttr, Attr
V.defAttr Attr -> Color -> Attr
`V.withForeColor` Color
V.yellow)
        ]

{- | Entry point for the interactive editor: detect the terminal's graphics
protocol and colors, load the Bravura glyph font if available, run
Brick's main loop starting from 'initAppState', then clean up the glyph
font and any live 'Termtab.Audio.PlaybackThread.PlaybackEnv' on exit.
Graphics detection happens before 'mkVty' grabs the terminal because the
foreground-color query itself reads stdin, which would otherwise race
vty's own input-reading thread.
-}
runUI :: Maybe FilePath -> Song -> IO ()
runUI :: Maybe FilePath -> Song -> IO ()
runUI Maybe FilePath
mPath Song
song = do
    bChan <- Int -> IO (BChan AppEvent)
forall a. Int -> IO (BChan a)
newBChan Int
10
    -- Resolve graphics before vty grabs the terminal: the foreground-color query
    -- reads stdin, which would otherwise race vty's input thread.
    protocol <- detectProtocol
    ink <- foregroundOrDefault
    mFont <- loadBravura
    let initialState =
            (Maybe FilePath -> Song -> BChan AppEvent -> AppState
initAppState Maybe FilePath
mPath Song
song BChan AppEvent
bChan)
                { asProtocol = protocol
                , asInkColor = ink
                , asGlyphFont = mFont
                }
    let buildVty = VtyUserConfig -> IO Vty
mkVty VtyUserConfig
V.defaultConfig
    initialVty <- buildVty
    finalState <- customMain initialVty buildVty (Just bChan) app initialState
    maybe (return ()) closeGlyphFont (asGlyphFont finalState)
    -- Clean up audio engine if it was initialized
    case asPlaybackEnv finalState of
        Just PlaybackEnv
env -> PlaybackEnv -> IO ()
destroyPlaybackEnv PlaybackEnv
env
        Maybe PlaybackEnv
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Load the Bravura font, tolerating a missing/unreadable path.
loadBravura :: IO (Maybe GlyphFont)
loadBravura :: IO (Maybe GlyphFont)
loadBravura = do
    mPath <- IO (Maybe FilePath)
bravuraFontPath
    case mPath of
        Maybe FilePath
Nothing -> Maybe GlyphFont -> IO (Maybe GlyphFont)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphFont
forall a. Maybe a
Nothing
        Just FilePath
path -> do
            result <- IO GlyphFont -> IO (Either SomeException GlyphFont)
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> IO GlyphFont
openGlyphFont FilePath
path) :: IO (Either SomeException GlyphFont)
            return (either (const Nothing) Just result)