{- | GP-style ASCII\/Unicode tablature rendering: one text row per string,
fret numbers overlaid on horizontal line characters, measures separated
by bar-line columns.

Column layout is duration-proportional: 'beatColumnWidth' scales a
beat's column with its 'Duration' relative to 'asZoom' so, e.g., an
eighth note takes half the width of a quarter note at the same zoom.
Because the viewport is narrower than the whole song, 'findVisibleRange'
decides which window of measures to actually draw, always keeping the
cursor's measure on screen. 'findVisibleRange' and 'beatColumnWidth' are
exported because "Termtab.UI.Widgets.Notation" reuses them so its staff
rendering lines up column-for-column with the tab below it.
-}
module Termtab.UI.Widgets.Tablature (renderTablature, cursorAttr, playheadAttr, selectionAttr, barLineAttr, stringLabelAttr, findVisibleRange, beatColumnWidth) where

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

import Termtab.Types
import Termtab.UI.Types

-- | Attribute name for the cell under the editing cursor.
cursorAttr :: AttrName
cursorAttr :: AttrName
cursorAttr = String -> AttrName
attrName String
"cursor"

-- | Attribute name for the cell at the current playback position.
playheadAttr :: AttrName
playheadAttr :: AttrName
playheadAttr = String -> AttrName
attrName String
"playhead"

-- | Attribute name for cells within the active 'VisualMode' selection.
selectionAttr :: AttrName
selectionAttr :: AttrName
selectionAttr = String -> AttrName
attrName String
"selection"

-- | Attribute name for measure-boundary bar-line characters.
barLineAttr :: AttrName
barLineAttr :: AttrName
barLineAttr = String -> AttrName
attrName String
"barLine"

{- | Attribute name for the leading per-string label column (T\/A\/B or a
line character).
-}
stringLabelAttr :: AttrName
stringLabelAttr :: AttrName
stringLabelAttr = String -> AttrName
attrName String
"stringLabel"

-- | Unicode line character for string lines
line :: Char
line :: Char
line = Char
'─'

-- | Unicode vertical bar for measure boundaries
bar :: String
bar :: String
bar = String
"│"

{- | Render one track's tab: a measure-number header row, then one string
line per string (drawn high-to-low via @reverse@, matching how guitar
tab is conventionally written with the highest string on top).
Available width comes from Brick's layout context (@getContext@) rather
than a parameter, so the visible measure range adapts to however much
horizontal space the panel is actually given.
-}
renderTablature :: AppState -> TrackIndex -> Widget ResourceName
renderTablature :: AppState -> TrackIndex -> Widget ResourceName
renderTablature AppState
st TrackIndex
tIdx = Size
-> Size
-> RenderM ResourceName (Result ResourceName)
-> Widget ResourceName
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM ResourceName (Result ResourceName) -> Widget ResourceName)
-> RenderM ResourceName (Result ResourceName)
-> Widget ResourceName
forall a b. (a -> b) -> a -> b
$ do
    ctx <- RenderM ResourceName (Context ResourceName)
forall n. RenderM n (Context n)
getContext
    let w = Context ResourceName -> Int
forall n. Context n -> Int
availWidth Context ResourceName
ctx
        track = TrackIndex -> Song -> Track
getTrack TrackIndex
tIdx (AppState -> Song
asSong AppState
st)
        nStrings = Track -> Int
stringCountForTrack' Track
track
        labelWidth = Int
1 -- single character: T, A, B, or ─
        contentWidth = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
labelWidth
        measures = Song -> [Measure]
songMeasures (AppState -> Song
asSong AppState
st)
        zoom = AppState -> Int
asZoom AppState
st
        MeasureIndex cursorM = asCurrentMeasure st
        -- Find the best starting measure: latest start that still includes the cursor
        visibleMeasures = Track
-> [Measure]
-> Int
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
findVisibleRange Track
track [Measure]
measures Int
zoom Int
contentWidth Int
cursorM
        isFocused = TrackIndex
tIdx TrackIndex -> TrackIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> TrackIndex
asCurrentTrack AppState
st
        labels = Int -> [String]
