{- | Rasterized standard-notation renderer.

Composes the visible measures of a track into a single RGBA image: a five-line
staff, a treble clef, bar lines, and Bravura noteheads/rests placed at their
staff positions. This is the image that the Kitty/Sixel backends blit above the
tab grid.

Beat x-positions are derived from the same @beatColumnWidth@ column math the tab
uses, so notation and tab stay column-aligned. The mapping from columns to
pixels ('nlColWidthPx') is a layout parameter tuned against the terminal's real
cell size when the renderer is wired into the UI (Phase 0).

Note: this imports 'beatColumnWidth' from the tab widget for now; that column
helper is a candidate for extraction into a shared layout module later.
-}
module Termtab.Graphics.Notation (
    NotationLayout (..),
    defaultLayout,
    renderNotationImage,
    totalColumns,
) where

import Codec.Picture
import Codec.Picture.Types (MutableImage (..), createMutableImage, readPixel, unsafeFreezeImage, writePixel)
import Control.Monad (forM_)
import Control.Monad.ST (RealWorld)
import Data.Word (Word8)

import Termtab.Graphics.Font
import Termtab.Graphics.FreeType (GlyphBitmap (..))
import Termtab.Notation.Staff
import Termtab.Types
import Termtab.UI.Widgets.Tablature (beatColumnWidth)

-- | Pixel geometry for the notation image.
data NotationLayout = NotationLayout
    { NotationLayout -> Int
nlStepPx :: Int
    -- ^ Vertical pixels between adjacent staff positions (line <-> space).
    , NotationLayout -> Int
nlColWidthPx :: Int
    -- ^ Pixels per tab column (governs horizontal scale + tab alignment).
    , NotationLayout -> Int
nlLabelCols :: Int
    -- ^ Columns reserved at the left for the clef (matches the tab's label column).
    , NotationLayout -> Int
nlLedgerAbove :: Int
    -- ^ Extra staff positions of headroom above the top line.
    , NotationLayout -> Int
nlLedgerBelow :: Int
    -- ^ Extra staff positions of headroom below the bottom line.
    , NotationLayout -> Int
nlMarginPx :: Int
    -- ^ Top/bottom padding in pixels.
    }
    deriving (Int -> NotationLayout -> ShowS
[NotationLayout] -> ShowS
NotationLayout -> String
(Int -> NotationLayout -> ShowS)
-> (NotationLayout -> String)
-> ([NotationLayout] -> ShowS)
-> Show NotationLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotationLayout -> ShowS
showsPrec :: Int -> NotationLayout -> ShowS
$cshow :: NotationLayout -> String
show :: NotationLayout -> String
$cshowList :: [NotationLayout] -> ShowS
showList :: [NotationLayout] -> ShowS
Show, NotationLayout -> NotationLayout -> Bool
(NotationLayout -> NotationLayout -> Bool)
-> (NotationLayout -> NotationLayout -> Bool) -> Eq NotationLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotationLayout -> NotationLayout -> Bool
== :: NotationLayout -> NotationLayout -> Bool
$c/= :: NotationLayout -> NotationLayout -> Bool
/= :: NotationLayout -> NotationLayout -> Bool
Eq)

{- | The layout used everywhere the UI renders notation images (see
"Termtab.UI.NotationGraphics"). A distinct 'NotationLayout' could be
built for a different pixel density, but nothing in the codebase
currently does so.
-}
defaultLayout :: NotationLayout
defaultLayout :: NotationLayout
defaultLayout =
    NotationLayout
        { nlStepPx :: Int
nlStepPx = Int
6
        , nlColWidthPx :: Int
nlColWidthPx = Int
10
        , nlLabelCols :: Int
nlLabelCols = Int
1
        , nlLedgerAbove :: Int
nlLedgerAbove = Int
4
        , nlLedgerBelow :: Int
nlLedgerBelow = Int
4
        , nlMarginPx :: Int
nlMarginPx = Int
4
        }

type Canvas = MutableImage RealWorld PixelRGBA8

{- | Render the visible measures of a track to an RGBA notation image.

The background is fully transparent and all ink (staff, clef, bar lines,
noteheads) is drawn in @ink@ — pass the terminal's foreground color so the
notation adopts the user's theme (see "Termtab.Graphics.TermColor"). Glyph
anti-aliasing is preserved via the alpha channel.
-}
renderNotationImage ::
    GlyphFont ->
    NotationLayout ->
    PixelRGBA8 ->
    Int ->
    Instrument ->
    [(MeasureIndex, [Beat], Measure)] ->
    IO (Image PixelRGBA8)
renderNotationImage :: GlyphFont
-> NotationLayout
-> PixelRGBA8
-> Int
-> Instrument
-> [(MeasureIndex, [Beat], Measure)]
-> IO (Image PixelRGBA8)
renderNotationImage GlyphFont
font NotationLayout
nl PixelRGBA8
ink Int
zoom Instrument
instr [(MeasureIndex, [Beat], Measure)]
measures = do
    let totalCols :: Int
totalCols = NotationLayout -> Int -> [(MeasureIndex, [Beat], Measure)] -> Int
totalColumns NotationLayout
nl Int
zoom [(MeasureIndex, [Beat], Measure)]
measures
        width :: Int
width = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
totalCols Int -> Int -> Int
forall a. Num a => a -> a -> a
* NotationLayout -> Int
nlColWidthPx NotationLayout
nl)
        topPos :: Int
