{-# LANGUAGE TypeFamilies #-} module Phi.Border ( BorderWidth(..) , simpleBorderWidth , border ) where import Phi.Types import Phi.Widget import Graphics.Rendering.Cairo data BorderWidth = BorderWidth { borderTop :: !Int , borderRight :: !Int , borderBottom :: !Int , borderLeft :: !Int } simpleBorderWidth :: Int -> BorderWidth simpleBorderWidth w = BorderWidth w w w w borderH :: BorderWidth -> Int borderH bw = borderLeft bw + borderRight bw borderV :: BorderWidth -> Int borderV bw = borderTop bw + borderBottom bw data Border = Border { margin :: !BorderWidth , borderWidth :: !Int , padding :: !BorderWidth , borderColor :: !Color , backgroundColor :: !Color , cornerRadius :: !Double , borderWeight :: !Float , content :: ![Widget] } instance WidgetClass Border where type WidgetData Border = () initialState _ = () minSize border = sum (map (\(Widget w) -> minSize w) c) + borderH p + 2*bw + borderH m where m = margin border bw = borderWidth border p = padding border c = content border weight border = borderWeight border render border _ w h = do newPath arc (x + width - radius) (y + radius) radius (-pi/2) 0 arc (x + width - radius) (y + height - radius) radius 0 (pi/2) arc (x + radius) (y + height - radius) radius (pi/2) pi arc (x + radius) (y + radius) radius pi (pi*3/2) closePath setSourceRGBA fr fg fb fa fillPreserve setSourceRGBA br bg bb ba setLineWidth $ fromIntegral bw stroke where m = margin border bw = borderWidth border p = padding border c = content border radius = cornerRadius border x = (fromIntegral $ borderLeft m) + (fromIntegral bw)/2 y = (fromIntegral $ borderTop m) + (fromIntegral bw)/2 width = fromIntegral $ w - borderH m - bw height = fromIntegral $ h - borderV m - bw (br, bg, bb, ba) = borderColor border (fr, fg, fb, fa) = backgroundColor border border :: BorderWidth -> Int -> BorderWidth -> Color -> Color -> Double -> Float -> [Widget] -> Widget border m bw p border bc cr w c = Widget $ Border m bw p border bc cr w c