---------------------------------------------------------
-- |
-- Copyright   : (c) 2023, haskell@henning-thielemann.de
-- License     : BSD-style
--
-- Maintainer  : haskell@henning-thielemann.de
-- Stability   : experimental
-- Portability : portable
--
-- PDF transparency
---------------------------------------------------------
module Graphics.PDF.Transparency(
  -- * Transparency
  SoftMask,
  createSoftMask,
  createTransparencyGroup,
  paintWithTransparency,
  ) where

import qualified Graphics.PDF.Draw as Draw
import Graphics.PDF.Document (createPDFXFormExtra)
import Graphics.PDF.Draw (PDF, Draw, SoftMask(SoftMask))
import Graphics.PDF.Shapes (Rectangle)
import Graphics.PDF.LowLevel.Serializer (serialize)
import Graphics.PDF.LowLevel.Types

import Control.Monad.Writer (tell)
import Control.Monad (void)



createSoftMask ::
       Rectangle -- ^ Bounding box
    -> Draw a -- ^ Content of the soft mask
    -> PDF SoftMask
createSoftMask :: forall a. Rectangle -> Draw a -> PDF SoftMask
createSoftMask Rectangle
bbox =
    (PDFReference PDFXForm -> SoftMask)
-> PDF (PDFReference PDFXForm) -> PDF SoftMask
forall a b. (a -> b) -> PDF a -> PDF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PDFReference PDFXForm -> SoftMask
SoftMask (PDF (PDFReference PDFXForm) -> PDF SoftMask)
-> (Draw a -> PDF (PDFReference PDFXForm))
-> Draw a
-> PDF SoftMask
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ColorSpace Double (PDFExpression Double)
-> Rectangle -> Draw a -> PDF (PDFReference PDFXForm)
forall a e b.
ColorSpace a e
-> Rectangle -> Draw b -> PDF (PDFReference PDFXForm)
createTransparencyGroup ColorSpace Double (PDFExpression Double)
Draw.GraySpace Rectangle
bbox

createTransparencyGroup ::
       Draw.ColorSpace a e
    -> Rectangle -- ^ Bounding box
    -> Draw b -- ^ Painting
    -> PDF (PDFReference Draw.PDFXForm)
createTransparencyGroup :: forall a e b.
ColorSpace a e
-> Rectangle -> Draw b -> PDF (PDFReference PDFXForm)
createTransparencyGroup ColorSpace a e
space Rectangle
bbox Draw b
img =
    Rectangle -> Draw b -> PDFDictionary -> PDF (PDFReference PDFXForm)
forall a.
Rectangle -> Draw a -> PDFDictionary -> PDF (PDFReference PDFXForm)
createPDFXFormExtra Rectangle
bbox Draw b
img (PDFDictionary -> PDF (PDFReference PDFXForm))
-> PDFDictionary -> PDF (PDFReference PDFXForm)
forall a b. (a -> b) -> a -> b
$
        [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
            String -> PDFDictionary -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Group" ([(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
                String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName String
"Group") (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"S" (String -> PDFName
PDFName String
"Transparency") (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                String -> Bool -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"I" Bool
True (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"CS" (ColorSpace a e -> PDFName
forall a e. ColorSpace a e -> PDFName
Draw.colorSpaceName ColorSpace a e
space) (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
                []) (PDFName, AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. a -> [a] -> [a]
:
            []

{- |
If the Draw Monad paints overlapping geometric primitives or text,
the result will certainly not be what you want.
Text ignores soft masks.
Each primitive other than text is painted with the soft mask
over the previous geometric objects.
It is very likely, that in this case you want
to generate a transparency group for your drawing.
-}
paintWithTransparency ::
       SoftMask -- ^ Soft mask
    -> Draw a -- ^ Shape to paint
    -> Draw ()
paintWithTransparency :: forall a. SoftMask -> Draw a -> Draw ()
paintWithTransparency SoftMask
softMask Draw a
d =
    Draw () -> Draw ()
forall a. Draw a -> Draw a
Draw.withNewContext (Draw () -> Draw ()) -> Draw () -> Draw ()
forall a b. (a -> b) -> a -> b
$ do
        String
newName <-
            String
-> (DrawState -> Map SoftMask String)
-> (Map SoftMask String -> DrawState -> DrawState)
-> SoftMask
-> Draw String
forall a.
(Ord a, PdfResourceObject a) =>
String
-> (DrawState -> Map a String)
-> (Map a String -> DrawState -> DrawState)
-> a
-> Draw String
Draw.registerResource String
"ExtGState"
                DrawState -> Map SoftMask String
Draw.softMasks (\Map SoftMask String
newMap DrawState
s -> DrawState
s { Draw.softMasks = newMap })
                SoftMask
softMask
        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
" gs"
            ]
        Draw a -> Draw ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Draw a
d

{-
https://github.com/pdf-association/pdf20examples/issues/9
-}