module Dyna.Gloss.Data.Picture
        ( Picture       (..)
        , Point, Vec, Path

        -- * Aliases for Picture constructors
        , blank
        , polygon
        , line
        , circle, thickCircle
        , arc,    thickArc
        , text
        , bitmap
        , bitmapSection
        -- , bitmap
        , color
        , translate, rotate, scale
        , pictures

        -- * Compound shapes
        , lineLoop
        , circleSolid
        , arcSolid
        , sectorWire
        , rectanglePath
        , rectangleWire
        , rectangleSolid
        , rectangleUpperPath
        , rectangleUpperWire
        , rectangleUpperSolid
        )
where

import Data.VectorSpace
import Graphics.Gloss.Data.Bitmap
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture (Picture(..))
import Graphics.Gloss.Geometry.Angle
import Dyna.Gloss.Data.Point
import Dyna.Gloss.Data.Vec

-- Constructors ----------------------------------------------------------------
-- NOTE: The docs here should be identical to the ones on the constructors.

-- | A blank picture, with nothing in it.
blank :: Picture
blank :: Picture
blank   = Picture
Blank

-- | A convex polygon filled with a solid color.
polygon :: Path -> Picture
polygon :: Path -> Picture
polygon = Path -> Picture
Polygon (Path -> Picture) -> (Path -> Path) -> Path -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vec -> (Float, Float)) -> Path -> Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec -> (Float, Float)
toTuple

-- | A line along an arbitrary path.
line :: Path -> Picture
line :: Path -> Picture
line = Path -> Picture
Line (Path -> Picture) -> (Path -> Path) -> Path -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vec -> (Float, Float)) -> Path -> Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec -> (Float, Float)
toTuple

-- | A circle with the given radius.
circle  :: Float  -> Picture
circle :: Float -> Picture
circle  = Float -> Picture
Circle

-- | A circle with the given thickness and radius.
--   If the thickness is 0 then this is equivalent to `Circle`.
thickCircle  :: Float -> Float -> Picture
thickCircle :: Float -> Float -> Picture
thickCircle = Float -> Float -> Picture
ThickCircle

-- | A circular arc drawn counter-clockwise between two angles (in degrees)
--   at the given radius.
arc     :: Float -> Float -> Float -> Picture
arc :: Float -> Float -> Float -> Picture
arc = Float -> Float -> Float -> Picture
Arc

-- | A circular arc drawn counter-clockwise between two angles (in degrees),
--   with the given radius  and thickness.
--   If the thickness is 0 then this is equivalent to `Arc`.
thickArc :: Float -> Float -> Float -> Float -> Picture
thickArc :: Float -> Float -> Float -> Float -> Picture
thickArc = Float -> Float -> Float -> Float -> Picture
ThickArc

-- | Some text to draw with a vector font.
text :: String -> Picture
text :: String -> Picture
text = String -> Picture
Text

-- | A bitmap image
bitmap  :: BitmapData -> Picture
bitmap :: BitmapData -> Picture
bitmap BitmapData
bitmapData = BitmapData -> Picture
Bitmap BitmapData
bitmapData

-- | a subsection of a bitmap image
--   first argument selects a sub section in the bitmap
--   second argument determines the bitmap data
bitmapSection  :: Rectangle -> BitmapData -> Picture
bitmapSection :: Rectangle -> BitmapData -> Picture
bitmapSection = Rectangle -> BitmapData -> Picture
BitmapSection

-- | A picture drawn with this color.
color :: Color -> Picture -> Picture
color :: Color -> Picture -> Picture
color = Color -> Picture -> Picture
Color

-- | A picture translated by the given x and y coordinates.
translate :: Vec -> Picture -> Picture
translate :: Vec -> Picture -> Picture
translate (Vec Float
x Float
y) = Float -> Float -> Picture -> Picture
Translate Float
x Float
y

