phi/lib/Phi/Border.hs

{-# 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
                               } deriving Show

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]
                     } deriving Show

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