From 176a012a0e3539f4101d6e469280b147b0444041 Mon Sep 17 00:00:00 2001 From: Evan Laforge Date: Sat, 25 Jan 2025 02:00:53 -0800 Subject: [PATCH] add Mridangam._printStrokes, move combining-char sensitive utils to Texts --- Solkattu/Format/Terminal.hs | 15 ++++---- Solkattu/Instrument/Mridangam.hs | 13 +++++++ Solkattu/Realize.hs | 39 +------------------- TODO | 17 +++++++++ Util/Texts.hs | 62 +++++++++++++++++++++++++++----- 5 files changed, 92 insertions(+), 54 deletions(-) diff --git a/Solkattu/Format/Terminal.hs b/Solkattu/Format/Terminal.hs index 981128106..c6e45e0d9 100644 --- a/Solkattu/Format/Terminal.hs +++ b/Solkattu/Format/Terminal.hs @@ -327,7 +327,7 @@ spellRests strokeWidth set (col, (prev, sym, next)) | not (isRest sym) = sym | even col && maybe False isRest next = sym - { _text = Realize.justifyLeft (symWidth sym) ' ' double } + { _text = Texts.justifyLeft (symWidth sym) ' ' double } | odd col && maybe False isRest prev = sym { _text = Text.replicate (symWidth sym) " " } | otherwise = sym @@ -345,10 +345,10 @@ overlapSymbols strokeWidth = snd . mapAccumLSnd combine ("", Nothing) combine (overlap, overlapSym) sym | _isSustain sym = if Text.null overlap then (("", Nothing), sym) - else let (pre, post) = Realize.textSplitAt strokeWidth overlap + else let (pre, post) = Texts.splitAt strokeWidth overlap in ((post, overlapSym), replace pre overlapSym sym) | otherwise = - let (pre, post) = Realize.textSplitAt strokeWidth (_text sym) + let (pre, post) = Texts.splitAt strokeWidth (_text sym) in ((post, Just sym), sym { _text = pre }) replace prefix mbOverlapSym sym = case mbOverlapSym of Nothing -> sym { _text = newText } @@ -360,7 +360,7 @@ overlapSymbols strokeWidth = snd . mapAccumLSnd combine ("", Nothing) } where newText = prefix - <> snd (Realize.textSplitAt (Realize.textLength prefix) (_text sym)) + <> snd (Texts.splitAt (Texts.length prefix) (_text sym)) makeSymbols :: Solkattu.Notation stroke => Int -> Talas.Tala -> Set Tala.Akshara -> Format.NormalizedFlat stroke -> [(S.State, Symbol)] @@ -371,8 +371,7 @@ makeSymbols strokeWidth tala angas = go S.Attack a -> ( False , style - , Realize.justifyLeft strokeWidth (Solkattu.extension a) - notation + , Texts.justifyLeft strokeWidth (Solkattu.extension a) notation ) where (style, notation) = Solkattu.notation a S.Sustain a -> @@ -381,7 +380,7 @@ makeSymbols strokeWidth tala angas = go , Text.replicate strokeWidth (Text.singleton (Solkattu.extension a)) ) - S.Rest -> (True, mempty, Realize.justifyLeft strokeWidth ' ' "_") + S.Rest -> (True, mempty, Texts.justifyLeft strokeWidth ' ' "_") go (S.FGroup _ group children) = modify (concatMap go children) where modify = case Solkattu._type group of @@ -483,7 +482,7 @@ emphasisStyle = Styled.fg red . Styled.bold -- I'm used to this dark red since it's what iterm used for bold. symWidth :: Symbol -> Int -symWidth = Realize.textLength . _text +symWidth = Texts.length . _text -- * util diff --git a/Solkattu/Instrument/Mridangam.hs b/Solkattu/Instrument/Mridangam.hs index b72e45466..c4a15bf8c 100644 --- a/Solkattu/Instrument/Mridangam.hs +++ b/Solkattu/Instrument/Mridangam.hs @@ -10,10 +10,12 @@ module Solkattu.Instrument.Mridangam where import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO import GHC.Stack (HasCallStack) import qualified Util.Lists as Lists +import qualified Util.Texts as Texts import qualified Derive.Expr as Expr import qualified Derive.Symbols as Symbols import qualified Solkattu.Realize as Realize @@ -144,6 +146,17 @@ instance Solkattu.Notation Valantalai where instance Pretty Thoppi where pretty = Solkattu.notationText instance Pretty Valantalai where pretty = Solkattu.notationText +_printStrokes :: IO () +_printStrokes = mapM_ Text.IO.putStrLn $ Texts.columns 2 $ + [ "" : map (t . Valantalai) rhs ] ++ + [ (map t $ Thoppi lh : [Both lh rh | rh <- rhs]) + | lh <- lhs + ] + where + t = Solkattu.notationText + rhs = [Ki ..] + lhs = [Tha Palm, Tha Fingertips, Thom Low, Thom Up, Gum] + -- | Pretty reproduces the "Derive.Solkattu.Dsl" syntax, which has to be -- haskell syntax, so it can't use +, and I have to put thoppi first to avoid -- the keyword @do@. It would be nice if I could make the tracklang syntax diff --git a/Solkattu/Realize.hs b/Solkattu/Realize.hs index c988b4fc7..a1016a661 100644 --- a/Solkattu/Realize.hs +++ b/Solkattu/Realize.hs @@ -46,11 +46,6 @@ module Solkattu.Realize ( -- ** ToStroke , ToStrokes , realizeStroke, realizeSollu - -- * text util - , justifyLeft - , textLength - , textSplitAt - -- * DEBUG , SolluMap(..) , solluMap @@ -624,7 +619,7 @@ formatError = format . UF.toList format (pre, Just err) = Left $ Texts.unlines2 (errorNotation (S.flattenedNotes pre)) err errorNotation = Text.unwords - . map (justifyLeft 2 ' ' . Solkattu.notationText) + . map (Texts.justifyLeft 2 ' ' . Solkattu.notationText) {- | Given a group like @@ -810,35 +805,3 @@ bestMatch tag sollus toStrokes = find tag = mapMaybe (\s -> ((tag, s),) <$> _getStrokes toStrokes tag s) prefixes = reverse $ drop 1 $ List.inits $ take (_longestKey toStrokes) sollus - - --- * text util - -justifyLeft :: Int -> Char -> Text -> Text -justifyLeft n c text - | len >= n = text - | otherwise = text <> Text.replicate (n - len) (Text.singleton c) - where len = textLength text - --- | Text.length that doesn't count combining characters. --- --- TODO there is surely a canonical way to count graphemes, say using text-icu, --- but it seems like a heavy dependency. -textLength :: Text -> Int -textLength = Num.sum . map len . untxt - where - -- Combining characters don't contribute to the width. I'm sure it's way - -- more complicated than this, but for the moment this seems to work. - len c - | Char.isMark c = 0 - | otherwise = 1 - --- | Text.splitAt that isn't confused by combining characters. -textSplitAt :: Int -> Text -> (Text, Text) -textSplitAt at text = - find $ map (flip Text.splitAt text) [0 .. textLength text] - where - find (cur : next@((pre, _) : _)) - | textLength pre > at = cur - | otherwise = find next - find _ = (text, "") diff --git a/TODO b/TODO index d7862800e..5125d045b 100644 --- a/TODO +++ b/TODO @@ -6329,6 +6329,23 @@ solkattu: . Another way is to support them all, but map them the same way to strokes. Good because the original notation is preserved. Currently I do this, maybe it's good enough. + mridangam gumiki notation: + . Firstly, Gum is confusing because it's a "dry" stroke. But I think + it is useful for timed gum, just the name is confusing. Maybe it + should be Up, but that's Thoppi Up. + . Previously, gum is /, and Thom Up is acute accent. + Gum as / can't be combined with other things. + Acute accent can't be combined well with symbols like , ^. + . Making Up into a trailing / solves those, at the cost of 2 chars. + But it seems ok and I think not bad to read. Better than acute. + . But gum as bare ´ is pretty annoying to type. Bare / makes a kind of + sense because it's just up, no o. + . I could make / -> gum, and have to type ó for o/ in strings, that makes + some sense, but it's a confusing mismatch between fromString and output + notation. Of course I have those for many things, but + . Maybe it comes down to how common is Up vs Gum. + If ´ is really so annoying, then I could use `, or even ', is that + otherwise used? notation conveniences: / mark karvai groups automatically? I don't have to highlight it. . If I'm not going to highlight, why bother? diff --git a/Util/Texts.hs b/Util/Texts.hs index ee95d2433..dcae0bdfb 100644 --- a/Util/Texts.hs +++ b/Util/Texts.hs @@ -3,8 +3,27 @@ -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} -module Util.Texts where -import Prelude hiding (lines) +module Util.Texts ( + Textlike(..) + , replaceMany + , unwords2, unlines2, join2, join + , split1 + , ellipsis, ellipsisList + , dropPrefix, dropSuffix + , enumeration + , columns, columnsSome + , justifyLeft + , length + , splitAt + , mapDelimited, mapDelimitedM, extractDelimited + -- * interpolate + , interpolate + -- * haddockUrl + , Files, Url + , haddockUrl +) where +import Prelude hiding (length, lines, splitAt) +import qualified Prelude import Control.Arrow (first) import Control.Monad (liftM) import qualified Control.Monad.Identity as Identity @@ -29,6 +48,7 @@ import qualified System.FilePath as FilePath import System.FilePath (()) import qualified Util.Lists as Lists +import qualified Util.Num as Num import qualified Util.Regex as Regex @@ -97,9 +117,6 @@ join2 sep a b = join sep $ filter (not . Text.null . toText) [a, b] join :: Textlike a => a -> [a] -> a join sep = fromText . Text.intercalate (toText sep) . map toText -unlines :: Textlike a => [a] -> a -unlines = fromText . Text.unlines . map toText - split1 :: Text -> Text -> (Text, Text) split1 sep text = (pre, Text.drop (Text.length sep) post) where (pre, post) = Text.breakOn sep text @@ -113,7 +130,7 @@ ellipsisList :: Int -> [Text] -> [Text] ellipsisList max xs | null post = xs | otherwise = pre ++ ["..."] - where (pre, post) = splitAt max xs + where (pre, post) = Prelude.splitAt max xs dropPrefix :: Text -> Text -> Text dropPrefix prefix text = Maybe.fromMaybe text (Text.stripPrefix prefix text) @@ -133,10 +150,39 @@ columnsSome :: Int -> [Either Text [Text]] -> [Text] columnsSome padding rows = map formatRow rows where formatRow = either id (Text.stripEnd . mconcat . zipWith pad widths) - pad w = Text.justifyLeft (w + padding) ' ' + pad w = justifyLeft (w + padding) ' ' byCol = map (map (Maybe.fromMaybe Text.empty)) (Lists.rotate2 (Either.rights rows)) - widths = map (List.maximum . (0:) . map Text.length) byCol + widths = map (List.maximum . (0:) . map length) byCol + +justifyLeft :: Int -> Char -> Text -> Text +justifyLeft count c text + | len >= count = text + | otherwise = text <> Text.replicate (count - len) (Text.singleton c) + where len = length text + +-- | Text.length that doesn't count combining characters. +-- +-- TODO there is surely a canonical way to count graphemes, say using text-icu, +-- but it seems like a heavy dependency. +length :: Text -> Int +length = Num.sum . map len . Text.unpack + where + -- Combining characters don't contribute to the width. I'm sure it's way + -- more complicated than this, but for the moment this seems to work. + len c + | Char.isMark c = 0 + | otherwise = 1 + +-- | Text.splitAt that isn't confused by combining characters. +splitAt :: Int -> Text -> (Text, Text) +splitAt at text = + find $ map (flip Text.splitAt text) [0 .. length text] + where + find (cur : next@((pre, _) : _)) + | length pre > at = cur + | otherwise = find next + find _ = (text, "") -- | Apply a function to the contents delimited by the given Char. You can -- quote a delimiter with a backslash.