-- | A picture rotated clockwise by the given angle (in tau's).
-- 1 Tau is full circle.
rotate  :: Float -> Picture -> Picture
rotate :: Float -> Picture -> Picture
rotate Float
x = Float -> Picture -> Picture
Rotate (Float
360 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)

-- | A picture scaled by the given x and y factors.
scale   :: Vec -> Picture -> Picture
scale :: Vec -> Picture -> Picture
scale (Vec Float
x Float
y) = Float -> Float -> Picture -> Picture
Scale Float
x Float
y

-- | A picture consisting of several others.
pictures :: [Picture] -> Picture
pictures :: [Picture] -> Picture
pictures = [Picture] -> Picture
Pictures


-- Other Shapes ---------------------------------------------------------------
-- | A closed loop along a path.
lineLoop :: Path -> Picture
lineLoop :: Path -> Picture
lineLoop Path
xs     = Path -> Picture
line (Path -> Picture) -> Path -> Picture
forall a b. (a -> b) -> a -> b
$ case Path
xs of
   []     -> []
   (Vec
x:Path
xs) -> (Vec
xVec -> Path -> Path
forall a. a -> [a] -> [a]
:Path
xs) Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ [Vec
x]


-- Circles and Arcs -----------------------------------------------------------
-- | A solid circle with the given radius.
circleSolid :: Float -> Picture
circleSolid :: Float -> Picture
circleSolid Float
r
        = Float -> Float -> Picture
thickCircle (Float
rFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2) Float
r


-- | A solid arc, drawn counter-clockwise between two angles at the given radius.
arcSolid  :: Float -> Float -> Float -> Picture
arcSolid :: Float -> Float -> Float -> Picture
arcSolid Float
a1 Float
a2 Float
r
        = Float -> Float -> Float -> Float -> Picture
thickArc Float
a1 Float
a2 (Float
rFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2) Float
r


-- | A wireframe sector of a circle.
--   An arc is draw counter-clockwise from the first to the second angle at
--   the given radius. Lines are drawn from the origin to the ends of the arc.
---
--   NOTE: We take the absolute value of the radius incase it's negative.
--   It would also make sense to draw the sector flipped around the
--   origin, but I think taking the absolute value will be less surprising
--   for the user.
--
sectorWire :: Float -> Float -> Float -> Picture
sectorWire :: Float -> Float -> Float -> Picture
sectorWire Float
a1 Float
a2 Float
r_
 = let r :: Float
r        = Float -> Float
forall a. Num a => a -> a
abs Float
r_
   in  [Picture] -> Picture
Pictures
        [ Float -> Float -> Float -> Picture
Arc Float
a1 Float
a2 Float
r
        , Path -> Picture
line [Vec
0, Float
Scalar Vec
r Scalar Vec -> Vec -> Vec
forall v. VectorSpace v => Scalar v -> v -> v
*^ Float -> Vec
unitVecAtAngle (Float -> Float
degToRad Float
a1) ]
        , Path -> Picture
line [Vec
0, Float
Scalar Vec
r Scalar Vec -> Vec -> Vec
forall v. VectorSpace v => Scalar v -> v -> v
*^ Float -> Vec
unitVecAtAngle (Float -> Float
degToRad Float
a2) ]
        ]

-- Rectangles -----------------------------------------------------------------
-- NOTE: Only the first of these rectangle functions has haddocks on the
--       arguments to reduce the amount of noise in the extracted docs.

-- | A path representing a rectangle centered about the origin
rectanglePath
        :: Float        -- ^ width of rectangle
        -> Float        -- ^ height of rectangle
        -> Path
rectanglePath :: Float -> Float -> Path
rectanglePath Float
sizeX Float
sizeY
 = let  sx :: Float
sx      = Float
sizeX Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        sy :: Float
sy      = Float
sizeY Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
   in   [Float -> Float -> Vec
Vec (-Float
sx) (-Float
sy), Float -> Float -> Vec
Vec (-Float
sx) Float
sy, Float -> Float -> Vec
Vec Float
sx Float
sy, Float -> Float -> Vec
Vec Float
sx (-Float
sy)]

-- | A wireframe rectangle centered about the origin.
rectangleWire :: Float -> Float -> Picture
rectangleWire :: Float -> Float -> Picture
rectangleWire Float
sizeX Float
sizeY
        = Path -> Picture
lineLoop (Path -> Picture) -> Path -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Path
rectanglePath Float
sizeX Float
sizeY

-- | A wireframe rectangle in the y > 0 half of the x-y plane.
rectangleUpperWire :: Float -> Float -> Picture
rectangleUpperWire :: Float -> Float -> Picture
rectangleUpperWire Float
sizeX Float
sizeY
        = Path -> Picture
lineLoop (Path -> Picture) -> Path -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Path
rectangleUpperPath Float
sizeX Float
sizeY

-- | A path representing a rectangle in the y > 0 half of the x-y plane.
rectangleUpperPath :: Float -> Float -> Path
rectangleUpperPath :: Float -> Float -> Path
rectangleUpperPath Float
sizeX Float
sy
 = let  sx :: Float
sx      = Float
sizeX Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
   in   [Float -> Float -> Vec
Vec (-Float
sx) Float
0, Float -> Float -> Vec
Vec (-Float
sx) Float
sy, Float -> Float -> Vec
Vec Float
sx Float
sy, Float -> Float -> Vec
Vec Float
sx Float
0]

-- | A solid rectangle centered about the origin.
rectangleSolid :: Float -> Float -> Picture
rectangleSolid :: Float -> Float -> Picture
rectangleSolid Float
sizeX Float
sizeY
        = Path -> Picture
Polygon (Path -> Picture) -> Path -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Path
forall b a. (Fractional b, Fractional a) => a -> b -> [(a, b)]
rectanglePath' Float
sizeX Float
sizeY
  where
    rectanglePath' :: a -> b -> [(a, b)]
rectanglePath' a
sizeX b
sizeY =
        let  sx :: a
sx      = a
sizeX a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2
             sy :: b
sy      = b
sizeY b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
2
        in   [(-a
sx, -b
sy), (-a
sx, b
sy), (a
sx, b
sy), (a
sx, -b
sy)]

-- | A solid rectangle in the y > 0 half of the x-y plane.
rectangleUpperSolid :: Float -> Float -> Picture
rectangleUpperSolid :: Float -> Float -> Picture
rectangleUpperSolid Float
sizeX Float
sizeY = Path -> Picture
Polygon (Path -> Picture) -> Path -> Picture
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Path
forall a b. (Fractional a, Num b) => a -> b -> [(a, b)]
path Float
sizeX Float
sizeY
  where
    path :: a -> b -> [(a, b)]
path a
sizeX b
sy
      = let  sx :: a
sx      = a
sizeX a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2
        in   [(-a
sx, b
0), (-a
sx, b
sy), (a
sx, b
sy), (a
sx, b
0)]