{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
module Graphics.Rendering.Chart.Renderable(
Renderable(..),
ToRenderable(..),
PickFn,
Rectangle(..),
RectCornerStyle(..),
rectangleToRenderable,
drawRectangle,
fillBackground,
addMargins,
emptyRenderable,
embedRenderable,
label,
rlabel,
spacer,
spacer1,
setPickFn,
mapMaybePickFn,
mapPickFn,
nullPickFn,
rect_minsize,
rect_fillStyle,
rect_lineStyle,
rect_cornerStyle,
) where
import Control.Monad
import Control.Lens
import Data.Monoid
import Data.Default.Class
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Utils
type PickFn a = Point -> Maybe a
nullPickFn :: PickFn a
nullPickFn :: PickFn a
nullPickFn = Maybe a -> PickFn a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
data Renderable a = Renderable {
Renderable a -> BackendProgram RectSize
minsize :: BackendProgram RectSize,
Renderable a -> RectSize -> BackendProgram (PickFn a)
render :: RectSize -> BackendProgram (PickFn a)
}
deriving (a -> Renderable b -> Renderable a
(a -> b) -> Renderable a -> Renderable b
(forall a b. (a -> b) -> Renderable a -> Renderable b)
-> (forall a b. a -> Renderable b -> Renderable a)
-> Functor Renderable
forall a b. a -> Renderable b -> Renderable a
forall a b. (a -> b) -> Renderable a -> Renderable b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Renderable b -> Renderable a
$c<$ :: forall a b. a -> Renderable b -> Renderable a
fmap :: (a -> b) -> Renderable a -> Renderable b
$cfmap :: forall a b. (a -> b) -> Renderable a -> Renderable b
Functor)
class ToRenderable a where
toRenderable :: a -> Renderable ()
instance ToRenderable (Renderable a) where
toRenderable :: Renderable a -> Renderable ()
toRenderable = Renderable a -> Renderable ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
emptyRenderable :: Renderable a
emptyRenderable :: Renderable a
emptyRenderable = RectSize -> Renderable a
forall a. RectSize -> Renderable a
spacer (0,0)
spacer :: RectSize -> Renderable a
spacer :: RectSize -> Renderable a
spacer sz :: RectSize
sz = Renderable :: forall a.
BackendProgram RectSize
-> (RectSize -> BackendProgram (PickFn a)) -> Renderable a
Renderable {
minsize :: BackendProgram RectSize
minsize = RectSize -> BackendProgram RectSize
forall (m :: * -> *) a. Monad m => a -> m a
return RectSize
sz,
render :: RectSize -> BackendProgram (PickFn a)
render = \_ -> PickFn a -> BackendProgram (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn a
forall a. PickFn a
nullPickFn
}
spacer1 :: Renderable a -> Renderable b
spacer1 :: Renderable a -> Renderable b
spacer1 r :: Renderable a
r = Renderable a
r{ render :: RectSize -> BackendProgram (PickFn b)
render = \_ -> PickFn b -> BackendProgram (PickFn b)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn b
forall a. PickFn a
nullPickFn }
setPickFn :: PickFn b -> Renderable a -> Renderable b
setPickFn :: PickFn b -> Renderable a -> Renderable b
setPickFn pickfn :: PickFn b
pickfn r :: Renderable a
r = Renderable a
r{ render :: RectSize -> BackendProgram (PickFn b)
render = \sz :: RectSize
sz -> Renderable a -> RectSize -> BackendProgram (PickFn a)
forall a. Renderable a -> RectSize -> BackendProgram (PickFn a)
render Renderable a
r RectSize
sz BackendProgram (PickFn a)
-> BackendProgram (PickFn b) -> BackendProgram (PickFn b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PickFn b -> BackendProgram (PickFn b)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn b
pickfn }
mapMaybePickFn :: (a -> Maybe b) -> Renderable a -> Renderable b
mapMaybePickFn :: (a -> Maybe b) -> Renderable a -> Renderable b
mapMaybePickFn f :: a -> Maybe b
f r :: Renderable a
r = Renderable a
r{ render :: RectSize -> BackendProgram (PickFn b)
render = \sz :: RectSize
sz -> do PickFn a
pf <- Renderable a -> RectSize -> BackendProgram (PickFn a)
forall a. Renderable a -> RectSize -> BackendProgram (PickFn a)
render Renderable a
r RectSize
sz
PickFn b -> BackendProgram (PickFn b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe b) -> Maybe b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe b) -> Maybe b)
-> (Point -> Maybe (Maybe b)) -> PickFn b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f (Maybe a -> Maybe (Maybe b))
-> PickFn a -> Point -> Maybe (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PickFn a
pf) }
mapPickFn :: (a -> b) -> Renderable a -> Renderable b
mapPickFn :: (a -> b) -> Renderable a -> Renderable b
mapPickFn f :: a -> b
f = (a -> Maybe b) -> Renderable a -> Renderable b
forall a b. (a -> Maybe b) -> Renderable a -> Renderable b
mapMaybePickFn (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
addMargins :: (Double,Double,Double,Double)
-> Renderable a
-> Renderable a
addMargins :: (Double, Double, Double, Double) -> Renderable a -> Renderable a
addMargins (t :: Double
t,b :: Double
b,l :: Double
l,r :: Double
r) rd :: Renderable a
rd = Renderable :: forall a.
BackendProgram RectSize
-> (RectSize -> BackendProgram (PickFn a)) -> Renderable a
Renderable { minsize :: BackendProgram RectSize
minsize = BackendProgram RectSize
mf, render :: RectSize -> BackendProgram (PickFn a)
render = RectSize -> BackendProgram (PickFn a)
rf }
where
mf :: BackendProgram RectSize
mf = do
(w :: Double
w,h :: Double
h) <- Renderable a -> BackendProgram RectSize
forall a. Renderable a -> BackendProgram RectSize
minsize Renderable a
rd
RectSize -> BackendProgram RectSize
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
lDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
r,Double
hDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b)
rf :: RectSize -> BackendProgram (PickFn a)
rf (w :: Double
w,h :: Double
h) =
Point -> BackendProgram (PickFn a) -> BackendProgram (PickFn a)
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation (Double -> Double -> Point
Point Double
l Double
t) (BackendProgram (PickFn a) -> BackendProgram (PickFn a))
-> BackendProgram (PickFn a) -> BackendProgram (PickFn a)
forall a b. (a -> b) -> a -> b
$ do
PickFn a
pickf <- Renderable a -> RectSize -> BackendProgram (PickFn a)
forall a. Renderable a -> RectSize -> BackendProgram (PickFn a)
render Renderable a
rd (Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
lDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r,Double
hDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
b)
PickFn a -> BackendProgram (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PickFn a
-> (Double, Double, Double, Double) -> RectSize -> PickFn a
forall a.
(Point -> Maybe a)
-> (Double, Double, Double, Double) -> RectSize -> Point -> Maybe a
mkpickf PickFn a
pickf (Double
t,Double
b,Double
l,Double
r) (Double
w,Double
h))
mkpickf :: (Point -> Maybe a)
-> (Double, Double, Double, Double) -> RectSize -> Point -> Maybe a
mkpickf pickf :: Point -> Maybe a
pickf (t' :: Double
t',b' :: Double
b',l' :: Double
l',r' :: Double
r') (w :: Double
w,h :: Double
h) (Point x :: Double
x y :: Double
y)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
l' Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r' Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
t' Bool -> Bool -> Bool
&& Double
t' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
b' = Point -> Maybe a
pickf (Double -> Double -> Point
Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
l') (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t'))
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
fillBackground :: FillStyle -> Renderable a -> Renderable a
fillBackground :: FillStyle -> Renderable a -> Renderable a
fillBackground fs :: FillStyle
fs r :: Renderable a
r = Renderable a
r{ render :: RectSize -> BackendProgram (PickFn a)
render = RectSize -> BackendProgram (PickFn a)
rf }
where
rf :: RectSize -> BackendProgram (PickFn a)
rf rsize :: RectSize
rsize@(w :: Double
w,h :: Double
h) = do
FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fs (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
Path
p <- Path -> BackendProgram Path
alignFillPath (Path -> BackendProgram Path) -> Path -> BackendProgram Path
forall a b. (a -> b) -> a -> b
$ Rect -> Path
rectPath (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point 0 0) (Double -> Double -> Point
Point Double
w Double
h))
Path -> BackendProgram ()
fillPath Path
p
Renderable a -> RectSize -> BackendProgram (PickFn a)
forall a. Renderable a -> RectSize -> BackendProgram (PickFn a)
render Renderable a
r RectSize
rsize
embedRenderable :: BackendProgram (Renderable a) -> Renderable a
embedRenderable :: BackendProgram (Renderable a) -> Renderable a
embedRenderable ca :: BackendProgram (Renderable a)
ca = Renderable :: forall a.
BackendProgram RectSize
-> (RectSize -> BackendProgram (PickFn a)) -> Renderable a
Renderable {
minsize :: BackendProgram RectSize
minsize = do { Renderable a
a <- BackendProgram (Renderable a)
ca; Renderable a -> BackendProgram RectSize
forall a. Renderable a -> BackendProgram RectSize
minsize Renderable a
a },
render :: RectSize -> BackendProgram (PickFn a)
render = \ r :: RectSize
r -> do { Renderable a
a <- BackendProgram (Renderable a)
ca; Renderable a -> RectSize -> BackendProgram (PickFn a)
forall a. Renderable a -> RectSize -> BackendProgram (PickFn a)
render Renderable a
a RectSize
r }
}
label :: FontStyle -> HTextAnchor -> VTextAnchor -> String -> Renderable String
label :: FontStyle
-> HTextAnchor -> VTextAnchor -> String -> Renderable String
label fs :: FontStyle
fs hta :: HTextAnchor
hta vta :: VTextAnchor
vta = FontStyle
-> HTextAnchor
-> VTextAnchor
-> Double
-> String
-> Renderable String
rlabel FontStyle
fs HTextAnchor
hta VTextAnchor
vta 0
rlabel :: FontStyle -> HTextAnchor -> VTextAnchor -> Double -> String -> Renderable String
rlabel :: FontStyle
-> HTextAnchor
-> VTextAnchor
-> Double
-> String
-> Renderable String
rlabel fs :: FontStyle
fs hta :: HTextAnchor
hta vta :: VTextAnchor
vta rot :: Double
rot s :: String
s = Renderable :: forall a.
BackendProgram RectSize
-> (RectSize -> BackendProgram (PickFn a)) -> Renderable a
Renderable { minsize :: BackendProgram RectSize
minsize = BackendProgram RectSize
mf, render :: RectSize -> BackendProgram (PickFn String)
render = RectSize -> BackendProgram (PickFn String)
forall p. RectSize -> BackendProgram (p -> Maybe String)
rf }
where
mf :: BackendProgram RectSize
mf = FontStyle -> BackendProgram RectSize -> BackendProgram RectSize
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle FontStyle
fs (BackendProgram RectSize -> BackendProgram RectSize)
-> BackendProgram RectSize -> BackendProgram RectSize
forall a b. (a -> b) -> a -> b
$ do
TextSize
ts <- String -> BackendProgram TextSize
textSize String
s
let sz :: RectSize
sz = (TextSize -> Double
textSizeWidth TextSize
ts, TextSize -> Double
textSizeHeight TextSize
ts)
RectSize -> BackendProgram RectSize
forall (m :: * -> *) a. Monad m => a -> m a
return (RectSize -> Double
xwid RectSize
sz, RectSize -> Double
ywid RectSize
sz)
rf :: RectSize -> BackendProgram (p -> Maybe String)
rf (w0 :: Double
w0,h0 :: Double
h0) = FontStyle
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle FontStyle
fs (BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String))
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a b. (a -> b) -> a -> b
$ do
TextSize
ts <- String -> BackendProgram TextSize
textSize String
s
let sz :: RectSize
sz@(w :: Double
w,h :: Double
h) = (TextSize -> Double
textSizeWidth TextSize
ts, TextSize -> Double
textSizeHeight TextSize
ts)
descent :: Double
descent = TextSize -> Double
textSizeDescent TextSize
ts
xadj :: HTextAnchor -> Double
xadj HTA_Left = RectSize -> Double
xwid RectSize
szDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
xadj HTA_Centre = Double
w0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
xadj HTA_Right = Double
w0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- RectSize -> Double
xwid RectSize
szDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
yadj :: VTextAnchor -> Double
yadj VTA_Top = RectSize -> Double
ywid RectSize
szDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
yadj VTA_Centre = Double
h0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
yadj VTA_Bottom = Double
h0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- RectSize -> Double
ywid RectSize
szDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
yadj VTA_BaseLine = Double
h0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- RectSize -> Double
ywid RectSize
szDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
descentDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
acr
Point
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation (Double -> Double -> Point
Point 0 (-Double
descent)) (BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String))
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a b. (a -> b) -> a -> b
$
Point
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation (Double -> Double -> Point
Point (HTextAnchor -> Double
xadj HTextAnchor
hta) (VTextAnchor -> Double
yadj VTextAnchor
vta)) (BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String))
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a b. (a -> b) -> a -> b
$
Double
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a. Double -> BackendProgram a -> BackendProgram a
withRotation Double
rot' (BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String))
-> BackendProgram (p -> Maybe String)
-> BackendProgram (p -> Maybe String)
forall a b. (a -> b) -> a -> b
$ do
Point -> String -> BackendProgram ()
drawText (Double -> Double -> Point
Point (-Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) (Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2)) String
s
(p -> Maybe String) -> BackendProgram (p -> Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (\_-> String -> Maybe String
forall a. a -> Maybe a
Just String
s)
rot' :: Double
rot' = Double
rot Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 180 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi
(cr :: Double
cr,sr :: Double
sr) = (Double -> Double
forall a. Floating a => a -> a
cos Double
rot', Double -> Double
forall a. Floating a => a -> a
sin Double
rot')
(acr :: Double
acr,asr :: Double
asr) = (Double -> Double
forall a. Num a => a -> a
abs Double
cr, Double -> Double
forall a. Num a => a -> a
abs Double
sr)
xwid :: RectSize -> Double
xwid (w :: Double
w,h :: Double
h) = Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
acr Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
asr
ywid :: RectSize -> Double
ywid (w :: Double
w,h :: Double
h) = Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
asr Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
acr
data RectCornerStyle = RCornerSquare
| RCornerBevel Double
| RCornerRounded Double
data Rectangle = Rectangle {
Rectangle -> RectSize
_rect_minsize :: RectSize,
Rectangle -> Maybe FillStyle
_rect_fillStyle :: Maybe FillStyle,
Rectangle -> Maybe LineStyle
_rect_lineStyle :: Maybe LineStyle,
Rectangle -> RectCornerStyle
_rect_cornerStyle :: RectCornerStyle
}
instance Default Rectangle where
def :: Rectangle
def = Rectangle :: RectSize
-> Maybe FillStyle
-> Maybe LineStyle
-> RectCornerStyle
-> Rectangle
Rectangle
{ _rect_minsize :: RectSize
_rect_minsize = (0,0)
, _rect_fillStyle :: Maybe FillStyle
_rect_fillStyle = Maybe FillStyle
forall a. Maybe a
Nothing
, _rect_lineStyle :: Maybe LineStyle
_rect_lineStyle = Maybe LineStyle
forall a. Maybe a
Nothing
, _rect_cornerStyle :: RectCornerStyle
_rect_cornerStyle = RectCornerStyle
RCornerSquare
}
instance ToRenderable Rectangle where
toRenderable :: Rectangle -> Renderable ()
toRenderable = Rectangle -> Renderable ()
forall a. Rectangle -> Renderable a
rectangleToRenderable
rectangleToRenderable :: Rectangle -> Renderable a
rectangleToRenderable :: Rectangle -> Renderable a
rectangleToRenderable rectangle :: Rectangle
rectangle = BackendProgram RectSize
-> (RectSize -> BackendProgram (PickFn a)) -> Renderable a
forall a.
BackendProgram RectSize
-> (RectSize -> BackendProgram (PickFn a)) -> Renderable a
Renderable BackendProgram RectSize
mf RectSize -> BackendProgram (PickFn a)
forall a. RectSize -> BackendProgram (PickFn a)
rf
where
mf :: BackendProgram RectSize
mf = RectSize -> BackendProgram RectSize
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle -> RectSize
_rect_minsize Rectangle
rectangle)
rf :: RectSize -> BackendProgram (PickFn a)
rf = \rectSize :: RectSize
rectSize -> Point -> Rectangle -> BackendProgram (PickFn a)
forall a. Point -> Rectangle -> BackendProgram (PickFn a)
drawRectangle (Double -> Double -> Point
Point 0 0)
Rectangle
rectangle{ _rect_minsize :: RectSize
_rect_minsize = RectSize
rectSize }
drawRectangle :: Point -> Rectangle -> BackendProgram (PickFn a)
drawRectangle :: Point -> Rectangle -> BackendProgram (PickFn a)
drawRectangle point :: Point
point rectangle :: Rectangle
rectangle = do
()
-> (FillStyle -> BackendProgram ())
-> Maybe FillStyle
-> BackendProgram ()
forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM () (Point -> RectSize -> FillStyle -> BackendProgram ()
fill Point
point RectSize
size) (Rectangle -> Maybe FillStyle
_rect_fillStyle Rectangle
rectangle)
()
-> (LineStyle -> BackendProgram ())
-> Maybe LineStyle
-> BackendProgram ()
forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM () (Point -> RectSize -> LineStyle -> BackendProgram ()
stroke Point
point RectSize
size) (Rectangle -> Maybe LineStyle
_rect_lineStyle Rectangle
rectangle)
PickFn a -> BackendProgram (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn a
forall a. PickFn a
nullPickFn
where
size :: RectSize
size = Rectangle -> RectSize
_rect_minsize Rectangle
rectangle
fill :: Point -> RectSize -> FillStyle -> BackendProgram ()
fill p :: Point
p sz :: RectSize
sz fs :: FillStyle
fs =
FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fs (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
Path -> BackendProgram ()
fillPath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Point -> RectSize -> RectCornerStyle -> Path
strokeRectangleP Point
p RectSize
sz (Rectangle -> RectCornerStyle
_rect_cornerStyle Rectangle
rectangle)
stroke :: Point -> RectSize -> LineStyle -> BackendProgram ()
stroke p :: Point
p sz :: RectSize
sz ls :: LineStyle
ls =
LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
ls (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Point -> RectSize -> RectCornerStyle -> Path
strokeRectangleP Point
p RectSize
sz (Rectangle -> RectCornerStyle
_rect_cornerStyle Rectangle
rectangle)
strokeRectangleP :: Point -> RectSize -> RectCornerStyle -> Path
strokeRectangleP (Point x1 :: Double
x1 y1 :: Double
y1) (x2 :: Double
x2,y2 :: Double
y2) RCornerSquare =
let (x3 :: Double
x3,y3 :: Double
y3) = (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2) in Double -> Double -> Path
moveTo' Double
x1 Double
y1
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x1 Double
y3
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x3 Double
y3
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x3 Double
y1
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x1 Double
y1
strokeRectangleP (Point x1 :: Double
x1 y1 :: Double
y1) (x2 :: Double
x2,y2 :: Double
y2) (RCornerBevel s :: Double
s) =
let (x3 :: Double
x3,y3 :: Double
y3) = (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2) in Double -> Double -> Path
moveTo' Double
x1 (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x1 (Double
y3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s) Double
y3
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
x3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s) Double
y3
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x3 (Double
y3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x3 (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
x3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s) Double
y1
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s) Double
y1
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x1 (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s)
strokeRectangleP (Point x1 :: Double
x1 y1 :: Double
y1) (x2 :: Double
x2,y2 :: Double
y2) (RCornerRounded s :: Double
s) =
let (x3 :: Double
x3,y3 :: Double
y3) = (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2) in
Point -> Double -> Double -> Double -> Path
arcNeg (Double -> Double -> Point
Point (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s) (Double
y3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s)) Double
s (Double
pi2Double -> Double -> Double
forall a. Num a => a -> a -> a
*2) Double
pi2
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Double -> Double -> Double -> Path
arcNeg (Double -> Double -> Point
Point (Double
x3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s) (Double
y3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s)) Double
s Double
pi2 0
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Double -> Double -> Double -> Path
arcNeg (Double -> Double -> Point
Point (Double
x3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s)) Double
s 0 (Double
pi2Double -> Double -> Double
forall a. Num a => a -> a -> a
*3)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Double -> Double -> Double -> Path
arcNeg (Double -> Double -> Point
Point (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s)) Double
s (Double
pi2Double -> Double -> Double
forall a. Num a => a -> a -> a
*3) (Double
pi2Double -> Double -> Double
forall a. Num a => a -> a -> a
*2)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x1 (Double
y3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s)
pi2 :: Double
pi2 = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2
$( makeLenses ''Rectangle )