{-# LANGUAGE GADTs #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- PDF shading
---------------------------------------------------------
module Graphics.PDF.Shading(
  -- * Shading
  -- ** Type
    PDFShading(..)
  , paintWithShading
  , applyShading
  , createFunction1Object
  , createFunction2Object
 ) where

import qualified Graphics.PDF.Expression as Expr
import Graphics.PDF.Draw as Draw
import Graphics.PDF.Pages(addObject)
import Graphics.PDF.Shapes(setAsClipPath)
import Graphics.PDF.Expression(PDFExpression)
import Graphics.PDF.LowLevel.Serializer(serialize)
import Graphics.PDF.LowLevel.Types(PDFFloat)

import qualified Data.Array as Array

import Control.Monad.Writer


type ExprFloat = PDFExpression PDFFloat

createFunction1Object ::
    (ColorTuple a, Expr.Result e) =>
    Function1 Global a e ->
    PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
createFunction1Object :: forall a e.
(ColorTuple a, Result e) =>
Function1 Global a e
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
createFunction1Object Function1 Global a e
func =
    let domain :: PDFDictionary
domain = Function1 Global a e -> PDFDictionary
forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> PDFDictionary
domain1Dict Function1 Global a e
func in
    case Function1 Global a e
func of
        Calculator1 ExprFloat -> e
f ->
            (PDFReference PDFStream
 -> FunctionObject (PDFFloat -> a) (ExprFloat -> e))
-> PDF (PDFReference PDFStream)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PDFReference PDFStream
-> FunctionObject (PDFFloat -> a) (ExprFloat -> e)
forall a e. PDFReference PDFStream -> FunctionObject a e
FunctionStream (PDF (PDFReference PDFStream)
 -> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e)))
-> PDF (PDFReference PDFStream)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> a -> b
$ PDFStream -> PDF (PDFReference PDFStream)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (PDFStream -> PDF (PDFReference PDFStream))
-> PDFStream -> PDF (PDFReference PDFStream)
forall a b. (a -> b) -> a -> b
$
            PDFDictionary -> (ExprFloat -> e) -> PDFStream
forall f. Function f => PDFDictionary -> f -> PDFStream
Draw.rsrcFromCalculator PDFDictionary
domain ExprFloat -> e
f
        Interpolated1 PDFFloat
n a
x a
y ->
            (PDFReference PDFDictionary
 -> FunctionObject (PDFFloat -> a) (ExprFloat -> e))
-> PDF (PDFReference PDFDictionary)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PDFReference PDFDictionary
-> FunctionObject (PDFFloat -> a) (ExprFloat -> e)
forall a e. PDFReference PDFDictionary -> FunctionObject a e
FunctionObject (PDF (PDFReference PDFDictionary)
 -> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e)))
-> PDF (PDFReference PDFDictionary)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> a -> b
$ PDFDictionary -> PDF (PDFReference PDFDictionary)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (PDFDictionary -> PDF (PDFReference PDFDictionary))
-> PDFDictionary -> PDF (PDFReference PDFDictionary)
forall a b. (a -> b) -> a -> b
$
            PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
forall a.
ColorTuple a =>
PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
Draw.rsrcFromInterpolated PDFDictionary
domain PDFFloat
n a
x a
y
        Stitched1 Function1 Local a e
part [(PDFFloat, Function1 Local a e)]
parts ->
            (PDFReference PDFDictionary
 -> FunctionObject (PDFFloat -> a) (ExprFloat -> e))
-> PDF (PDFReference PDFDictionary)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PDFReference PDFDictionary
-> FunctionObject (PDFFloat -> a) (ExprFloat -> e)
forall a e. PDFReference PDFDictionary -> FunctionObject a e
FunctionObject (PDF (PDFReference PDFDictionary)
 -> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e)))
-> PDF (PDFReference PDFDictionary)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> a -> b
$ PDFDictionary -> PDF (PDFReference PDFDictionary)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (PDFDictionary -> PDF (PDFReference PDFDictionary))
-> PDFDictionary -> PDF (PDFReference PDFDictionary)
forall a b. (a -> b) -> a -> b
$
            PDFDictionary
-> Function1 Local a e
-> [(PDFFloat, Function1 Local a e)]
-> PDFDictionary
forall a e.
(ColorTuple a, Result e) =>
PDFDictionary
-> Function1 Local a e
-> [(PDFFloat, Function1 Local a e)]
-> PDFDictionary
Draw.rsrcFromStitched PDFDictionary
domain Function1 Local a e
part [(PDFFloat, Function1 Local a e)]
parts
        Sampled1 Array Int a
arr ->
            (PDFReference PDFStream
 -> FunctionObject (PDFFloat -> a) (ExprFloat -> e))
-> PDF (PDFReference PDFStream)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PDFReference PDFStream
-> FunctionObject (PDFFloat -> a) (ExprFloat -> e)
forall a e. PDFReference PDFStream -> FunctionObject a e
FunctionStream (PDF (PDFReference PDFStream)
 -> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e)))