tabLabels Int
nStrings
    render $
        vBox $
            [renderMeasureNumberRow labelWidth zoom visibleMeasures]
                ++ [ renderStringLine st isFocused labelWidth zoom visibleMeasures (StringIndex si) (labels !! si)
                   | si <- reverse [0 .. nStrings - 1]
                   ]

{- | Look up a track by index, substituting a placeholder track if out of
range (same defensive fallback as "Termtab.UI.Widgets.Notation"'s
@getTrack@ — this widget must always have something to draw).
-}
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

{- | String count for tab rendering: a fretless 'Standard' instrument still
gets one row (so a non-fretted track has a visible line to put notation
markers relative to), unlike
'Termtab.UI.Types.stringCountForTrack' which reports 0 for it.
-}
stringCountForTrack' :: Track -> Int
stringCountForTrack' :: Track -> Int
stringCountForTrack' Track
track = case Track -> Instrument
trackInstrument Track
track of
    Guitar [Pitch]
_ Int
n -> Int
n
    Bass [Pitch]
_ Int
n -> Int
n
    Standard MidiProgram
_ -> Int
1

{- | GP-style labels: "T", "A", "B" on top 3 strings (which are the highest-pitched,
rendered first since we reverse), rest get line character.
-}
tabLabels :: Int -> [String]
tabLabels :: Int -> [String]
tabLabels Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 =
        Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Char
line] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"B", String
"A", String
"T"]
    | Bool
otherwise = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n [Char
line]

-- | Render measure numbers above the tab
renderMeasureNumberRow :: Int -> Int -> [(MeasureIndex, [Beat], Measure)] -> Widget ResourceName
renderMeasureNumberRow :: Int
-> Int -> [(MeasureIndex, [Beat], Measure)] -> Widget ResourceName
renderMeasureNumberRow Int
labelWidth Int
zoom [(MeasureIndex, [Beat], Measure)]
visibleMeasures =
    [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 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
labelWidth Char
' ')]
            [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ ((MeasureIndex, [Beat], Measure) -> Widget ResourceName)
-> [(MeasureIndex, [Beat], Measure)] -> [Widget ResourceName]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (MeasureIndex, [Beat], Measure) -> Widget ResourceName
renderMeasureNumber Int
zoom) [(MeasureIndex, [Beat], Measure)]
visibleMeasures

{- | Render one measure's 1-based number, left-aligned and padded with
spaces to exactly the width 'renderMeasureOnString' will draw that same
measure at (including its trailing bar-line column), so the number
lines up with the measure below it regardless of how many beats it has.
-}
renderMeasureNumber :: Int -> (MeasureIndex, [Beat], Measure) -> Widget ResourceName
renderMeasureNumber :: Int -> (MeasureIndex, [Beat], Measure) -> Widget ResourceName
renderMeasureNumber Int
zoom (MeasureIndex Int
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)
        emptySlotCount :: Int
emptySlotCount = if Int
zoom 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
zoom else Int
0
        actualTotalCols :: Int
actualTotalCols = Int
usedCols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
emptySlotCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
zoom
        mNum :: String
mNum = Int -> String
forall a. Show a => a -> String
show (Int
mi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        -- +1 for the bar line character
        padded :: String
padded = String
mNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
actualTotalCols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
mNum)) Char
' '
     in String -> Widget ResourceName
forall n. String -> Widget n
str String
padded

-- | Column width for a beat, minimum 3 to fit double-digit frets
beatColumnWidth :: Int -> Duration -> Int
beatColumnWidth :: Int -> Duration -> Int
beatColumnWidth Int
zoom Duration
dur = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 (Int
zoom Int -> Int -> Int
forall a. Num a => a -> a -> a
* Duration -> Int
durationWeight Duration
dur Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)

{- | Sixteenth-note units per 'Duration', used by 'beatColumnWidth' to
scale column width proportionally to note length.
-}
durationWeight :: Duration -> Int
durationWeight :: Duration -> Int
durationWeight Duration
Whole = Int
16
durationWeight Duration
Half = Int
8
durationWeight Duration
Quarter = Int
4
durationWeight Duration
Eighth = Int
2
durationWeight Duration
Sixteenth = Int
1
durationWeight Duration
Thirty2nd = Int
1
durationWeight (Dotted Duration
d) = Duration -> Int
durationWeight Duration
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Duration -> Int
durationWeight Duration
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
durationWeight (Triplet Duration
d) = Duration -> Int
durationWeight Duration
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3

