77 lines
2.4 KiB
Haskell
77 lines
2.4 KiB
Haskell
|
module Phi.Border ( BorderWidth(..)
|
||
|
|
, simpleBorderWidth
|
||
|
|
, border
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Phi.Panel
|
||
|
|
|
||
|
|
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 :: !Panel
|
||
|
|
}
|
||
|
|
|
||
|
|
instance PanelClass Border where
|
||
|
|
minSize border = minSize 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 -> Panel -> Panel
|
||
|
|
border m bw p border bc cr w c = Panel $ Border m bw p border bc cr w c
|