-> PDF (PDFReference PDFStream)
-> PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
forall a b. (a -> b) -> a -> b
$ PDFStream -> PDF (PDFReference PDFStream)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (PDFStream -> PDF (PDFReference PDFStream))
-> PDFStream -> PDF (PDFReference PDFStream)
forall a b. (a -> b) -> a -> b
$
            PDFDictionary -> ((Int, Int) -> [Int]) -> Array Int a -> PDFStream
forall a i.
ColorTuple a =>
PDFDictionary -> ((i, i) -> [Int]) -> Array i a -> PDFStream
Draw.rsrcFromSampled PDFDictionary
domain (\(Int, Int)
bnds -> [(Int, Int) -> Int
forall a. Ix a => (a, a) -> Int
Array.rangeSize (Int, Int)
bnds]) Array Int a
arr

createFunction2Object ::
    (ColorTuple a, Expr.Result e) =>
    Function2 Global a e ->
    PDF (FunctionObject
            (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e))
createFunction2Object :: forall a e.
(ColorTuple a, Result e) =>
Function2 Global a e
-> PDF
     (FunctionObject
        (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e))
createFunction2Object Function2 Global a e
func =
    let domain :: PDFDictionary
domain = Function2 Global a e -> PDFDictionary
forall a (f :: * -> * -> *) e.
ColorTuple a =>
f a e -> PDFDictionary
domain2Dict Function2 Global a e
func in
    (PDFReference PDFStream
 -> FunctionObject
      (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e))
-> PDF (PDFReference PDFStream)
-> PDF
     (FunctionObject
        (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e))
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PDFReference PDFStream
-> FunctionObject
     (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e)
forall a e. PDFReference PDFStream -> FunctionObject a e
FunctionStream (PDF (PDFReference PDFStream)
 -> PDF
      (FunctionObject
         (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e)))
-> PDF (PDFReference PDFStream)
-> PDF
     (FunctionObject
        (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e))
forall a b. (a -> b) -> a -> b
$ PDFStream -> PDF (PDFReference PDFStream)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject (PDFStream -> PDF (PDFReference PDFStream))
-> PDFStream -> PDF (PDFReference PDFStream)
forall a b. (a -> b) -> a -> b
$
    case Function2 Global a e
func of
        Calculator2 ExprFloat -> ExprFloat -> e
f -> PDFDictionary -> (ExprFloat -> ExprFloat -> e) -> PDFStream
forall f. Function f => PDFDictionary -> f -> PDFStream
rsrcFromCalculator PDFDictionary
domain ExprFloat -> ExprFloat -> e
f
        Sampled2 Array (Int, Int) a
arr ->
            PDFDictionary
-> (((Int, Int), (Int, Int)) -> [Int])
-> Array (Int, Int) a
-> PDFStream
forall a i.
ColorTuple a =>
PDFDictionary -> ((i, i) -> [Int]) -> Array i a -> PDFStream
rsrcFromSampled
                PDFDictionary
domain
                (\((Int
lx,Int
ly), (Int
ux,Int
uy)) ->
                    [(Int, Int) -> Int
forall a. Ix a => (a, a) -> Int
Array.rangeSize (Int
lx,Int
ux), (Int, Int) -> Int
forall a. Ix a => (a, a) -> Int
Array.rangeSize (Int
ly,Int
uy)])
                Array (Int, Int) a
arr


-- | Fill clipping region with a shading
applyShading :: PDFShading -> Draw ()
applyShading :: PDFShading -> Draw ()
applyShading PDFShading
shade = do
    String
newName <-
        String
-> (DrawState -> Map PDFShading String)
-> (Map PDFShading String -> DrawState -> DrawState)
-> PDFShading
-> Draw String
forall a.
(Ord a, PdfResourceObject a) =>
String
-> (DrawState -> Map a String)
-> (Map a String -> DrawState -> DrawState)
-> a
-> Draw String
registerResource String
"Shading"
            DrawState -> Map PDFShading String
shadings (\Map PDFShading String
newMap DrawState
s -> DrawState
s { shadings = newMap })
            PDFShading
shade
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" sh"
                    ]
    
paintWithShading :: PDFShading -- ^ Shading
                 -> Draw a -- ^ Shape to paint
                 -> Draw ()
paintWithShading :: forall a. PDFShading -> Draw a -> Draw ()
paintWithShading PDFShading
shade Draw a
d = do
    Draw () -> Draw ()
forall a. Draw a -> Draw a
withNewContext (Draw () -> Draw ()) -> Draw () -> Draw ()
forall a b. (a -> b) -> a -> b
$ do
      a
_ <- Draw a
d
      Draw ()
setAsClipPath
      PDFShading -> Draw ()
applyShading PDFShading
shade