topPos = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ NotationLayout -> Int
nlLedgerAbove NotationLayout
nl
        bottomPos :: Int
bottomPos = Int -> Int
forall a. Num a => a -> a
negate (NotationLayout -> Int
nlLedgerBelow NotationLayout
nl)
        height :: Int
height = NotationLayout -> Int
nlMarginPx NotationLayout
nl Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
topPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bottomPos) Int -> Int -> Int
forall a. Num a => a -> a -> a
* NotationLayout -> Int
nlStepPx NotationLayout
nl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        glyphSize :: Int
glyphSize = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* NotationLayout -> Int
nlStepPx NotationLayout
nl
        yOf :: Int -> Int
yOf Int
pos = NotationLayout -> Int
nlMarginPx NotationLayout
nl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
topPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) Int -> Int -> Int
forall a. Num a => a -> a -> a
* NotationLayout -> Int
nlStepPx NotationLayout
nl
        xOf :: Double -> b
xOf Double
col = Double -> b
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
col Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NotationLayout -> Int
nlColWidthPx NotationLayout
nl) :: Double)
        lineThick :: Int
lineThick = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (NotationLayout -> Int
nlStepPx NotationLayout
nl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)
        barThick :: Int
barThick = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (NotationLayout -> Int
nlStepPx NotationLayout
nl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3)
    -- Transparent background: the terminal's own background shows through.
    canvas <- Int
-> Int -> PixelRGBA8 -> IO (MutableImage (PrimState IO) PixelRGBA8)
forall px (m :: * -> *).
(Pixel px, PrimMonad m) =>
Int -> Int -> px -> m (MutableImage (PrimState m) px)
createMutableImage Int
width Int
height (Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
PixelRGBA8 Word8
0 Word8
0 Word8
0 Word8
0)

    -- Five staff lines across the full width.
    forM_ [0, 2, 4, 6, 8] $ \Int
pos ->
        Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawHLine Canvas
canvas PixelRGBA8
ink Int
0 (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int
yOf Int
pos) Int
lineThick

    -- Treble clef at the left, baseline on the G4 line (position 2).
    mClef <- cachedGlyph font glyphSize gClefGlyph
    forM_ mClef $ \GlyphBitmap
gb -> Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphAt Canvas
canvas PixelRGBA8
ink (NotationLayout -> Int
nlColWidthPx NotationLayout
nl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Int -> Int
yOf Int
2) GlyphBitmap
gb

    let Placed placedBeats barCols = layoutColumns nl zoom measures

    -- Bar lines run from the top line to the bottom line.
    forM_ barCols $ \Int
bc ->
        Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawVLine Canvas
