{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Blank.Utils where

import Data.ByteString.Base64  -- Not sure why to use this, vs this *.URL version. This one works, though.
import qualified Data.ByteString as B
import Data.Text(Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)

import Graphics.Blank.Canvas
import Graphics.Blank.Generated
import Graphics.Blank.JavaScript

import Prelude.Compat

-- | Clear the screen. Restores the default transformation matrix.
clearCanvas :: Canvas ()
clearCanvas :: Canvas ()
clearCanvas = do
  (Double, Double, Double, Double, Double, Double) -> Canvas ()
setTransform (Double
1, Double
0, Double
0, Double
1, Double
0, Double
0)
  CanvasContext
me <- Canvas CanvasContext
myCanvasContext
  (Double, Double, Double, Double) -> Canvas ()
clearRect (Double
0,Double
0,forall a b. (Image a, Num b) => a -> b
width CanvasContext
me,forall a b. (Image a, Num b) => a -> b
height CanvasContext
me)

-- | Wrap a canvas computation in 'save' / 'restore'.
saveRestore :: Canvas a -> Canvas a
saveRestore :: forall a. Canvas a -> Canvas a
saveRestore Canvas a
m = do
    () -> Canvas ()
save ()
    a
r <- Canvas a
m
    () -> Canvas ()
restore ()
    forall (m :: * -> *) a. Monad m => a -> m a
return a
r

infixr 0 #

-- | The @#@-operator is the Haskell analog to the @.@-operator
--   in JavaScript. Example:
--
-- > grd # addColorStop(0, "#8ED6FF");
--
--   This can be seen as equivalent of @grd.addColorStop(0, "#8ED6FF")@.
(#) :: a -> (a -> b) -> b
# :: forall a b. a -> (a -> b) -> b
(#) a
obj a -> b
act = a -> b
act a
obj

-- | Read a file, and generate a data URL.
--
-- >  url <- readDataURL "image/png" "image/foo.png"
--
readDataURL :: Text -> FilePath -> IO Text
readDataURL :: Text -> FilePath -> IO Text
readDataURL Text
mime_type FilePath
filePath = do
    ByteString
dat <- FilePath -> IO ByteString
B.readFile FilePath
filePath
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"data:" forall a. Semigroup a => a -> a -> a
<> Text
mime_type forall a. Semigroup a => a -> a -> a
<> Text
";base64," forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
encode ByteString
dat)

-- | Find the MIME type for a data URL.
--
-- > > dataURLMimeType "data:image/png;base64,iVBORw..."
-- > "image/png"
dataURLMimeType :: Text -> Text
dataURLMimeType :: Text -> Text
dataURLMimeType Text
txt
    | Text
dat forall a. Eq a => a -> a -> Bool
/= Text
"data" = forall a. HasCallStack => FilePath -> a
error FilePath
"dataURLMimeType: no 'data:'"
    | Bool -> Bool
not (Text -> Bool
Text.null Text
rest0) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
Text.null Text
rest2) = Text
mime_type
    | Bool
otherwise = forall a. HasCallStack => FilePath -> a
error FilePath
"dataURLMimeType: bad parse"
 where
   (Text
dat,Text
rest0)       = (Char -> Bool) -> Text -> (Text, Text)
Text.span (forall a. Eq a => a -> a -> Bool
/= Char
':') Text
txt
   rest1 :: Text
rest1             = case Text -> Maybe (Char, Text)
Text.uncons Text
rest0 of
                         Just (Char
_,Text
rest1') -> Text
rest1'
                         Maybe (Char, Text)
Nothing         -> Text
"dataURLMimeType: Unexpected empty Text"
   (Text
mime_type,Text
rest2) = (Char -> Bool) -> Text -> (Text, Text)
Text.span (forall a. Eq a => a -> a -> Bool
/= Char
';') Text
rest1

-- | Write a data URL to a given file.
writeDataURL :: FilePath -> Text -> IO ()
writeDataURL :: FilePath -> Text -> IO ()
writeDataURL FilePath
fileName
             = FilePath -> ByteString -> IO ()
B.writeFile FilePath
fileName
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decodeLenient
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.tail
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
',')

-- | Draws an image onto the canvas at the given x- and y-coordinates.
drawImageAt :: Image image => (image, Double, Double) -> Canvas ()
drawImageAt :: forall image. Image image => (image, Double, Double) -> Canvas ()
drawImageAt (image
img, Double
dx, Double
dy) = Method -> Canvas ()
Method forall a b. (a -> b) -> a -> b
$ forall image. Image image => (image, [Double]) -> Method
DrawImage (image
img, [Double
dx, Double
dy])

-- | Acts like 'drawImageAt', but with two extra 'Double' arguments. The third and fourth
--   'Double's specify the width and height of the image, respectively.
drawImageSize :: Image image => (image, Double, Double, Double, Double) -> Canvas ()
drawImageSize :: forall image.
Image image =>
(image, Double, Double, Double, Double) -> Canvas ()
drawImageSize (image
img, Double
dx, Double
dy, Double
dw, Double
dh) = Method -> Canvas ()
Method forall a b. (a -> b) -> a -> b
$ forall image. Image image => (image, [Double]) -> Method
DrawImage (image
img, [Double
dx, Double
dy, Double
dw, Double
dh])

-- | Acts like 'drawImageSize', but with four extra 'Double' arguments before the arguments
--   of 'drawImageSize'. The first and second 'Double's specify the x- and y-coordinates at
--   which the image begins to crop. The third and fourth 'Double's specify the width and
--   height of the cropped image.
--
-- @
-- 'drawImageCrop' img 0 0 dw dh dx dy dw dh = 'drawImageSize' = dx dy dw dh
-- @
drawImageCrop :: Image image => (image, Double, Double, Double, Double, Double, Double, Double, Double) -> Canvas ()
drawImageCrop :: forall image.
Image image =>
(image, Double, Double, Double, Double, Double, Double, Double,
 Double)
-> Canvas ()
drawImageCrop (image
img, Double
sx, Double
sy, Double
sw, Double
sh, Double
dx, Double
dy, Double
dw, Double
dh)
  = Method -> Canvas ()
Method forall a b. (a -> b) -> a -> b
$ forall image. Image image => (image, [Double]) -> Method
DrawImage (image
img, [Double
sx, Double
sy, Double
sw, Double
sh, Double
dx, Double
dy, Double
dw, Double
dh])

-- | Writes 'ImageData' to the canvas at the given x- and y-coordinates.
putImageDataAt :: (ImageData, Double, Double) -> Canvas ()
putImageDataAt :: (ImageData, Double, Double) -> Canvas ()
putImageDataAt (ImageData
imgData, Double
dx, Double
dy) = Method -> Canvas ()
Method forall a b. (a -> b) -> a -> b
$ (ImageData, [Double]) -> Method
PutImageData (ImageData
imgData, [Double
dx, Double
dy])

-- | Acts like 'putImageDataAt', but with four extra 'Double' arguments that specify
--   which region of the 'ImageData' (the dirty rectangle) should be drawn. The third
--   and fourth 'Double's specify the dirty rectangle's x- and y- coordinates, and the
--   fifth and sixth 'Double's specify the dirty rectangle's width and height.
--
-- @
-- 'putImageDataDirty' imgData dx dy 0 0 w h = 'putImageDataAt' imgData dx dy
--   where (w, h) = case imgData of ImageData w' h' _ -> (w', h')
-- @
putImageDataDirty :: (ImageData, Double, Double, Double, Double, Double, Double) -> Canvas ()
putImageDataDirty :: (ImageData, Double, Double, Double, Double, Double, Double)
-> Canvas ()
putImageDataDirty (ImageData
imgData, Double
dx, Double
dy, Double
dirtyX, Double
dirtyY, Double
dirtyWidth, Double
dirtyHeight)
  = Method -> Canvas ()
Method forall a b. (a -> b) -> a -> b
$ (ImageData, [Double]) -> Method
PutImageData (ImageData
imgData, [Double
dx, Double
dy, Double
dirtyX, Double
dirtyY, Double
dirtyWidth, Double
dirtyHeight])