{- | Plain Unicode-text rendering of standard staff notation, used as the
fallback when the terminal can't display the rasterized Bravura image
from "Termtab.UI.NotationGraphics" (see
"Termtab.UI.Widgets.TrackPanel"'s choice between the two). Draws the
staff by brute force: one text row per vertical position (staff line or
space, plus a couple of ledger positions above and below), each row
built independently across all visible measures.
-}
module Termtab.UI.Widgets.Notation (renderNotation) where

import Brick hiding (zoom)
import Data.Map.Strict qualified as Map

import Termtab.Notation.Staff (isStaffLine, noteheadGlyph, pitchToStaffPos)
import Termtab.Types
import Termtab.UI.Types
import Termtab.UI.Widgets.Tablature (beatColumnWidth, findVisibleRange)

{- | Render standard notation above the tab.
9 rows: 5 staff lines (even positions) + 4 spaces (odd positions).
Staff positions: 0=E4, 1=F4, 2=G4, 3=A4, 4=B4, 5=C5, 6=D5, 7=E5, 8=F5
Lines are at positions 0, 2, 4, 6, 8. Spaces at 1, 3, 5, 7.

Two extra rows are drawn above (positions 9, 10) and two below (-1, -2)
for ledger-line\/off-staff notes; 'Termtab.Notation.Staff.pitchToStaffPos'
can return values outside [0, 8] and those still need somewhere to render,
even without an actual ledger line drawn for them. The visible measure
range comes from 'findVisibleRange' (shared with "Termtab.UI.Widgets.Tablature"
so notation and tab columns line up).
-}
renderNotation :: AppState -> TrackIndex -> Widget ResourceName
renderNotation :: AppState -> TrackIndex -> Widget ResourceName
renderNotation AppState
st TrackIndex
tIdx =
    let track :: Track
track = TrackIndex -> Song -> Track
getTrack TrackIndex
tIdx (AppState -> Song
asSong AppState
st)
        measures :: [Measure]
measures = Song -> [Measure]
songMeasures (AppState -> Song
asSong AppState
st)
        zoom :: Int
zoom = AppState -> Int
asZoom AppState
st
        MeasureIndex Int
cursorM = AppState -> MeasureIndex
asCurrentMeasure AppState
st
        visibleMeasures :: [(MeasureIndex, [Beat], Measure)]
visibleMeasures = Track
-> [Measure]
-> Int
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
findVisibleRange Track
track [Measure]
measures Int
zoom Int
200 Int
cursorM
        instr :: Instrument
instr = Track -> Instrument
trackInstrument Track
track
     in [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
$
            -- Above staff (ledger lines / high notes)
            [Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> Int
-> Bool
-> Widget ResourceName
renderStaffRow Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
visibleMeasures Int
10 Bool
False]
                [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> Int
-> Bool
-> Widget ResourceName
renderStaffRow Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
visibleMeasures Int
9 Bool
False]
                -- Staff: top line (F5) down to bottom line (E4)
                -- Alternating: line, space, line, space, ...
                [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [ Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> Int
-> Bool
-> Widget ResourceName
renderStaffRow Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
visibleMeasures Int
pos (Int -> Bool
isStaffLine Int
pos)
                   | Int
pos <- [Int
8, Int
7, Int
6, Int
5, Int
4, Int
3, Int
2, Int
1, Int
0]
                   ]
                -- Below staff (ledger lines / low notes)
                [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> Int
-> Bool
-> Widget ResourceName
renderStaffRow Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
visibleMeasures (-Int
1) Bool
False]
                [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> Int
-> Bool
-> Widget ResourceName
renderStaffRow Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
visibleMeasures (-Int
2) Bool
False]

{- | Look up a track by index, substituting a placeholder empty
'Standard' track if the index is out of range rather than failing —
this widget must always be able to draw /something/.
-}
getTrack :: TrackIndex -> Song -> Track
getTrack :: TrackIndex -> Song -> Track
getTrack (TrackIndex Int
i) Song
song =
    case Int -> [Track] -> [Track]
forall a. Int -> [a] -> [a]
drop Int
i (Song -> [Track]
songTracks Song
song) of
        (Track
t : [Track]
_) -> Track
t
        [] -> Text
-> Instrument -> MidiChannel -> Map MeasureIndex [Beat] -> Track
Track Text
"?" (MidiProgram -> Instrument
Standard (Int -> MidiProgram
MidiProgram Int
0)) (Int -> MidiChannel
MidiChannel Int
0) Map MeasureIndex [Beat]
forall k a. Map k a
Map.empty

-- | Render one row of the staff (either a line or a space).
renderStaffRow :: Int -> Instrument -> [(MeasureIndex, [Beat], Measure)] -> Int -> Bool -> Widget ResourceName
renderStaffRow :: Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> Int
-> Bool
-> Widget ResourceName
renderStaffRow Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
visibleMeasures Int
staffPos Bool
onLine =
    let fillChar :: Char
fillChar = if Bool
onLine then Char
'─' else Char
' '
        barChar :: String
barChar = if Int
staffPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
staffPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 then String
"│" else String
" "
     in [Widget ResourceName] -> Widget ResourceName
forall n. [Widget n] -> Widget n
hBox ([Widget ResourceName] -> Widget ResourceName)
-> [Widget ResourceName] -> Widget ResourceName
forall a b. (a -> b) -> a -> b
$
            [String -> Widget ResourceName
forall n. String -> Widget n
str [Char
fillChar]] -- label column
                [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ ((MeasureIndex, [Beat], Measure) -> [Widget ResourceName])
-> [(MeasureIndex, [Beat], Measure)] -> [Widget ResourceName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int
-> Instrument
-> Int
-> Char
-> String
-> (MeasureIndex, [Beat], Measure)
-> [Widget ResourceName]
renderMeasureAtPos Int
zoom Instrument
instr Int
staffPos Char
fillChar String
barChar) [(MeasureIndex, [Beat], Measure)]
visibleMeasures

{- | Render one measure's worth of one staff row: one column per actual
beat (via 'renderBeatAtPos'), then filler columns for whatever duration
of the measure isn't covered by beats yet (mirroring the \"empty slot\"
padding used elsewhere, e.g.
'Termtab.UI.Types.currentMeasureBeatCount'), then a trailing bar-line
column.
-}
renderMeasureAtPos :: Int -> Instrument -> Int -> Char -> String -> (MeasureIndex, [Beat], Measure) -> [Widget ResourceName]
renderMeasureAtPos :: Int
-> Instrument
-> Int
-> Char
-> String
-> (MeasureIndex, [Beat], Measure)
-> [Widget ResourceName]
renderMeasureAtPos Int
zoom Instrument
instr Int
staffPos Char
fillChar String
barChar (MeasureIndex
_mi, [Beat]
beats, Measure
measure) =
    let TimeSignature Int
num Int
_ = Measure -> TimeSignature
timeSignature Measure
measure
        totalCols :: Int
totalCols = Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
zoom
        usedCols :: Int
usedCols = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Beat -> Int) -> [Beat] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Duration -> Int
beatColumnWidth Int
zoom (Duration -> Int) -> (Beat -> Duration) -> Beat -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Beat -> Duration
beatDuration) [Beat]
beats)
        remainingCols :: Int
