{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Graphics.Cairo.Drawing.Extents where

import Foreign.C.Types

data CairoExtents = CairoExtentsLeftTopRightBottom {
	CairoExtents -> CDouble
cairoExtentsLeftX :: CDouble,
	CairoExtents -> CDouble
cairoExtentsTopY :: CDouble,
	CairoExtents -> CDouble
cairoExtentsRightX :: CDouble,
	CairoExtents -> CDouble
cairoExtentsBottomY :: CDouble } deriving Int -> CairoExtents -> ShowS
[CairoExtents] -> ShowS
CairoExtents -> String
(Int -> CairoExtents -> ShowS)
-> (CairoExtents -> String)
-> ([CairoExtents] -> ShowS)
-> Show CairoExtents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CairoExtents -> ShowS
showsPrec :: Int -> CairoExtents -> ShowS
$cshow :: CairoExtents -> String
show :: CairoExtents -> String
$cshowList :: [CairoExtents] -> ShowS
showList :: [CairoExtents] -> ShowS
Show

pattern CairoExtentsLeftTopWidthHeight :: CDouble -> CDouble -> CDouble -> CDouble -> CairoExtents
pattern $mCairoExtentsLeftTopWidthHeight :: forall {r}.
CairoExtents
-> (CDouble -> CDouble -> CDouble -> CDouble -> r)
-> ((# #) -> r)
-> r
$bCairoExtentsLeftTopWidthHeight :: CDouble -> CDouble -> CDouble -> CDouble -> CairoExtents
CairoExtentsLeftTopWidthHeight {
	CairoExtents -> CDouble
cairoExtentsLeft, CairoExtents -> CDouble
cairoExtentsTop,
	CairoExtents -> CDouble
cairoExtentsWidth, CairoExtents -> CDouble
cairoExtentsHeight } <-
	(cairoExtentsLeftTopWidthHeight -> (cairoExtentsLeft, cairoExtentsTop, cairoExtentsWidth, cairoExtentsHeight)) where 
	CairoExtentsLeftTopWidthHeight CDouble
l CDouble
t CDouble
w CDouble
h = CDouble -> CDouble -> CDouble -> CDouble -> CairoExtents
CairoExtentsLeftTopRightBottom CDouble
l CDouble
t (CDouble
l CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
+ CDouble
w) (CDouble
t CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
+ CDouble
h)

cairoExtentsLeftTopWidthHeight :: CairoExtents -> (CDouble, CDouble, CDouble, CDouble)
cairoExtentsLeftTopWidthHeight :: CairoExtents -> (CDouble, CDouble, CDouble, CDouble)
cairoExtentsLeftTopWidthHeight (CairoExtentsLeftTopRightBottom CDouble
l CDouble
t CDouble
r CDouble
b) = (CDouble
l, CDouble
t, CDouble
r CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
- CDouble
l, CDouble
b CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
- CDouble
t)