summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2016-11-22 18:45:44 +0100
committertv <tv@krebsco.de>2016-11-22 18:57:31 +0100
commitc80785663fa97484792440b3af3d54ae639d3c22 (patch)
treecdc189cd74da05492cc95b4365c277a721e9b1d3
parent25a510dcb38ea9158e9969d56eb66cb1b860ab5f (diff)
add Blinkv1.1.0
-rw-r--r--blessings.cabal2
-rw-r--r--src/Blessings.hs26
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 ([],[])) : []