remainingCols = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
totalCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
usedCols)
        emptySlotWidth :: Int
emptySlotWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 Int
zoom
        emptySlotCount :: Int
emptySlotCount = if Int
emptySlotWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
remainingCols Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
emptySlotWidth else Int
0
        beatWidgets :: [Widget ResourceName]
beatWidgets =
            [ Int
-> Instrument
-> Int
-> Char
-> BeatIndex
-> [Beat]
-> Widget ResourceName
renderBeatAtPos Int
zoom Instrument
instr Int
staffPos Char
fillChar (Int -> BeatIndex
BeatIndex Int
bi) [Beat]
beats
            | Int
bi <- [Int
0 .. [Beat] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Beat]
beats Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]
        emptyWidgets :: [Widget n]
emptyWidgets = [String -> Widget n
forall n. String -> Widget n
str (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
emptySlotCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
emptySlotWidth) Char
fillChar)]
        barLine :: Widget n
barLine = String -> Widget n
forall n. String -> Widget n
str String
barChar
     in [Widget ResourceName]
beatWidgets [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Widget ResourceName]
forall {n}. [Widget n]
emptyWidgets [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Widget ResourceName
forall {n}. Widget n
barLine]

{- | Render one beat's column of one staff row: a rest glyph if the beat is
a rest sitting on the staff's middle line (position 4), blank fill for
any other rest, or a notehead (via 'noteheadGlyph') if any of the beat's
notes maps to this row's 'pitchToStaffPos' — otherwise blank fill, since
most rows have no note on a given beat.
-}
renderBeatAtPos :: Int -> Instrument -> Int -> Char -> BeatIndex -> [Beat] -> Widget ResourceName
renderBeatAtPos :: Int
-> Instrument
-> Int
-> Char
-> BeatIndex
-> [Beat]
-> Widget ResourceName
renderBeatAtPos Int
zoom Instrument
instr Int
staffPos Char
fillChar (BeatIndex Int
bIdx) [Beat]
beats =
    let mBeat :: Maybe Beat
