diff options
| -rw-r--r-- | blessings.cabal | 2 | ||||
| -rw-r--r-- | src/Blessings.hs | 26 |
2 files changed, 23 insertions, 5 deletions
diff --git a/blessings.cabal b/blessings.cabal index 2e9b763..1dc6122 100644 --- a/blessings.cabal +++ b/blessings.cabal @@ -3,7 +3,7 @@ build-type: Simple cabal-version: >= 1.2 license: MIT name: blessings -version: 1.0.0 +version: 1.1.0 library build-depends: base diff --git a/src/Blessings.hs b/src/Blessings.hs index 753b560..7565299 100644 --- a/src/Blessings.hs +++ b/src/Blessings.hs @@ -84,6 +84,22 @@ instance IsPm BColor where . filterPm sgrFColor +data Blink = Blink | NoBlink + deriving (Eq, Show) + +instance IsPm Blink where + toPm Blink = [5] + toPm NoBlink = [25] + fromPm = rec . filterPm sgrColor + where + rec xs = case filter (`elem` ([5,25] :: [Int])) xs of + [] -> Nothing + xs' -> case last xs' of + 5 -> Just Blink + 25 -> Just NoBlink + _ -> error "filter broken in fromPm :: Pm -> Maybe Blink" + + data Bold = Bold | NoBold deriving (Eq, Show) @@ -167,30 +183,32 @@ sgrBColor (48:2:_) = Just 5 sgrBColor _ = Nothing -type RenderState = [(FColor, BColor, Bold, Underline)] +type RenderState = [(FColor, BColor, Blink, Bold, Underline)] emptyRenderState :: RenderState -emptyRenderState = [(ECMA48FColor 39, ECMA48BColor 49, NoBold, NoUnderline)] +emptyRenderState = [(ECMA48FColor 39, ECMA48BColor 49, NoBlink, NoBold, NoUnderline)] renderString :: RenderState -> Blessings String -> String -> String renderString _ (Plain s) y = s ++ y -- TODO merge successive sequences: \ESC[32m\ESC[1m -> \ESC[31;1m -renderString rs@((fc, bc, b, u):_) (SGR c t) y = +renderString rs@((fc, bc, bl, b, u):_) (SGR c t) y = renderSGR bra ++ renderString rs' t (renderSGR ket ++ y) where fc' = maybe fc id $ fromPm c bc' = maybe bc id $ fromPm c + bl' = maybe bl id $ fromPm c b' = maybe b id $ fromPm c u' = maybe u id $ fromPm c - rs' = (fc', bc', b', u') : rs + rs' = (fc', bc', bl', b', u') : rs bra = braket >>= fst ket = braket >>= snd braket = (if fc' /= fc then (toPm fc', toPm fc) else ([],[])) : (if bc' /= bc then (toPm bc', toPm bc) else ([],[])) : + (if bl' /= bl then (toPm bl', toPm bl) else ([],[])) : (if b' /= b then (toPm b', toPm b) else ([],[])) : (if u' /= u then (toPm u', toPm u) else ([],[])) : [] |