{-# LANGUAGE TemplateHaskell #-}
module Graphics.Rendering.Chart.Drawing
(
PointShape(..)
, PointStyle(..)
, drawPoint
, alignPath
, alignFillPath
, alignStrokePath
, alignFillPoints
, alignStrokePoints
, alignFillPoint
, alignStrokePoint
, strokePointPath
, fillPointPath
, withRotation
, withTranslation
, withScale
, withScaleX, withScaleY
, withPointStyle
, withDefaultStyle
, drawTextA
, drawTextR
, drawTextsR
, textDrawRect
, textDimension
, defaultColorSeq
, solidLine
, dashedLine
, filledCircles
, hollowCircles
, filledPolygon
, hollowPolygon
, plusses
, exes
, stars
, arrows
, solidFillStyle
, module Graphics.Rendering.Chart.Backend
, point_color
, point_border_color
, point_border_width
, point_radius
, point_shape
) where
import Data.Default.Class
import Control.Lens
import Data.Colour
import Data.Colour.Names
import Data.List (unfoldr)
import Data.Monoid
import Graphics.Rendering.Chart.Backend
import Graphics.Rendering.Chart.Geometry hiding (moveTo)
import qualified Graphics.Rendering.Chart.Geometry as G
withRotation :: Double -> BackendProgram a -> BackendProgram a
withRotation :: Double -> BackendProgram a -> BackendProgram a
withRotation angle :: Double
angle = Matrix -> BackendProgram a -> BackendProgram a
forall a. Matrix -> BackendProgram a -> BackendProgram a
withTransform (Double -> Matrix -> Matrix
rotate Double
angle 1)
withTranslation :: Point -> BackendProgram a -> BackendProgram a
withTranslation :: Point -> BackendProgram a -> BackendProgram a
withTranslation p :: Point
p = Matrix -> BackendProgram a -> BackendProgram a
forall a. Matrix -> BackendProgram a -> BackendProgram a
withTransform (Vector -> Matrix -> Matrix
translate (Point -> Vector
pointToVec Point
p) 1)
withScale :: Vector -> BackendProgram a -> BackendProgram a
withScale :: Vector -> BackendProgram a -> BackendProgram a
withScale v :: Vector
v = Matrix -> BackendProgram a -> BackendProgram a
forall a. Matrix -> BackendProgram a -> BackendProgram a
withTransform (Vector -> Matrix -> Matrix
scale Vector
v 1)
withScaleX :: Double -> BackendProgram a -> BackendProgram a
withScaleX :: Double -> BackendProgram a -> BackendProgram a
withScaleX x :: Double
x = Vector -> BackendProgram a -> BackendProgram a
forall a. Vector -> BackendProgram a -> BackendProgram a
withScale (Double -> Double -> Vector
Vector Double
x 1)
withScaleY :: Double -> BackendProgram a -> BackendProgram a
withScaleY :: Double -> BackendProgram a -> BackendProgram a
withScaleY y :: Double
y = Vector -> BackendProgram a -> BackendProgram a
forall a. Vector -> BackendProgram a -> BackendProgram a
withScale (Double -> Double -> Vector
Vector 1 Double
y)
withPointStyle :: PointStyle -> BackendProgram a -> BackendProgram a
withPointStyle :: PointStyle -> BackendProgram a -> BackendProgram a
withPointStyle (PointStyle cl :: AlphaColour Double
cl bcl :: AlphaColour Double
bcl bw :: Double
bw _ _) m :: BackendProgram a
m =
LineStyle -> BackendProgram a -> BackendProgram a
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (LineStyle
forall a. Default a => a
def { _line_color :: AlphaColour Double
_line_color = AlphaColour Double
bcl, _line_width :: Double
_line_width = Double
bw, _line_join :: LineJoin
_line_join = LineJoin
LineJoinMiter }) (BackendProgram a -> BackendProgram a)
-> BackendProgram a -> BackendProgram a
forall a b. (a -> b) -> a -> b
$
FillStyle -> BackendProgram a -> BackendProgram a
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle AlphaColour Double
cl) BackendProgram a
m
withDefaultStyle :: BackendProgram a -> BackendProgram a
withDefaultStyle :: BackendProgram a -> BackendProgram a
withDefaultStyle = LineStyle -> BackendProgram a -> BackendProgram a
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
forall a. Default a => a
def (BackendProgram a -> BackendProgram a)
-> (BackendProgram a -> BackendProgram a)
-> BackendProgram a
-> BackendProgram a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillStyle -> BackendProgram a -> BackendProgram a
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
forall a. Default a => a
def (BackendProgram a -> BackendProgram a)
-> (BackendProgram a -> BackendProgram a)
-> BackendProgram a
-> BackendProgram a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStyle -> BackendProgram a -> BackendProgram a
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle FontStyle
forall a. Default a => a
def
alignPath :: (Point -> Point) -> Path -> Path
alignPath :: (Point -> Point) -> Path -> Path
alignPath f :: Point -> Point
f = (Point -> Path)
-> (Point -> Path)
-> (Point -> Double -> Double -> Double -> Path)
-> (Point -> Double -> Double -> Double -> Path)
-> Path
-> Path
-> Path
forall m.
Monoid m =>
(Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
foldPath (Point -> Path
G.moveTo (Point -> Path) -> (Point -> Point) -> Point -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
f)
(Point -> Path
lineTo (Point -> Path) -> (Point -> Point) -> Point -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
f)
(Point -> Double -> Double -> Double -> Path
arc (Point -> Double -> Double -> Double -> Path)
-> (Point -> Point) -> Point -> Double -> Double -> Double -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
f)
(Point -> Double -> Double -> Double -> Path
arcNeg (Point -> Double -> Double -> Double -> Path)
-> (Point -> Point) -> Point -> Double -> Double -> Double -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
f)
Path
close
alignStrokePath :: Path -> BackendProgram Path
alignStrokePath :: Path -> BackendProgram Path
alignStrokePath p :: Path
p = do
Point -> Point
f <- BackendProgram (Point -> Point)
getPointAlignFn
Path -> BackendProgram Path
forall (m :: * -> *) a. Monad m => a -> m a
return (Path -> BackendProgram Path) -> Path -> BackendProgram Path
forall a b. (a -> b) -> a -> b
$ (Point -> Point) -> Path -> Path
alignPath Point -> Point
f Path
p
alignFillPath :: Path -> BackendProgram Path
alignFillPath :: Path -> BackendProgram Path
alignFillPath p :: Path
p = do
Point -> Point
f <- BackendProgram (Point -> Point)
getCoordAlignFn
Path -> BackendProgram Path
forall (m :: * -> *) a. Monad m => a -> m a
return (Path -> BackendProgram Path) -> Path -> BackendProgram Path
forall a b. (a -> b) -> a -> b
$ (Point -> Point) -> Path -> Path
alignPath Point -> Point
f Path
p
alignStrokePoints :: [Point] -> BackendProgram [Point]
alignStrokePoints :: [Point] -> BackendProgram [Point]
alignStrokePoints p :: [Point]
p = do
Point -> Point
f <- BackendProgram (Point -> Point)
getPointAlignFn
[Point] -> BackendProgram [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> BackendProgram [Point])
-> [Point] -> BackendProgram [Point]
forall a b. (a -> b) -> a -> b
$ (Point -> Point) -> [Point] -> [Point]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> Point
f [Point]
p
alignFillPoints :: [Point] -> BackendProgram [Point]
alignFillPoints :: [Point] -> BackendProgram [Point]
alignFillPoints p :: [Point]
p = do
Point -> Point
f <- BackendProgram (Point -> Point)
getCoordAlignFn
[Point] -> BackendProgram [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> BackendProgram [Point])
-> [Point] -> BackendProgram [Point]
forall a b. (a -> b) -> a -> b
$ (Point -> Point) -> [Point] -> [Point]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> Point
f [Point]
p
alignStrokePoint :: Point -> BackendProgram Point
alignStrokePoint :: Point -> BackendProgram Point
alignStrokePoint p :: Point
p = do
Point -> Point
alignfn <- BackendProgram (Point -> Point)
getPointAlignFn
Point -> BackendProgram Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Point
alignfn Point
p)
alignFillPoint :: Point -> BackendProgram Point
alignFillPoint :: Point -> BackendProgram Point
alignFillPoint p :: Point
p = do
Point -> Point
alignfn <- BackendProgram (Point -> Point)
getCoordAlignFn
Point -> BackendProgram Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Point
alignfn Point
p)
stepPath :: [Point] -> Path
stepPath :: [Point] -> Path
stepPath (p :: Point
p:ps :: [Point]
ps) = Point -> Path
G.moveTo Point
p
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> [Path] -> Path
forall a. Monoid a => [a] -> a
mconcat ((Point -> Path) -> [Point] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map Point -> Path
lineTo [Point]
ps)
stepPath [] = Path
forall a. Monoid a => a
mempty
strokePointPath :: [Point] -> BackendProgram ()
strokePointPath :: [Point] -> BackendProgram ()
strokePointPath pts :: [Point]
pts = Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ [Point] -> Path
stepPath [Point]
pts
fillPointPath :: [Point] -> BackendProgram ()
fillPointPath :: [Point] -> BackendProgram ()
fillPointPath pts :: [Point]
pts = Path -> BackendProgram ()
fillPath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ [Point] -> Path
stepPath [Point]
pts
drawTextA :: HTextAnchor -> VTextAnchor -> Point -> String -> BackendProgram ()
drawTextA :: HTextAnchor -> VTextAnchor -> Point -> String -> BackendProgram ()
drawTextA hta :: HTextAnchor
hta vta :: VTextAnchor
vta = HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR HTextAnchor
hta VTextAnchor
vta 0
drawTextR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR :: HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR hta :: HTextAnchor
hta vta :: VTextAnchor
vta angle :: Double
angle p :: Point
p s :: String
s =
Point -> BackendProgram () -> BackendProgram ()
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation Point
p (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
Double -> BackendProgram () -> BackendProgram ()
forall a. Double -> BackendProgram a -> BackendProgram a
withRotation Double
theta (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
TextSize
ts <- String -> BackendProgram TextSize
textSize String
s
Point -> String -> BackendProgram ()
drawText (HTextAnchor -> VTextAnchor -> TextSize -> Point
adjustText HTextAnchor
hta VTextAnchor
vta TextSize
ts) String
s
where
theta :: Double
theta = Double
angleDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/180.0
drawTextsR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextsR :: HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextsR hta :: HTextAnchor
hta vta :: VTextAnchor
vta angle :: Double
angle p :: Point
p s :: String
s = case Int
num of
0 -> () -> BackendProgram ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
1 -> HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR HTextAnchor
hta VTextAnchor
vta Double
angle Point
p String
s
_ ->
Point -> BackendProgram () -> BackendProgram ()
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation Point
p (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
Double -> BackendProgram () -> BackendProgram ()
forall a. Double -> BackendProgram a -> BackendProgram a
withRotation Double
theta (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
[TextSize]
tss <- (String -> BackendProgram TextSize)
-> [String] -> ProgramT ChartBackendInstr Identity [TextSize]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> BackendProgram TextSize
textSize [String]
ss
let ts :: TextSize
ts = [TextSize] -> TextSize
forall a. [a] -> a
head [TextSize]
tss
let
maxh :: Double
maxh = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((TextSize -> Double) -> [TextSize] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map TextSize -> Double
textSizeYBearing [TextSize]
tss)
gap :: Double
gap = Double
maxh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2
totalHeight :: Double
totalHeight = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
maxh Double -> Double -> Double
forall a. Num a => a -> a -> a
+
(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numDouble -> Double -> Double
forall a. Num a => a -> a -> a
-1)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
gap
ys :: [Double]
ys = Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
num ((Double -> Maybe (Double, Double)) -> Double -> [Double]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\y :: Double
y-> (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double
y, Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
gapDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
maxh))
(VTextAnchor -> TextSize -> Double -> Double
yinit VTextAnchor
vta TextSize
ts Double
totalHeight))
xs :: [Double]
xs = (TextSize -> Double) -> [TextSize] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (HTextAnchor -> TextSize -> Double
adjustTextX HTextAnchor
hta) [TextSize]
tss
[BackendProgram ()] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ((Double -> Double -> String -> BackendProgram ())
-> [Double] -> [Double] -> [String] -> [BackendProgram ()]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Double -> Double -> String -> BackendProgram ()
drawT [Double]
xs [Double]
ys [String]
ss)
where
ss :: [String]
ss = String -> [String]
lines String
s
num :: Int
num = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ss
drawT :: Double -> Double -> String -> BackendProgram ()
drawT x :: Double
x y :: Double
y = Point -> String -> BackendProgram ()
drawText (Double -> Double -> Point
Point Double
x Double
y)
theta :: Double
theta = Double
angleDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/180.0
yinit :: VTextAnchor -> TextSize -> Double -> Double
yinit VTA_Top ts :: TextSize
ts _ = TextSize -> Double
textSizeAscent TextSize
ts
yinit VTA_BaseLine _ _ = 0
yinit VTA_Centre ts :: TextSize
ts height :: Double
height = Double
height Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextSize -> Double
textSizeAscent TextSize
ts
yinit VTA_Bottom ts :: TextSize
ts height :: Double
height = Double
height Double -> Double -> Double
forall a. Num a => a -> a -> a
+ TextSize -> Double
textSizeAscent TextSize
ts
adjustText :: HTextAnchor -> VTextAnchor -> TextSize -> Point
adjustText :: HTextAnchor -> VTextAnchor -> TextSize -> Point
adjustText hta :: HTextAnchor
hta vta :: VTextAnchor
vta ts :: TextSize
ts = Double -> Double -> Point
Point (HTextAnchor -> TextSize -> Double
adjustTextX HTextAnchor
hta TextSize
ts) (VTextAnchor -> TextSize -> Double
adjustTextY VTextAnchor
vta TextSize
ts)
adjustTextX :: HTextAnchor -> TextSize -> Double
adjustTextX :: HTextAnchor -> TextSize -> Double
adjustTextX HTA_Left _ = 0
adjustTextX HTA_Centre ts :: TextSize
ts = - (TextSize -> Double
textSizeWidth TextSize
ts Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2)
adjustTextX HTA_Right ts :: TextSize
ts = - TextSize -> Double
textSizeWidth TextSize
ts
adjustTextY :: VTextAnchor -> TextSize -> Double
adjustTextY :: VTextAnchor -> TextSize -> Double
adjustTextY VTA_Top ts :: TextSize
ts = TextSize -> Double
textSizeAscent TextSize
ts
adjustTextY VTA_Centre ts :: TextSize
ts = - TextSize -> Double
textSizeYBearing TextSize
ts Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2
adjustTextY VTA_BaseLine _ = 0
adjustTextY VTA_Bottom ts :: TextSize
ts = - TextSize -> Double
textSizeDescent TextSize
ts
textDrawRect :: HTextAnchor -> VTextAnchor -> Point -> String -> BackendProgram Rect
textDrawRect :: HTextAnchor
-> VTextAnchor -> Point -> String -> BackendProgram Rect
textDrawRect hta :: HTextAnchor
hta vta :: VTextAnchor
vta (Point x :: Double
x y :: Double
y) s :: String
s = do
TextSize
ts <- String -> BackendProgram TextSize
textSize String
s
let (w :: Double
w,h :: Double
h,dh :: Double
dh) = (TextSize -> Double
textSizeWidth TextSize
ts, TextSize -> Double
textSizeHeight TextSize
ts, TextSize -> Double
textSizeDescent TextSize
ts)
lx :: Double
lx = HTextAnchor -> TextSize -> Double
adjustTextX HTextAnchor
hta TextSize
ts
ly :: Double
ly = VTextAnchor -> TextSize -> Double
adjustTextY VTextAnchor
vta TextSize
ts
(x' :: Double
x',y' :: Double
y') = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lx, Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ly Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dh)
p1 :: Point
p1 = Double -> Double -> Point
Point Double
x' (Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
h)
p2 :: Point
p2 = Double -> Double -> Point
Point (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) Double
y'
Rect -> BackendProgram Rect
forall (m :: * -> *) a. Monad m => a -> m a
return (Rect -> BackendProgram Rect) -> Rect -> BackendProgram Rect
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Rect
Rect Point
p1 Point
p2
textDimension :: String -> BackendProgram RectSize
textDimension :: String -> BackendProgram (Double, Double)
textDimension s :: String
s = do
TextSize
ts <- String -> BackendProgram TextSize
textSize String
s
(Double, Double) -> BackendProgram (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextSize -> Double
textSizeWidth TextSize
ts, TextSize -> Double
textSizeHeight TextSize
ts)
data PointShape = PointShapeCircle
| PointShapePolygon Int Bool
| PointShapePlus
| PointShapeCross
| PointShapeStar
| PointShapeArrowHead Double
| PointShapeEllipse Double Double
data PointStyle = PointStyle
{ PointStyle -> AlphaColour Double
_point_color :: AlphaColour Double
, PointStyle -> AlphaColour Double
_point_border_color :: AlphaColour Double
, PointStyle -> Double
_point_border_width :: Double
, PointStyle -> Double
_point_radius :: Double
, PointStyle -> PointShape
_point_shape :: PointShape
}
instance Default PointStyle where
def :: PointStyle
def = PointStyle :: AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle
{ _point_color :: AlphaColour Double
_point_color = Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black
, _point_border_color :: AlphaColour Double
_point_border_color = AlphaColour Double
forall a. Num a => AlphaColour a
transparent
, _point_border_width :: Double
_point_border_width = 0
, _point_radius :: Double
_point_radius = 1
, _point_shape :: PointShape
_point_shape = PointShape
PointShapeCircle
}
drawPoint :: PointStyle
-> Point
-> BackendProgram ()
drawPoint :: PointStyle -> Point -> BackendProgram ()
drawPoint ps :: PointStyle
ps@(PointStyle cl :: AlphaColour Double
cl _ _ r :: Double
r shape :: PointShape
shape) p :: Point
p = PointStyle -> BackendProgram () -> BackendProgram ()
forall a. PointStyle -> BackendProgram a -> BackendProgram a
withPointStyle PointStyle
ps (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
p' :: Point
p'@(Point x :: Double
x y :: Double
y) <- Point -> BackendProgram Point
alignStrokePoint Point
p
case PointShape
shape of
PointShapeCircle -> do
let path :: Path
path = Point -> Double -> Double -> Double -> Path
arc Point
p' Double
r 0 (2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)
Path -> BackendProgram ()
fillPath Path
path
Path -> BackendProgram ()
strokePath Path
path
PointShapePolygon sides :: Int
sides isrot :: Bool
isrot -> do
let intToAngle :: a -> p
intToAngle n :: a
n =
if Bool
isrot
then a -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n p -> p -> p
forall a. Num a => a -> a -> a
* 2p -> p -> p
forall a. Num a => a -> a -> a
*p
forall a. Floating a => a
pip -> p -> p
forall a. Fractional a => a -> a -> a
/Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides
else (0.5 p -> p -> p
forall a. Num a => a -> a -> a
+ a -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)p -> p -> p
forall a. Num a => a -> a -> a
*2p -> p -> p
forall a. Num a => a -> a -> a
*p
forall a. Floating a => a
pip -> p -> p
forall a. Fractional a => a -> a -> a
/Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sides
angles :: [Double]
angles = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
forall p a. (Integral a, Floating p) => a -> p
intToAngle [0 .. Int
sidesInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]
(p1 :: Point
p1:p1' :: Point
p1':p1s :: [Point]
p1s) = (Double -> Point) -> [Double] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (\a :: Double
a -> Double -> Double -> Point
Point (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
a)
(Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
a)) [Double]
angles
let path :: Path
path = Point -> Path
G.moveTo Point
p1 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> [Path] -> Path
forall a. Monoid a => [a] -> a
mconcat ((Point -> Path) -> [Point] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map Point -> Path
lineTo ([Point] -> [Path]) -> [Point] -> [Path]
forall a b. (a -> b) -> a -> b
$ Point
p1'Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
p1s) Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p1 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p1'
Path -> BackendProgram ()
fillPath Path
path
Path -> BackendProgram ()
strokePath Path
path
PointShapeArrowHead theta :: Double
theta ->
Point -> BackendProgram () -> BackendProgram ()
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation Point
p (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> BackendProgram () -> BackendProgram ()
forall a. Double -> BackendProgram a -> BackendProgram a
withRotation (Double
theta Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
PointStyle -> Point -> BackendProgram ()
drawPoint (Double -> Int -> Bool -> AlphaColour Double -> PointStyle
filledPolygon Double
r 3 Bool
True AlphaColour Double
cl) (Double -> Double -> Point
Point 0 0)
PointShapePlus ->
Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
r) Double
y
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r) Double
y
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
r)
PointShapeCross -> do
let rad :: Double
rad = Double
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt 2
Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad)
PointShapeStar -> do
let rad :: Double
rad = Double
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt 2
Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
r) Double
y
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r) Double
y
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
r)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
r)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rad) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
rad)
PointShapeEllipse b :: Double
b theta :: Double
theta ->
Point -> BackendProgram () -> BackendProgram ()
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation Point
p (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> BackendProgram () -> BackendProgram ()
forall a. Double -> BackendProgram a -> BackendProgram a
withRotation Double
theta (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> BackendProgram () -> BackendProgram ()
forall a. Double -> BackendProgram a -> BackendProgram a
withScaleX Double
b (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
let path :: Path
path = Point -> Double -> Double -> Double -> Path
arc (Double -> Double -> Point
Point 0 0) Double
r 0 (2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)
Path -> BackendProgram ()
fillPath Path
path
Path -> BackendProgram ()
strokePath Path
path
defaultColorSeq :: [AlphaColour Double]
defaultColorSeq :: [AlphaColour Double]
defaultColorSeq = [AlphaColour Double] -> [AlphaColour Double]
forall a. [a] -> [a]
cycle ([AlphaColour Double] -> [AlphaColour Double])
-> [AlphaColour Double] -> [AlphaColour Double]
forall a b. (a -> b) -> a -> b
$ (Colour Double -> AlphaColour Double)
-> [Colour Double] -> [AlphaColour Double]
forall a b. (a -> b) -> [a] -> [b]
map Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque [Colour Double
forall a. (Ord a, Floating a) => Colour a
blue, Colour Double
forall a. (Ord a, Floating a) => Colour a
red, Colour Double
forall a. (Ord a, Floating a) => Colour a
green, Colour Double
forall a. (Ord a, Floating a) => Colour a
yellow, Colour Double
forall a. (Ord a, Floating a) => Colour a
cyan, Colour Double
forall a. (Ord a, Floating a) => Colour a
magenta]
solidLine :: Double
-> AlphaColour Double
-> LineStyle
solidLine :: Double -> AlphaColour Double -> LineStyle
solidLine w :: Double
w cl :: AlphaColour Double
cl = Double
-> AlphaColour Double
-> [Double]
-> LineCap
-> LineJoin
-> LineStyle
LineStyle Double
w AlphaColour Double
cl [] LineCap
LineCapButt LineJoin
LineJoinMiter
dashedLine :: Double
-> [Double]
-> AlphaColour Double
-> LineStyle
dashedLine :: Double -> [Double] -> AlphaColour Double -> LineStyle
dashedLine w :: Double
w ds :: [Double]
ds cl :: AlphaColour Double
cl = Double
-> AlphaColour Double
-> [Double]
-> LineCap
-> LineJoin
-> LineStyle
LineStyle Double
w AlphaColour Double
cl [Double]
ds LineCap
LineCapButt LineJoin
LineJoinMiter
filledCircles :: Double
-> AlphaColour Double
-> PointStyle
filledCircles :: Double -> AlphaColour Double -> PointStyle
filledCircles radius :: Double
radius cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
cl AlphaColour Double
forall a. Num a => AlphaColour a
transparent 0 Double
radius PointShape
PointShapeCircle
hollowCircles :: Double
-> Double
-> AlphaColour Double
-> PointStyle
hollowCircles :: Double -> Double -> AlphaColour Double -> PointStyle
hollowCircles radius :: Double
radius w :: Double
w cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent AlphaColour Double
cl Double
w Double
radius PointShape
PointShapeCircle
hollowPolygon :: Double
-> Double
-> Int
-> Bool
-> AlphaColour Double
-> PointStyle
hollowPolygon :: Double -> Double -> Int -> Bool -> AlphaColour Double -> PointStyle
hollowPolygon radius :: Double
radius w :: Double
w sides :: Int
sides isrot :: Bool
isrot cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent AlphaColour Double
cl Double
w Double
radius (Int -> Bool -> PointShape
PointShapePolygon Int
sides Bool
isrot)
filledPolygon :: Double
-> Int
-> Bool
-> AlphaColour Double
-> PointStyle
filledPolygon :: Double -> Int -> Bool -> AlphaColour Double -> PointStyle
filledPolygon radius :: Double
radius sides :: Int
sides isrot :: Bool
isrot cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
cl AlphaColour Double
forall a. Num a => AlphaColour a
transparent 0 Double
radius (Int -> Bool -> PointShape
PointShapePolygon Int
sides Bool
isrot)
plusses :: Double
-> Double
-> AlphaColour Double
-> PointStyle
plusses :: Double -> Double -> AlphaColour Double -> PointStyle
plusses radius :: Double
radius w :: Double
w cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent AlphaColour Double
cl Double
w Double
radius PointShape
PointShapePlus
exes :: Double
-> Double
-> AlphaColour Double
-> PointStyle
exes :: Double -> Double -> AlphaColour Double -> PointStyle
exes radius :: Double
radius w :: Double
w cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent AlphaColour Double
cl Double
w Double
radius PointShape
PointShapeCross
stars :: Double
-> Double
-> AlphaColour Double
-> PointStyle
stars :: Double -> Double -> AlphaColour Double -> PointStyle
stars radius :: Double
radius w :: Double
w cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent AlphaColour Double
cl Double
w Double
radius PointShape
PointShapeStar
arrows :: Double
-> Double
-> Double
-> AlphaColour Double
-> PointStyle
arrows :: Double -> Double -> Double -> AlphaColour Double -> PointStyle
arrows radius :: Double
radius angle :: Double
angle w :: Double
w cl :: AlphaColour Double
cl =
AlphaColour Double
-> AlphaColour Double
-> Double
-> Double
-> PointShape
-> PointStyle
PointStyle AlphaColour Double
forall a. Num a => AlphaColour a
transparent AlphaColour Double
cl Double
w Double
radius (Double -> PointShape
PointShapeArrowHead Double
angle)
solidFillStyle :: AlphaColour Double -> FillStyle
solidFillStyle :: AlphaColour Double -> FillStyle
solidFillStyle = AlphaColour Double -> FillStyle
FillStyleSolid
$( makeLenses ''PointStyle )