canvas PixelRGBA8
ink (Double -> Int
forall b. Integral b => Double -> b
xOf (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc)) (Int -> Int
yOf Int
8) (Int -> Int
yOf Int
0) Int
barThick

    -- Beats: rests near the middle line, noteheads at their staff positions.
    forM_ placedBeats $ \(Double
centerCol, Beat
beat) -> do
        let cx :: Int
cx = Double -> Int
forall b. Integral b => Double -> b
xOf Double
centerCol
        if Beat -> Bool
beatIsRest Beat
beat
            then do
                mg <- GlyphFont -> Int -> Char -> IO (Maybe GlyphBitmap)
cachedGlyph GlyphFont
font Int
glyphSize (Duration -> Char
restGlyph (Beat -> Duration
beatDuration Beat
beat))
                forM_ mg $ \GlyphBitmap
gb -> Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphCentered Canvas
canvas PixelRGBA8
ink Int
cx (Int -> Int
yOf Int
4) GlyphBitmap
gb
            else [Note] -> (Note -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Beat -> [Note]
beatNotes Beat
beat) ((Note -> IO ()) -> IO ()) -> (Note -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Note
note -> do
                let pos :: Int
pos = Instrument -> Pitch -> Int
pitchToStaffPos Instrument
instr (Note -> Pitch
notePitch Note
note)
                mg <- GlyphFont -> Int -> Char -> IO (Maybe GlyphBitmap)
cachedGlyph GlyphFont
font Int
glyphSize (Duration -> Char
noteheadGlyph (Beat -> Duration
beatDuration Beat
beat))
                forM_ mg $ \GlyphBitmap
gb -> do
                    Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphCentered Canvas
canvas PixelRGBA8
ink Int
cx (Int -> Int
yOf Int
pos) GlyphBitmap
gb
                    Canvas
-> NotationLayout
-> PixelRGBA8
-> (Int -> Int)
-> Int
-> Int
-> Int
-> IO ()
drawLedgers Canvas
canvas NotationLayout
nl PixelRGBA8
ink Int -> Int
yOf Int
cx Int
width Int
pos

    unsafeFreezeImage canvas

-- Column layout -------------------------------------------------------------

{- | The result of 'layoutColumns': every visible beat's fractional center
column (for drawing it under 'renderNotationImage') alongside the
integer columns each measure's bar line falls on.
-}
data Placed = Placed
    { Placed -> [(Double, Beat)]
pBeats :: [(Double, Beat)]
    , Placed -> [Int]
pBarCols :: [Int]
    }

{- | Width in columns of one measure's content (excluding its bar line),
matching the tab's accounting: beats consume 'beatColumnWidth' each, then empty
quarter slots pad out any remaining nominal width. Subdivided measures whose
beats exceed the nominal width expand to fit (as the tab does).
-}
measureColumns :: Int -> [Beat] -> Measure -> Int
measureColumns :: Int -> [Beat] -> Measure -> Int
measureColumns Int
zoom [Beat]
beats Measure
measure =
    let TimeSignature Int
num Int
_ = Measure -> TimeSignature
timeSignature Measure
measure
        nominal :: Int
nominal = Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
zoom
        used :: Int
used = [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)
        remaining :: Int
remaining = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nominal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
used)
        emptySlots :: Int
emptySlots = if Int
zoom Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
remaining Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
zoom else Int
0
     in Int
used Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
emptySlots Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
zoom

-- | Total tab columns across all visible measures (label + measures + bar lines).
totalColumns :: NotationLayout -> Int -> [(MeasureIndex, [Beat], Measure)] -> Int
totalColumns :: NotationLayout -> Int -> [(MeasureIndex, [Beat], Measure)] -> Int
totalColumns NotationLayout
nl Int
zoom [(MeasureIndex, [Beat], Measure)]
measures =
    NotationLayout -> Int
nlLabelCols NotationLayout
nl
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int -> [Beat] -> Measure -> Int
measureColumns Int
zoom [Beat]
beats Measure
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 | (MeasureIndex
_, [Beat]
beats, Measure
m) <- [(MeasureIndex, [Beat], Measure)]
measures]