mBeat = case Int -> [Beat] -> [Beat]
forall a. Int -> [a] -> [a]
drop Int
bIdx [Beat]
beats of
            (Beat
b : [Beat]
_) -> Beat -> Maybe Beat
forall a. a -> Maybe a
Just Beat
b
            [] -> Maybe Beat
forall a. Maybe a
Nothing
        colWidth :: Int
colWidth = case Maybe Beat
mBeat of
            Just Beat
b -> Int -> Duration -> Int
beatColumnWidth Int
zoom (Beat -> Duration
beatDuration Beat
b)
            Maybe Beat
Nothing -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 Int
zoom
     in case Maybe Beat
mBeat of
            Maybe Beat
Nothing -> String -> Widget ResourceName
forall n. String -> Widget n
str (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
colWidth Char
fillChar)
            Just Beat
beat
                | Beat -> Bool
beatIsRest Beat
beat Bool -> Bool -> Bool
&& Int
staffPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 ->
                    -- Rest at middle of staff
                    String -> Widget ResourceName
forall n. String -> Widget n
str (Int -> Char -> Char -> String
placeGlyph Int
colWidth Char
fillChar Char
'𝄾')
                | Beat -> Bool
beatIsRest Beat
beat ->
                    String -> Widget ResourceName
forall n. String -> Widget n
str (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
colWidth Char
fillChar)
                | Bool
otherwise ->
                    let matching :: [Note]
matching = (Note -> Bool) -> [Note] -> [Note]
forall a. (a -> Bool) -> [a] -> [a]
filter (Instrument -> Int -> Note -> Bool
noteOnStaffPos Instrument
instr Int
staffPos) (Beat -> [Note]
beatNotes Beat
beat)
                     in if [Note] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note]
matching
                            then String -> Widget ResourceName
forall n. String -> Widget n
str (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
colWidth Char
fillChar)
                            else
                                let nh :: Char
nh = Duration -> Char
noteheadGlyph (Beat -> Duration
beatDuration Beat
beat)
                                 in String -> Widget ResourceName
forall n. String -> Widget n
str (Int -> Char -> Char -> String
placeGlyph Int
colWidth Char
fillChar Char
nh)

{- | Does this note's pitch map to the given staff position, for this
instrument's clef\/pitch mapping?
-}
noteOnStaffPos :: Instrument -> Int -> Note -> Bool
noteOnStaffPos :: Instrument -> Int -> Note -> Bool
noteOnStaffPos Instrument
instr Int
targetPos Note
note =
    Instrument -> Pitch -> Int
pitchToStaffPos Instrument
instr (Note -> Pitch
notePitch Note
note) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
targetPos

-- | Place a glyph character centered in a cell.
placeGlyph :: Int -> Char -> Char -> String
placeGlyph :: Int -> Char -> Char -> String
placeGlyph Int
w Char
fillChar Char
glyph
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = [Char
glyph]
    | Bool
otherwise =
        let remaining :: Int
remaining = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            lPad :: Int
lPad = Int
remaining Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            rPad :: Int
rPad = Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lPad
         in Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
lPad Char
fillChar String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
glyph] String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
rPad Char
fillChar