{- | Total column width a measure occupies at a given zoom, assuming every
beat in it is a plain quarter note (the time signature's numerator times
zoom), plus one for its trailing bar line. Used only by
'findVisibleRange'\/'fitMeasures' to decide how many measures fit —
actual rendering instead sums real per-beat widths via
'beatColumnWidth', so this is an approximation that's exact only when a
measure's beats are all quarters.
-}
measureWidthFromTimeSig :: Int -> Measure -> Int
measureWidthFromTimeSig :: Int -> Measure -> Int
measureWidthFromTimeSig Int
zoom Measure
m =
    let TimeSignature Int
num Int
_ = Measure -> TimeSignature
timeSignature Measure
m
     in Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
zoom Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

{- | Find the best visible range: start as early as possible while
ensuring the cursor measure is visible and the width is filled.
-}
findVisibleRange :: Track -> [Measure] -> Int -> Int -> Int -> [(MeasureIndex, [Beat], Measure)]
findVisibleRange :: Track
-> [Measure]
-> Int
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
findVisibleRange Track
track [Measure]
measures Int
zoom Int
availW Int
cursorM =
    -- Try each possible start from 0 to cursorM, pick the latest one
    -- that still includes the cursor measure
    let candidates :: [(Int, [(MeasureIndex, [Beat], Measure)])]
candidates =
            [ (Int
startM, [(MeasureIndex, [Beat], Measure)]
fitted)
            | Int
startM <- [Int
0 .. Int
cursorM]
            , let fitted :: [(MeasureIndex, [Beat], Measure)]
fitted = Track
-> [Measure]
-> Int
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
fitMeasures Track
track [Measure]
measures Int
zoom Int
availW Int
startM
            , ((MeasureIndex, [Beat], Measure) -> Bool)
-> [(MeasureIndex, [Beat], Measure)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(MeasureIndex Int
mi, [Beat]
_, Measure
_) -> Int
mi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cursorM) [(MeasureIndex, [Beat], Measure)]
fitted
            ]
     in case [(Int, [(MeasureIndex, [Beat], Measure)])]
candidates of
            [] -> Track
-> [Measure]
-> Int
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
fitMeasures Track
track [Measure]
measures Int
zoom Int
availW Int
cursorM
            ((Int
_, [(MeasureIndex, [Beat], Measure)]
fitted) : [(Int, [(MeasureIndex, [Beat], Measure)])]
_) -> [(MeasureIndex, [Beat], Measure)]
fitted

{- | Greedily collect measures starting at @startM@ until the next one
wouldn't fit in @availW@ columns (per 'measureWidthFromTimeSig'), always
including at least the @startM@ measure itself even if it alone exceeds
the available width (an over-wide measure still needs to be shown, just
alone). Used by 'findVisibleRange' to test each candidate starting
measure.
-}
fitMeasures :: Track -> [Measure] -> Int -> Int -> Int -> [(MeasureIndex, [Beat], Measure)]
fitMeasures :: Track
-> [Measure]
-> Int
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
fitMeasures Track
track [Measure]
measures Int
zoom Int
availW Int
startM = Int -> Int -> [(MeasureIndex, [Beat], Measure)]
go Int
startM Int
availW
  where
    totalM :: Int
totalM = [Measure] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Measure]
measures
    go :: Int -> Int -> [(MeasureIndex, [Beat], Measure)]
go Int
mi Int
remaining
        | Int
mi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
totalM = []
        | Bool
otherwise =
            let measure :: Measure
measure = [Measure]
measures [Measure] -> Int -> Measure
forall a. HasCallStack => [a] -> Int -> a
!! Int
mi
                beats :: [Beat]
beats = Track -> MeasureIndex -> [Beat]
beatsForTrackMeasure Track
track (Int -> MeasureIndex
MeasureIndex Int
mi)
                mWidth :: Int