{- | Walk the measures assigning each beat a (fractional) center column and each
measure a bar-line column, mirroring the tab's column accounting.
-}
layoutColumns :: NotationLayout -> Int -> [(MeasureIndex, [Beat], Measure)] -> Placed
layoutColumns :: NotationLayout
-> Int -> [(MeasureIndex, [Beat], Measure)] -> Placed
layoutColumns NotationLayout
nl Int
zoom = Double -> [(MeasureIndex, [Beat], Measure)] -> Placed
forall {a}. Double -> [(a, [Beat], Measure)] -> Placed
go (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NotationLayout -> Int
nlLabelCols NotationLayout
nl))
  where
    go :: Double -> [(a, [Beat], Measure)] -> Placed
go Double
_ [] = [(Double, Beat)] -> [Int] -> Placed
Placed [] []
    go Double
startCol ((a
_, [Beat]
beats, Measure
m) : [(a, [Beat], Measure)]
rest) =
        let mw :: Int
mw = Int -> [Beat] -> Measure -> Int
measureColumns Int
zoom [Beat]
beats Measure
m
            placedBeats :: [(Double, Beat)]
placedBeats = Double -> [Beat] -> [(Double, Beat)]
forall {t}. Fractional t => t -> [Beat] -> [(t, Beat)]
placeBeats Double
startCol [Beat]
beats
            barCol :: Int
barCol = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mw
            Placed [(Double, Beat)]
bs [Int]
bars = Double -> [(a, [Beat], Measure)] -> Placed
go (Double
startCol Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) [(a, [Beat], Measure)]
rest
         in [(Double, Beat)] -> [Int] -> Placed
Placed ([(Double, Beat)]
placedBeats [(Double, Beat)] -> [(Double, Beat)] -> [(Double, Beat)]
forall a. [a] -> [a] -> [a]
++ [(Double, Beat)]
bs) (Int
barCol Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
bars)
    placeBeats :: t -> [Beat] -> [(t, Beat)]
placeBeats t
_ [] = []
    placeBeats t
c (Beat
b : [Beat]
bs) =
        let w :: Int
w = Int -> Duration -> Int
beatColumnWidth Int
zoom (Beat -> Duration
beatDuration Beat
b)
            center :: t
center = t
c t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w t -> t -> t
forall a. Fractional a => a -> a -> a
/ t
2
         in (t
center, Beat
b) (t, Beat) -> [(t, Beat)] -> [(t, Beat)]
forall a. a -> [a] -> [a]
: t -> [Beat] -> [(t, Beat)]
placeBeats (t
c t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) [Beat]
bs

-- Drawing primitives --------------------------------------------------------

-- | Short ledger lines for a note above/below the staff.
drawLedgers :: Canvas -> NotationLayout -> PixelRGBA8 -> (Int -> Int) -> Int -> Int -> Int -> IO ()
drawLedgers :: Canvas
-> NotationLayout
-> PixelRGBA8
-> (Int -> Int)
-> Int
-> Int
-> Int
-> IO ()
drawLedgers Canvas
canvas NotationLayout
nl PixelRGBA8
ink Int -> Int
yOf Int
cx Int
_width Int
pos =
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
positions ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
p ->
        Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawHLine Canvas
canvas PixelRGBA8
ink (Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
half) (Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
half) (Int -> Int
yOf Int
p) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (NotationLayout -> Int
nlStepPx NotationLayout
nl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4))
  where
    half :: Int
half = NotationLayout -> Int
nlColWidthPx NotationLayout
nl
    positions :: [Int]
positions
        | Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8 = [Int
p | Int
p <- [Int
10, Int
12 .. Int
pos]]
        | Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Int
p | Int
p <- [-Int
2, -Int
4 .. Int
pos]]
        | Bool
otherwise = []

drawHLine :: Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawHLine :: Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawHLine Canvas
canvas PixelRGBA8
ink Int
x0 Int
x1 Int
y Int
thick =
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
thick Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
t ->
        [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
x0 .. Int
x1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
x -> Canvas -> PixelRGBA8 -> Int -> Int -> IO ()
setInk Canvas
canvas PixelRGBA8
ink Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t)

