module Rainbox.Box
(
Background(..)
, defaultBackground
, backgroundFromChunk
, backgroundToTextSpec
, same
, Height(..)
, B.height
, Width(..)
, B.HasWidth(..)
, Align
, Vert
, Horiz
, B.center
, B.top
, B.bottom
, B.left
, B.right
, B.Bar(..)
, B.barToBox
, B.barsToBox
, B.Box
, B.unBox
, B.blank
, blankH
, blankV
, B.chunks
, chunk
, B.catH
, B.catV
, sepH
, sepV
, punctuateH
, punctuateV
, view
, B.viewH
, B.viewV
, grow
, growH
, growV
, column
, resize
, resizeH
, resizeV
, render
, printBox
) where
import Data.Monoid
import Data.List (intersperse)
import qualified Data.Text as X
import System.Console.Rainbow
import System.Console.Rainbow.Types
import System.Console.Rainbow.Colors
import qualified Rainbox.Box.Primitives as B
import Rainbox.Box.Primitives
( Box
, Align
, Horiz
, Vert
, Height(..)
, Width(..)
, Background
, unBox
)
import qualified System.IO as IO
backgroundFromChunk :: Chunk -> B.Background
backgroundFromChunk (Chunk ts _) = B.Background bk8 bk256
where
bk8 = case getLast . background8 . style8 $ ts of
Nothing -> c8_default
Just c -> c
bk256 = case getLast . background256 . style256 $ ts of
Nothing -> c256_default
Just c -> c
backgroundToTextSpec :: B.Background -> TextSpec
backgroundToTextSpec (B.Background bk8 bk256) = TextSpec
{ style8 = mempty { background8 = Last . Just $ bk8 }
, style256 = mempty { background256 = Last . Just $ bk256 } }
defaultBackground :: B.Background
defaultBackground = B.Background c8_default c256_default
same :: Color8 -> B.Background
same c = B.Background c (to256 c)
blankH :: Background -> Int -> Box
blankH bk i = B.blank bk (Height 0) (Width i)
blankV :: Background -> Int -> Box
blankV bk i = B.blank bk (Height i) (Width 0)
chunk :: Chunk -> Box
chunk = B.chunks . (:[])
grow
:: Background
-> Height
-> Width
-> Align Vert
-> Align Horiz
-> Box
-> Box
grow bk (B.Height h) (B.Width w) av ah
= growH bk w ah
. growV bk h av
growH
:: Background
-> Int
-> Align Horiz
-> Box
-> Box
growH bk tgtW a b
| tgtW < w = b
| otherwise = B.catH bk B.top [lft, b, rt]
where
w = B.width b
diff = tgtW w
(lft, rt) = (blankH bk wl, blankH bk wr)
(wl, wr)
| a == B.center = B.split diff
| a == B.left = (0, diff)
| otherwise = (diff, 0)
growV
:: Background
-> Int
-> Align Vert
-> Box
-> Box
growV bk tgtH a b
| tgtH < h = b
| otherwise = B.catV bk B.left [tp, b, bt]
where
h = B.height b
diff = tgtH h
(tp, bt) = (blankV bk ht, blankV bk hb)
(ht, hb)
| a == B.center = B.split diff
| a == B.top = (0, diff)
| otherwise = (diff, 0)
column
:: Background
-> Align Horiz
-> [Box]
-> [Box]
column bk ah bs = map (growH bk w ah) bs
where
w = maximum . (0:) . map B.width $ bs
view
:: Height
-> Width
-> Align Vert
-> Align Horiz
-> Box
-> Box
view h w av ah
= B.viewH (B.unWidth w) ah
. B.viewV (B.unHeight h) av
resize
:: Background
-> Height
-> Width
-> Align Vert
-> Align Horiz
-> Box
-> Box
resize bk h w av ah
= resizeH bk (unWidth w) ah
. resizeV bk (unHeight h) av
resizeH
:: Background
-> Int
-> Align Horiz
-> Box
-> Box
resizeH bk w a b
| bw < w = growH bk w a b
| bw > w = B.viewH w a b
| otherwise = b
where
bw = B.width b
resizeV
:: Background
-> Int
-> Align Vert
-> Box
-> Box
resizeV bk h a b
| bh < h = growV bk h a b
| bh > h = B.viewV h a b
| otherwise = b
where
bh = B.height b
sepH :: Background -> Int -> Align Vert -> [Box] -> Box
sepH bk sep a = punctuateH bk a bl
where
bl = blankH bk sep
sepV :: Background -> Int -> Align Horiz -> [Box] -> Box
sepV bk sep a = punctuateV bk a bl
where
bl = blankV bk sep
punctuateH :: Background -> Align Vert -> Box -> [Box] -> Box
punctuateH bk a sep = B.catH bk a . intersperse sep
punctuateV :: Background -> Align Horiz -> Box -> [Box] -> Box
punctuateV bk a sep = B.catV bk a . intersperse sep
render :: Box -> [Chunk]
render bx = case unBox bx of
B.NoHeight _ -> []
B.WithHeight rw ->
concat . concat . map (: [["\n"]])
. map renderRod $ rw
renderRod :: B.Rod -> [Chunk]
renderRod = map toChunk . B.unRod
where
toChunk = either spcToChunk id . B.unNibble
spcToChunk ss =
Chunk (backgroundToTextSpec (B.spcBackground ss))
[X.replicate (B.numSpaces ss) (X.singleton ' ')]
printBox :: Box -> IO ()
printBox b = do
t <- smartTermFromEnv IO.stdout
hPutChunks IO.stdout t . render $ b