mWidth = Int -> Measure -> Int
measureWidthFromTimeSig Int
zoom Measure
measure
             in if Int
mWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
remaining Bool -> Bool -> Bool
&& Int
mi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
startM
                    then []
                    else (Int -> MeasureIndex
MeasureIndex Int
mi, [Beat]
beats, Measure
measure) (MeasureIndex, [Beat], Measure)
-> [(MeasureIndex, [Beat], Measure)]
-> [(MeasureIndex, [Beat], Measure)]
forall a. a -> [a] -> [a]
: Int -> Int -> [(MeasureIndex, [Beat], Measure)]
go (Int
mi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mWidth)

{- | Render one full string's line: its label\/line-character cell followed
by every visible measure's cells for that string.
-}
renderStringLine ::
    AppState ->
    Bool ->
    Int ->
    Int ->
    [(MeasureIndex, [Beat], Measure)] ->
    StringIndex ->
    String ->
    Widget ResourceName
renderStringLine :: AppState
-> Bool
-> Int
-> Int
-> [(MeasureIndex, [Beat], Measure)]
-> StringIndex
-> String
-> Widget ResourceName
renderStringLine AppState
st Bool
isFocused Int
_labelWidth Int
zoom [(MeasureIndex, [Beat], Measure)]
visibleMeasures StringIndex
sIdx String
label =
    [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
$
        [AttrName -> Widget ResourceName -> Widget ResourceName
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
stringLabelAttr (String -> Widget ResourceName
forall n. String -> Widget n
str String
label)]
            [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 (AppState
-> Bool
-> Int
-> StringIndex
-> (MeasureIndex, [Beat], Measure)
-> [Widget ResourceName]
renderMeasureOnString AppState
st Bool
isFocused Int
zoom StringIndex
sIdx) [(MeasureIndex, [Beat], Measure)]
visibleMeasures

{- | Render one measure's cells on one string: an actual cell per real beat
('renderBeatCell'), then padding cells for the measure's unused duration
('renderEmptyCell'), then a bar-line cell — the same actual\/padding\/
bar-line structure as "Termtab.UI.Widgets.Notation"'s
@renderMeasureAtPos@, kept independent here because tab cells carry
fret numbers instead of noteheads.
-}
renderMeasureOnString ::
    AppState ->
    Bool ->
    Int ->
    StringIndex ->
    (MeasureIndex, [Beat], Measure) ->
    [Widget ResourceName]
renderMeasureOnString :: AppState
-> Bool
-> Int
-> StringIndex
-> (MeasureIndex, [Beat], Measure)
-> [Widget ResourceName]
renderMeasureOnString AppState
st Bool
isFocused Int
zoom StringIndex
sIdx (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 =
            [ AppState
-> Bool
-> Int
-> StringIndex
-> MeasureIndex
-> BeatIndex
-> [Beat]
-> Widget ResourceName
renderBeatCell AppState
st Bool
isFocused Int
zoom StringIndex
sIdx MeasureIndex
mi (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 ResourceName]
emptyWidgets =
            [ AppState
-> Bool
-> StringIndex
-> MeasureIndex
-> BeatIndex
-> Int
-> Widget ResourceName
renderEmptyCell AppState
st Bool
isFocused StringIndex
sIdx MeasureIndex
mi (Int -> BeatIndex
BeatIndex Int
bi) Int
emptySlotWidth
            | Int
bi <- [[Beat] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Beat]
beats .. [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
emptySlotCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]
        barLine :: Widget n
barLine = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
barLineAttr (String -> Widget n
forall n. String -> Widget n
str String
bar)
     in [Widget ResourceName]
beatWidgets [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Widget ResourceName]
emptyWidgets [Widget ResourceName]
-> [Widget ResourceName] -> [Widget ResourceName]
forall a. [a] -> [a] -> [a]
++ [Widget ResourceName
forall {n}. Widget n
barLine]

{- | Render a padding cell (a beat slot past the track's actual beat list,
filling out the measure's declared duration): a line-character run,
highlighted with 'cursorAttr' if the cursor happens to be positioned in
this empty slot on the focused track\/string.
-}
renderEmptyCell ::
    AppState ->
    Bool ->
    StringIndex ->
    MeasureIndex ->
    BeatIndex ->
    Int ->
    Widget ResourceName
renderEmptyCell :: AppState
-> Bool
-> StringIndex
-> MeasureIndex
-> BeatIndex
-> Int
-> Widget ResourceName
renderEmptyCell AppState
st Bool
isFocused StringIndex
sIdx MeasureIndex
mi BeatIndex
bi Int
colWidth =
    let cell :: String
cell = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
colWidth) Char
line
        isCursor :: Bool
isCursor =
            Bool
isFocused
                Bool -> Bool -> Bool
&& MeasureIndex
mi MeasureIndex -> MeasureIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> MeasureIndex
asCurrentMeasure AppState
st
                Bool -> Bool -> Bool
&& BeatIndex
bi BeatIndex -> BeatIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> BeatIndex
asCurrentBeat AppState
st
                Bool -> Bool -> Bool
&& StringIndex
sIdx StringIndex -> StringIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> StringIndex
asCurrentString AppState
st
        attr :: AttrName
attr
            | Bool
isCursor = AttrName
cursorAttr
            | Bool
otherwise = AttrName
forall a. Monoid a => a
mempty
     in AttrName -> Widget ResourceName -> Widget ResourceName
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attr (String -> Widget ResourceName
forall n. String -> Widget n
str String
cell)

{- | Render one real beat's cell on one string: the fret number if this
beat has a note on this string ('fretOnString'), overlaid on the
line-character fill via 'fretOnLine'; otherwise plain fill. Highlighted
with (in priority order) 'cursorAttr' if this is the editing cursor,
'selectionAttr' if within the active 'VisualMode' selection range (only
ever true within the current measure — selection doesn't span
measures), or 'playheadAttr' if this is the current playback position.
-}
renderBeatCell ::
    AppState ->
    Bool ->
    Int ->
    StringIndex ->
    MeasureIndex ->
    BeatIndex ->
    [Beat] ->
    Widget ResourceName
renderBeatCell :: AppState
-> Bool
-> Int
-> StringIndex
-> MeasureIndex
-> BeatIndex
-> [Beat]
-> Widget ResourceName
renderBeatCell AppState
st Bool
isFocused Int
zoom StringIndex
sIdx MeasureIndex
mi BeatIndex
bi [Beat]
beats =
    let BeatIndex Int
bIdx = BeatIndex
bi
        mBeat :: Maybe Beat
mBeat = case Int -> [Beat] -> [Beat]
forall a. Int -> [a] -> [a]
drop Int
bIdx [Beat]
beats of
            (Beat
beat : [Beat]
_) -> Beat -> Maybe Beat
forall a. a -> Maybe a
Just Beat
beat
            [] -> Maybe Beat
forall a. Maybe a
Nothing
        colWidth :: Int
colWidth = case Maybe Beat
mBeat of
            Just Beat
beat -> Int -> Duration -> Int
beatColumnWidth Int
zoom (Beat -> Duration
beatDuration Beat
beat)
            Maybe Beat
Nothing -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 Int
zoom
        fretText :: Maybe Int
fretText = case Maybe Beat
mBeat of
            Just Beat
beat -> StringIndex -> Beat -> Maybe Int
fretOnString StringIndex
sIdx Beat
beat
            Maybe Beat
Nothing -> Maybe Int
forall a. Maybe a
Nothing
        cell :: String
cell = case Maybe Int
fretText of
            Just Int
f -> Int -> String -> String
fretOnLine Int
colWidth (Int -> String
forall a. Show a => a -> String
show Int
f)
            Maybe Int
Nothing -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
colWidth Char
line
        isCursor :: Bool
isCursor =
            Bool
isFocused
                Bool -> Bool -> Bool
&& MeasureIndex
mi MeasureIndex -> MeasureIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> MeasureIndex
asCurrentMeasure AppState
st
                Bool -> Bool -> Bool
&& BeatIndex
bi BeatIndex -> BeatIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> BeatIndex
asCurrentBeat AppState
st
                Bool -> Bool -> Bool
&& StringIndex
sIdx StringIndex -> StringIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> StringIndex
asCurrentString AppState
st
        isPlayhead :: Bool
isPlayhead =
            AppState -> Maybe MeasureIndex
asPlayheadMeasure AppState
st Maybe MeasureIndex -> Maybe MeasureIndex -> Bool
forall a. Eq a => a -> a -> Bool
== MeasureIndex -> Maybe MeasureIndex
forall a. a -> Maybe a
Just MeasureIndex
mi
                Bool -> Bool -> Bool
&& AppState -> Maybe BeatIndex
asPlayheadBeat AppState
st Maybe BeatIndex -> Maybe BeatIndex -> Bool
forall a. Eq a => a -> a -> Bool
== BeatIndex -> Maybe BeatIndex
forall a. a -> Maybe a
Just BeatIndex
bi
        isSelected :: Bool
isSelected = case AppState -> Maybe (MeasureIndex, BeatIndex)
asSelectionStart AppState
st of
            Just (MeasureIndex
selMi, BeatIndex
selBi) ->
                MeasureIndex
mi MeasureIndex -> MeasureIndex -> Bool
forall a. Eq a => a -> a -> Bool
== MeasureIndex
selMi
                    Bool -> Bool -> Bool
&& MeasureIndex
mi MeasureIndex -> MeasureIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AppState -> MeasureIndex
asCurrentMeasure AppState
st
                    Bool -> Bool -> Bool
&& let BeatIndex Int
s = BeatIndex -> BeatIndex -> BeatIndex
forall a. Ord a => a -> a -> a
min BeatIndex
selBi (AppState -> BeatIndex
asCurrentBeat AppState
st)
                           BeatIndex Int
e = BeatIndex -> BeatIndex -> BeatIndex
forall a. Ord a => a -> a -> a
max BeatIndex
selBi (AppState -> BeatIndex
asCurrentBeat AppState
st)
                           BeatIndex Int
b = BeatIndex
bi
                        in Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e
            Maybe (MeasureIndex, BeatIndex)
Nothing -> Bool
False
        attr :: AttrName
attr
            | Bool
isCursor = AttrName
cursorAttr
            | Bool
isSelected = AttrName
selectionAttr
            | Bool
isPlayhead = AttrName
playheadAttr
            | Bool
otherwise = AttrName
forall a. Monoid a => a
mempty
     in AttrName -> Widget ResourceName -> Widget ResourceName
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attr (String -> Widget ResourceName
forall n. String -> Widget n
str String
cell)

-- | Place a fret number on a line: ─5── or 12── (number replaces line segments)
fretOnLine :: Int -> String -> String
fretOnLine :: Int -> String -> String
fretOnLine Int
w String
s
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w String
s
    | Bool
otherwise =
        let remaining :: Int
remaining = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len
            padLeft :: Int
padLeft = Int
remaining Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            padRight :: Int
padRight = Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padLeft
         in Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padLeft Char
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padRight Char
line
  where
    len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s

-- | The fret number fretted on a given string within a beat, if any.
fretOnString :: StringIndex -> Beat -> Maybe Int
fretOnString :: StringIndex -> Beat -> Maybe Int
fretOnString StringIndex
sIdx Beat
beat =
    case (Note -> Bool) -> [Note] -> [Note]
forall a. (a -> Bool) -> [a] -> [a]
filter (StringIndex -> Note -> Bool
matchesString StringIndex
sIdx) (Beat -> [Note]
beatNotes Beat
beat) of
        (Note
n : [Note]
_) -> case Note -> Maybe FretNumber
noteFret Note
n of
            Just (FretNumber Int
f) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
f
            Maybe FretNumber
Nothing -> Maybe Int
forall a. Maybe a
Nothing
        [] -> Maybe Int
forall a. Maybe a
Nothing

-- | Is this note fretted on the given string?
matchesString :: StringIndex -> Note -> Bool
matchesString :: StringIndex -> Note -> Bool
matchesString StringIndex
sIdx Note
n = Note -> Maybe StringIndex
noteString Note
n Maybe StringIndex -> Maybe StringIndex -> Bool
forall a. Eq a => a -> a -> Bool
== StringIndex -> Maybe StringIndex
forall a. a -> Maybe a
Just StringIndex
sIdx