drawVLine :: Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawVLine :: Canvas -> PixelRGBA8 -> Int -> Int -> Int -> Int -> IO ()
drawVLine Canvas
canvas PixelRGBA8
ink Int
x Int
y0 Int
y1 Int
thick =
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
thick Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
t ->
        [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
y0 .. Int
y1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
y -> Canvas -> PixelRGBA8 -> Int -> Int -> IO ()
setInk Canvas
canvas PixelRGBA8
ink (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t) Int
y

-- | Draw a glyph with its pen origin at (penX, baselineY).
drawGlyphAt :: Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphAt :: Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphAt Canvas
canvas PixelRGBA8
ink Int
penX Int
baselineY GlyphBitmap
gb = do
    let img :: Image Word8
img = GlyphBitmap -> Image Word8
gbImage GlyphBitmap
gb
        gw :: Int
gw = Image Word8 -> Int
forall a. Image a -> Int
imageWidth Image Word8
img
        gh :: Int
gh = Image Word8 -> Int
forall a. Image a -> Int
imageHeight Image Word8
img
        originX :: Int
originX = Int
penX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GlyphBitmap -> Int
gbLeft GlyphBitmap
gb
        originY :: Int
originY = Int
baselineY Int -> Int -> Int
forall a. Num a => a -> a -> a
- GlyphBitmap -> Int
gbTop GlyphBitmap
gb
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
gh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
gy ->
        [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
gw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
gx ->
            Canvas -> PixelRGBA8 -> Int -> Int -> Word8 -> IO ()
blendInk Canvas
canvas PixelRGBA8
ink (Int
originX Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gx) (Int
originY Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gy) (Image Word8 -> Int -> Int -> Word8
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image Word8
img Int
gx Int
gy)

-- | Draw a glyph horizontally centered on centerX, baseline at baselineY.
drawGlyphCentered :: Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphCentered :: Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphCentered Canvas
canvas PixelRGBA8
ink Int
centerX Int
baselineY GlyphBitmap
gb =
    Canvas -> PixelRGBA8 -> Int -> Int -> GlyphBitmap -> IO ()
drawGlyphAt Canvas
canvas PixelRGBA8
ink (Int
centerX Int -> Int -> Int
forall a. Num a => a -> a -> a
- GlyphBitmap -> Int
gbAdvance GlyphBitmap
gb Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
baselineY GlyphBitmap
gb

-- | Composite fully-opaque ink (used for staff/stems/bar lines).
setInk :: Canvas -> PixelRGBA8 -> Int -> Int -> IO ()
setInk :: Canvas -> PixelRGBA8 -> Int -> Int -> IO ()
setInk Canvas
canvas PixelRGBA8
ink Int
x Int
y = Canvas -> PixelRGBA8 -> Int -> Int -> Word8 -> IO ()
blendInk Canvas
canvas PixelRGBA8
ink Int
x Int
y Word8
255

{- | Composite @ink@ with the given coverage as alpha, keeping the strongest
coverage where marks overlap (all ink is one color, so max-alpha is correct).
-}
blendInk :: Canvas -> PixelRGBA8 -> Int -> Int -> Word8 -> IO ()
blendInk :: Canvas -> PixelRGBA8 -> Int -> Int -> Word8 -> IO ()
blendInk Canvas
canvas (PixelRGBA8 Word8
r Word8
g Word8
b Word8
_) Int
x Int
y Word8
cov
    | Word8
cov Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Canvas -> Int
forall s a. MutableImage s a -> Int
mutableImageWidth Canvas
canvas Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Canvas -> Int
forall s a. MutableImage s a -> Int
mutableImageHeight Canvas
canvas = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise = do
        PixelRGBA8 _ _ _ a <- MutableImage (PrimState IO) PixelRGBA8
-> Int -> Int -> IO PixelRGBA8
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
MutableImage (PrimState m) a -> Int -> Int -> m a
forall (m :: * -> *).
PrimMonad m =>
MutableImage (PrimState m) PixelRGBA8 -> Int -> Int -> m PixelRGBA8
readPixel Canvas
MutableImage (PrimState IO) PixelRGBA8
canvas Int
x Int
y
        writePixel canvas x y (PixelRGBA8 r g b (max a cov))