-- | Diagrams user API
module Graphics.Diagrams 
    ( Point
    , (*.), (.*.), (.+.), (.-.)
    , Color
    , color, rgb
    , red, green, blue, black, white, gray, yellow
    , Diagram
    , rect, rectangle, circle, polygon, (>-<), (~~), polyline
    , textFrom, textTo, textAt, fontFamily, link
    , move, rotate, scale, scaleXY, clip
    , fill, stroke, strokeWidth
    , union, (<|>), empty
    , pack
    ) where

import Graphics.Diagrams.Types

---------------------

infixl 7 .*., *.
infixl 6 .+., .-.
infix  4 >-<, ~~
infixl 3 `move`, `rotate`, `scale`, `scaleXY`, `fill`, `stroke`, `strokeWidth`, `textFrom`, `textTo`, `textAt`, `fontFamily`, `link`
infixl 2 <|>

--------------------

empty :: Diagram
empty = EmptyDiagram

(>-<), (~~), line :: Point -> Point -> Diagram
(>-<) = line
(~~) = line
line a b = polyline [a,b] 

rect :: Double -> Double -> Diagram
rect = Rect

rectangle :: Point -> Point -> Diagram
rectangle (a1,a2) (b1,b2) = rect (b1-a1) (b2-a2) `move` (a1+(b1-a1)/2, a2+(b2-a2)/2)

--dot :: Diagram
--dot = circle 0.5 `strokeWidth` 0 `fill` black

circle :: Double -> Diagram
circle = Circle

polygon, polyline :: [Point] -> Diagram
polygon = Polyline True
polyline = Polyline False

text :: Position -> String -> Diagram
text x  = TransformMatrix 0.1 0 0 (-0.1) 0 0 . Text x

textAt, textFrom, textTo :: String -> Point -> Diagram
textAt t x = text Middle t `move` x
textFrom t x = text Start t `move` x
textTo t x = text End t `move` x

fontFamily :: Diagram -> String -> Diagram
fontFamily = flip FontFamily

link :: Diagram -> String -> Diagram
link = flip Link

pack :: Diagram -> (Diagram -> Diagram) -> Diagram
pack = Pack

clip :: Point -> Point -> Diagram -> Diagram
clip = Clip

(<|>) :: Diagram -> Diagram -> Diagram
(<|>) = Overlay


move :: Diagram -> Point -> Diagram
x `move` p = Move p x

rotate :: Diagram -> Double -> Diagram
x `rotate` d = Rotate d x

scale :: Diagram -> Double -> Diagram
x `scale` t = Scale t x

scaleXY :: Diagram -> (Double, Double) -> Diagram
d `scaleXY` (x, y) = ScaleXY x y d

fill :: Diagram -> Color -> Diagram
x `fill` c = Fill c x

stroke :: Diagram -> Color -> Diagram
x `stroke` c = Stroke c x 

strokeWidth :: Diagram -> Double -> Diagram
x `strokeWidth` c = StrokeWidth c x

union :: [Diagram] -> Diagram
union = foldr Overlay EmptyDiagram


-------------------------

color :: String -> Color
color = Color

rgb :: Double -> Double -> Double -> Color
rgb = RGB

red, green, blue, black, white, gray, yellow :: Color
red    = color "red"
green  = color "green"
blue   = color "blue"
black  = color "black"
white  = color "white"
gray   = color "gray"
yellow = color "yellow"


-- type Point = (Double, Double)

-- | Point type as defined in the diagrams package
-- Scalar multiplication.
(*.) :: Double -> Point -> Point
s *. (x,y) = (s*x, s*y)

-- | Elementwise addition, subtraction and multiplication for 'Point's.
(.+.), (.-.), (.*.) :: Point -> Point -> Point
(x1,y1) .+. (x2,y2) = (x1 + x2, y1 + y2)
(x1,y1) .*. (x2,y2) = (x1 * x2, y1 * y2)
a .-. b = a .+. ((-1) *. b)