diff options
| author | jao <jao@gnu.org> | 2022-09-14 05:07:24 +0100 | 
|---|---|---|
| committer | jao <jao@gnu.org> | 2022-09-14 05:07:24 +0100 | 
| commit | ce453fdcc78679d1073e0ab22b603e43fe88347f (patch) | |
| tree | 193a1a91bb96ab626fde93780d0267c541fe5519 | |
| parent | dd69f889c6326e46b3ffb14b545134e1d6e2ee8f (diff) | |
| download | xmobar-ce453fdcc78679d1073e0ab22b603e43fe88347f.tar.gz xmobar-ce453fdcc78679d1073e0ab22b603e43fe88347f.tar.bz2 | |
whitespace
| -rw-r--r-- | src/Xmobar/Run/Parsers.hs | 30 | ||||
| -rw-r--r-- | src/Xmobar/X11/XlibDraw.hs | 69 | 
2 files changed, 52 insertions, 47 deletions
| diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs index de983fd..982ef71 100644 --- a/src/Xmobar/Run/Parsers.hs +++ b/src/Xmobar/Run/Parsers.hs @@ -119,10 +119,7 @@ textParser c f a = do s <- many1 $  -- string of digits (base 10) denoting the length of the raw string,  -- a literal ":" as digit-string-terminator, the raw string itself, and  -- then a literal "/>". -rawParser :: TextRenderInfo -          -> FontIndex -          -> Maybe [Action] -          -> Parser [Segment] +rawParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]  rawParser c f a = do    string "<raw="    lenstr <- many1 digit @@ -174,21 +171,28 @@ toButtons = map (\x -> read [x])  -- | Parsers a string wrapped in a color specification.  colorParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment] -colorParser (TextRenderInfo _ _ _ bs) f a = do +colorParser (TextRenderInfo _ _ _ bs) fidx a = do    c <- between (string "<fc=") (string ">") colors    let colorParts = break (==':') c    let (ot,ob) = case break (==',') (Prelude.drop 1 $ snd colorParts) of -             (top,',':btm) -> (top, btm) -             (top,      _) -> (top, top) -  s <- manyTill -       (allParsers (TextRenderInfo (fst colorParts) (fromMaybe (-1) $ readMaybe ot) (fromMaybe (-1) $ readMaybe ob) bs) f a) -       (try $ string "</fc>") +                  (top,',':btm) -> (top, btm) +                  (top,      _) -> (top, top) +      tri = TextRenderInfo (fst colorParts) +                           (fromMaybe (-1) $ readMaybe ot) +                           (fromMaybe (-1) $ readMaybe ob) +                           bs +  s <- manyTill (allParsers tri fidx a) (try $ string "</fc>")    return (concat s)  -- | Parses a string wrapped in a box specification.  boxParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]  boxParser (TextRenderInfo cs ot ob bs) f a = do -  c <- between (string "<box") (string ">") (option "" (many1 (alphaNum <|> char '=' <|> char ' ' <|> char '#' <|> char ','))) +  c <- between (string "<box") (string ">") +               (option "" (many1 (alphaNum +                                  <|> char '=' +                                  <|> char ' ' +                                  <|> char '#' +                                  <|> char ',')))    let b = Box BBFull (BoxOffset C 0) 1 cs (BoxMargins 0 0 0 0)    let g = boxReader b (words c)    s <- manyTill @@ -209,7 +213,9 @@ boxParamReader b _ "" = b  boxParamReader (Box bb off lw fc mgs) "type" val =    Box (fromMaybe bb $ readMaybe ("BB" ++ val)) off lw fc mgs  boxParamReader (Box bb (BoxOffset alg off) lw fc mgs) "offset" (a:o) = -  Box bb (BoxOffset (fromMaybe alg $ readMaybe [a]) (fromMaybe off $ readMaybe o)) lw fc mgs +  Box bb (BoxOffset align offset) lw fc mgs +  where offset = fromMaybe off $ readMaybe o +        align = fromMaybe alg $ readMaybe [a]  boxParamReader (Box bb off lw fc mgs) "width" val =    Box bb off (fromMaybe lw $ readMaybe val) fc mgs  boxParamReader (Box bb off lw _ mgs) "color" val = diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs index f6637c5..2f3f1a2 100644 --- a/src/Xmobar/X11/XlibDraw.hs +++ b/src/Xmobar/X11/XlibDraw.hs @@ -107,13 +107,12 @@ printStrings dr gc fontlist offs a boxes sl@((s,c,i,l):xs) = do        totSLen = foldr (\(_,_,_,len) -> (+) len) 0 sl        remWidth = fi wid - fi totSLen        fontst = safeIndex fontlist i -      voff = indexedOffset conf i        offset = case a of                   C -> (remWidth + offs) `div` 2                   R -> remWidth                   L -> offs        (fc,bc) = colorComponents conf (tColorsString c) -  valign <- verticalOffset ht s fontst voff conf +  valign <- verticalOffset ht s fontst (indexedOffset conf i) conf    let (ht',ay) = case (tBgTopOffset c, tBgBottomOffset c) of                     (-1,_)  -> (0, -1)                     (_,-1)  -> (0, -1) @@ -134,39 +133,6 @@ printStrings dr gc fontlist offs a boxes sl@((s,c,i,l):xs) = do      else liftIO $ drawBoxes d dr gc (fromIntegral ht) dropBoxes    printStrings dr gc fontlist (offs + l) a boxes' xs -drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel -              -> Dimension -> Dimension -> IO () -drawBorder b lw d p gc c wi ht =  case b of -  NoBorder -> return () -  TopB       -> drawBorder (TopBM 0) lw d p gc c wi ht -  BottomB    -> drawBorder (BottomBM 0) lw d p gc c wi ht -  FullB      -> drawBorder (FullBM 0) lw d p gc c wi ht -  TopBM m    -> sf >> sla >> -                 drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff) -  BottomBM m -> let rw = fi ht - fi m + boff in -                 sf >> sla >> drawLine d p gc 0 rw (fi wi) rw -  FullBM m   -> let mp = fi m -                    pad = 2 * fi mp +  fi lw -                in sf >> sla >> -                     drawRectangle d p gc mp mp (wi - pad) (ht - pad) -  where sf    = setForeground d gc c -        sla   = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter -        boff  = borderOffset b lw - -borderOffset :: (Integral a) => Border -> Int -> a -borderOffset b lw = -  case b of -    BottomB    -> negate boffs -    BottomBM _ -> negate boffs -    TopB       -> boffs -    TopBM _    -> boffs -    _          -> 0 -  where boffs = calcBorderOffset lw - -calcBorderOffset :: (Integral a) => Int -> a -calcBorderOffset = ceiling . (/2) . toDouble -  where toDouble = fi :: (Integral a) => a -> Double -  drawBoxes :: Display -> Drawable -> GC            -> Position -> [((Position, Position), Box)]            -> IO () @@ -214,6 +180,39 @@ drawBoxBorder      _ -> error "unreachable code" +drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel +              -> Dimension -> Dimension -> IO () +drawBorder b lw d p gc c wi ht =  case b of +  NoBorder -> return () +  TopB       -> drawBorder (TopBM 0) lw d p gc c wi ht +  BottomB    -> drawBorder (BottomBM 0) lw d p gc c wi ht +  FullB      -> drawBorder (FullBM 0) lw d p gc c wi ht +  TopBM m    -> sf >> sla >> +                 drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff) +  BottomBM m -> let rw = fi ht - fi m + boff in +                 sf >> sla >> drawLine d p gc 0 rw (fi wi) rw +  FullBM m   -> let mp = fi m +                    pad = 2 * fi mp +  fi lw +                in sf >> sla >> +                     drawRectangle d p gc mp mp (wi - pad) (ht - pad) +  where sf    = setForeground d gc c +        sla   = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter +        boff  = borderOffset b lw + +borderOffset :: (Integral a) => Border -> Int -> a +borderOffset b lw = +  case b of +    BottomB    -> negate boffs +    BottomBM _ -> negate boffs +    TopB       -> boffs +    TopBM _    -> boffs +    _          -> 0 +  where boffs = calcBorderOffset lw + +calcBorderOffset :: (Integral a) => Int -> a +calcBorderOffset = ceiling . (/2) . toDouble +  where toDouble = fi :: (Integral a) => a -> Double +  updateActions :: Rectangle -> [[Segment]] -> X [([Action], Position, Position)]  updateActions (Rectangle _ _ wid _) ~[left,center,right] = do    conf <- ask | 
