module Picture
    ( module Picture.Data
    , polygon
    , polygonCol
    , bezierQuad
    , arc
    , arcSolid
    , thickArc
    , thickCircle
    , thickLine
    , circleSolid
    , circleSolidCol
    , circle
    , line
    , lineCol
    , text
    , pictures
    , translate
    , rotate
    , scale
    , color
    , withAlpha
    , greyN
    , red       
    , green     
    , blue      
    , yellow    
    , cyan      
    , magenta   
    , rose      
    , violet    
    , azure     
    , aquamarine
    , chartreuse
    , orange    
    , white     
    , black
    , dim
    , light
    , dark
    , bright
    , mixColors
    , zeroZ
    , setDepth
    , setLayer
    )
  where
import Geometry
import Geometry.Data

import Picture.Data

import Data.Bifunctor
import qualified Data.DList as DL

import Graphics.Rendering.OpenGL (lineWidth, ($=))

import Control.Lens

black :: RGBA
black = (0,0,0,1)

polygon :: [Point2] -> Picture
{-# INLINE polygon #-}
polygon = Polygon 0

polygonCol :: [(Point2,RGBA)] -> Picture
{-# INLINE polygonCol #-}
polygonCol = PolygonCol 0

-- note that much of work computing the width of the bezier curve is done here
bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
bezierQuad cola colc ra rc a b c 
    | a == b && b == c = blank
    | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
    | otherwise = BezierQuad 0 
        [-- ( (0,0) , cola, (0,0), (0,0) )
         (aIn, cola, (fa aIn,fc aIn) , (1,0) )
        ,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
        ,(cIn, colc, (fa cIn,fc cIn) , (0,1) )
        ,( aX, cola, (1,0) , (fa' aX,fc' aX)  )
        ,( cX, colc, (0,1) , (fa' cX,fc' cX)  )
        ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
        ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
        ]
  where 
    colb = mixColors 0.5 0.5 cola colc
    b2a | isLHS a b c = a -.- b
        | otherwise   = b -.- a
    aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
    aX  = a -.- aRadVec
    aIn = a +.+ aRadVec
    b2c | isLHS a b c = b -.- c
        | otherwise   = c -.- b
    cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
    cX  = c -.- cRadVec
    cIn = c +.+ cRadVec
    bRadVec = 0.25 * (ra + rc) *.* normalizeV (a +.+ b -.- 2 *.* c)
    bX  = b +.+ bRadVec
    bIn = b -.- bRadVec
    fa = extrapolate aX cX bX 
    fc = extrapolate cX aX bX
    fa' = extrapolate aIn cIn bIn
    fc' = extrapolate cIn aIn bIn

-- given a one and two zeros of a linear function over x and y,
-- determine the function
-- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) = 
    (       x * ( ay - by )
        +   y * ( bx - ax )
        +   (ax * by - bx * ay)
    ) 
    / 
    (       ox * ( ay - by )
        +   ax * ( by - oy )
        +   bx * ( oy - ay )
    )

color :: RGBA -> Picture -> Picture
{-# INLINE color #-}
color c = OverPic id id 0 (const c)

translate3 :: Float -> Float -> Point3 -> Point3
{-# INLINE translate3 #-}
translate3 a b (x,y,z) = (x+a,y+b,z)

translate :: Float -> Float -> Picture -> Picture
{-# INLINE translate #-}
translate x y = OverPic (translate3 x y) id 0 id

setDepth :: Float -> Picture -> Picture
{-# INLINE setDepth #-}
setDepth d = OverPic (\(x,y,_) -> (x,y,d)) id 0 id

setLayer :: Int -> Picture -> Picture
{-# INLINE setLayer #-}
setLayer = OnLayer

scale3 :: Float -> Float -> Point3 -> Point3
{-# INLINE scale3 #-}
scale3 a b (x,y,z) = (x*a,y*b,z)

scale :: Float -> Float -> Picture -> Picture
{-# INLINE scale #-}
scale x y = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id

rotate3 :: Float -> Point3 -> Point3
{-# INLINE rotate3 #-}
rotate3 a (x,y,z) = (x',y',z)
  where 
    (x',y') = rotateV a (x,y)

rotate :: Float -> Picture -> Picture
{-# INLINE rotate #-}
rotate a = OverPic (rotate3 a) id a id

pictures :: [Picture] -> Picture
{-# INLINE pictures #-}
pictures = Pictures

makeArc :: Float -> (Float,Float) -> [Point2]
{-# INLINE makeArc #-}
makeArc rad (a,b) = map (`rotateV` (0,rad)) angles
  where 
    angles = [a,a+step.. b]
    step = pi * 0.2

circleSolid :: Float -> Picture
{-# INLINE circleSolid #-}
circleSolid = Circle 0 white white

circleSolidCol :: Color -> Color -> Float -> Picture
{-# INLINE circleSolidCol #-}
circleSolidCol = Circle 0

circle :: Float -> Picture
{-# INLINE circle #-}
circle rad = thickArc 0 (2*pi) rad 1

text :: String -> Picture
{-# INLINE text #-}
text = Text 1

line :: [Point2] -> Picture
{-# INLINE line #-}
line = Line 0

lineCol :: [(Point2,RGBA)] -> Picture
{-# INLINE lineCol #-}
lineCol = LineCol 0

thickLine :: [Point2] -> Float -> Picture
{-# INLINE thickLine #-}
thickLine ps t = pictures $ f ps
  where 
    f (x:y:ys) 
      | x == y      = f (x:ys)
      | otherwise   = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
    f _             = []
    n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))

thickCircle :: Float -> Float -> Picture
{-# INLINE thickCircle #-}
thickCircle = thickArc 0 (2*pi)

arcSolid :: Float -> Float -> Float -> Picture
{-# INLINE arcSolid #-}
arcSolid startA endA rad
    = polygon $ (0,0) : makeArc rad (startA,endA)

arc startA endA rad = thickArc startA endA rad 1
{-# INLINE arc #-}

thickArc :: Float -> Float -> Float -> Float -> Picture
{-# INLINE thickArc #-}
thickArc = ThickArc 0

withAlpha :: Float -> RGBA -> RGBA
{-# INLINE withAlpha #-}
withAlpha a (x,y,z,a') = (x,y,z,a*a')

red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
red       = (1,0,0,1) 
green     = (0,1,0,1) 
blue      = (0,0,1,1) 
yellow    = (1,1,0,1)  
cyan      = (0,1,1,1) 
magenta   = (1,0,1,1)  
rose      = (1,0,0.5,1) 
violet    = (0.5,0,1,1)  
azure     = (0,0.5,1,1) 
aquamarine= (0,1,0.5,1) 
chartreuse= (0.5,1,0,1)
orange    = (1,0.5,0,1)  
white     = (1,1,1,1) 

mixColors :: Float -> Float -> Color -> Color -> Color
mixColors rata ratb (r0,g0,b0,a0) (r2,g2,b2,a2) = 
    let fullrat = rata + ratb
        normrata = rata / fullrat
        normratb = ratb / fullrat
        f x y = sqrt $ normrata * x^2 + normratb * y^2
    in  (f r0 r2 , f g0 g2 , f b0 b2 , normrata * a0 + normratb * a2)

light :: Color -> Color
light (r,g,b,a) = (r+0.2,g+0.2,b+0.2,a)

dark :: Color -> Color
dark (r,g,b,a) = (r-0.2,g-0.2,b-0.2,a)
        
dim :: Color -> Color
dim (r,g,b,a) = (r/1.2,g/1.2,b/1.2,a)

bright :: Color -> Color
bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a)

greyN :: Float -> Color
greyN x = (x,x,x,1)