{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Data types for representing pictures.
module Brillo.Internals.Data.Picture (
  Point,
  Vector,
  Path,
  Picture (..),

  -- * Bitmaps
  Rectangle (..),
  BitmapData,
  PixelFormat (..),
  BitmapFormat (..),
  RowOrder (..),
  bitmapSize,
  bitmapOfForeignPtr,
  bitmapDataOfForeignPtr,
  bitmapOfByteString,
  bitmapDataOfByteString,
  bitmapOfBMP,
  bitmapDataOfBMP,
  loadBMP,
  rectAtOrigin,
)
where

import Brillo.Internals.Data.Color (Color)
import Brillo.Internals.Rendering.Bitmap (
  BitmapData (BitmapData, bitmapSize),
  BitmapFormat (..),
  PixelFormat (..),
  Rectangle (..),
  RowOrder (..),
 )
import Codec.BMP (BMP, bmpDimensions, readBMP, unpackBMPToRGBA32)
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe qualified as BSU
import Data.Data (Data, Typeable)
import Data.Word (Word8)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr)
import Foreign.Marshal.Alloc (finalizerFree, mallocBytes)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (castPtr)
import System.IO.Unsafe (unsafePerformIO)
import Prelude hiding (map)


#if __GLASGOW_HASKELL__ >= 800
import Data.Semigroup
import Data.List.NonEmpty
#endif


-- | A point on the x-y plane.
type Point = (Float, Float)


-- | A vector can be treated as a point, and vis-versa.
type Vector = Point


-- | A path through the x-y plane.
type Path = [Point]


-- | A 2D picture
data Picture
  = -- Primitives -------------------------------------

    -- | A blank picture, with nothing in it.
    Blank
  | -- | A convex polygon filled with a solid color.
    Polygon Path
  | -- | A line along an arbitrary path.
    Line Path
  | -- | A circle with the given radius.
    Circle Float
  | -- | A circle with the given radius and thickness.
    --   If the thickness is 0 then this is equivalent to `Circle`.
    ThickCircle Float Float
  | -- | A circular arc drawn counter-clockwise between two angles
    --  (in degrees) at the given radius.
    Arc Float Float Float
  | -- | A circular arc drawn counter-clockwise between two angles
    --  (in degrees), with the given radius and thickness.
    --   If the thickness is 0 then this is equivalent to `Arc`.
    ThickArc Float Float Float Float
  | -- | Text to draw with a vector font
    Text String
  | -- | A bitmap image.
    Bitmap BitmapData
  | -- | A subsection of a bitmap image where
    --   the first argument selects a sub section in the bitmap,
    --   and second argument determines the bitmap data.
    BitmapSection Rectangle BitmapData
  | -- Color ------------------------------------------

    -- | A picture drawn with this color.
    Color Color Picture
  | -- Transforms -------------------------------------

    -- | A picture translated by the given x and y coordinates.
    Translate Float Float Picture
  | -- | A picture rotated clockwise by the given angle (in degrees).
    Rotate Float Picture
  | -- | A picture scaled by the given x and y factors.
    Scale Float Float Picture
  | -- More Pictures ----------------------------------

    -- | A picture consisting of several others.
    Pictures [Picture]
  deriving (Int -> Picture -> ShowS
[Picture] -> ShowS
Picture -> String
(Int -> Picture -> ShowS)
-> (Picture -> String) -> ([Picture] -> ShowS) -> Show Picture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Picture -> ShowS
showsPrec :: Int -> Picture -> ShowS
$cshow :: Picture -> String
show :: Picture -> String
$cshowList :: [Picture] -> ShowS
showList :: [Picture] -> ShowS
Show, Picture -> Picture -> Bool
(Picture -> Picture -> Bool)
-> (Picture -> Picture -> Bool) -> Eq Picture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Picture -> Picture -> Bool
== :: Picture -> Picture -> Bool
$c/= :: Picture -> Picture -> Bool
/= :: Picture -> Picture -> Bool
Eq, Typeable Picture
Typeable Picture =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Picture -> c Picture)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Picture)
-> (Picture -> Constr)
-> (Picture -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Picture))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picture))
-> ((forall b. Data b => b -> b) -> Picture -> Picture)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Picture -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Picture -> r)
-> (forall u. (forall d. Data d => d -> u) -> Picture -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Picture -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Picture -> m Picture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Picture -> m Picture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Picture -> m Picture)
-> Data Picture
Picture -> Constr
Picture -> DataType
(forall b. Data b => b -> b) -> Picture -> Picture
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Picture -> u
forall u. (forall d. Data d => d -> u) -> Picture -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Picture -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Picture -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picture
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picture -> c Picture
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Picture)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picture)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picture -> c Picture
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picture -> c Picture
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picture
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picture
$ctoConstr :: Picture -> Constr
toConstr :: Picture -> Constr
$cdataTypeOf :: Picture -> DataType
dataTypeOf :: Picture -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Picture)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Picture)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picture)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picture)
$cgmapT :: (forall b. Data b => b -> b) -> Picture -> Picture
gmapT :: (forall b. Data b => b -> b) -> Picture -> Picture
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Picture -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Picture -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Picture -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Picture -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Picture -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Picture -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Picture -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Picture -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picture -> m Picture
Data, Typeable)


-- Instances ------------------------------------------------------------------
instance Monoid Picture where
  mempty :: Picture
mempty = Picture
Blank
  mconcat :: [Picture] -> Picture
mconcat = [Picture] -> Picture
Pictures

#if __GLASGOW_HASKELL__ >= 800
instance Semigroup Picture where
  Picture
a <> :: Picture -> Picture -> Picture
<> Picture
b          = [Picture] -> Picture
Pictures [Picture
a, Picture
b]
  sconcat :: NonEmpty Picture -> Picture
sconcat         = [Picture] -> Picture
Pictures ([Picture] -> Picture)
-> (NonEmpty Picture -> [Picture]) -> NonEmpty Picture -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Picture -> [Picture]
forall a. NonEmpty a -> [a]
toList
  stimes :: forall b. Integral b => b -> Picture -> Picture
stimes          = b -> Picture -> Picture
forall b a. Integral b => b -> a -> a
stimesIdempotent
#endif


-- Bitmaps --------------------------------------------------------------------

{-| O(1). Use a `ForeignPtr` of RGBA data as a bitmap with the given
  width and height.

  The boolean flag controls whether Brillo should cache the data
  between frames for speed. If you are programatically generating
  the image for each frame then use `False`. If you have loaded it
  from a file then use `True`.
-}
bitmapOfForeignPtr :: Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> Picture
bitmapOfForeignPtr :: Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> Picture
bitmapOfForeignPtr Int
width Int
height BitmapFormat
fmt ForeignPtr Word8
fptr Bool
cacheMe =
  BitmapData -> Picture
Bitmap (BitmapData -> Picture) -> BitmapData -> Picture
forall a b. (a -> b) -> a -> b
$
    Int
-> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> BitmapData
bitmapDataOfForeignPtr Int
width Int
height BitmapFormat
fmt ForeignPtr Word8
fptr Bool
cacheMe


-- Bitmap width height (bitmapDataOfForeignPtr width height fmt fptr) cacheMe

bitmapDataOfForeignPtr :: Int -> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> BitmapData
bitmapDataOfForeignPtr :: Int
-> Int -> BitmapFormat -> ForeignPtr Word8 -> Bool -> BitmapData
bitmapDataOfForeignPtr Int
width Int
height BitmapFormat
fmt ForeignPtr Word8
fptr Bool
cacheMe =
  let len :: Int
len = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
  in  Int
-> BitmapFormat
-> (Int, Int)
-> Bool
-> ForeignPtr Word8
-> BitmapData
BitmapData Int
len BitmapFormat
fmt (Int
width, Int
height) Bool
cacheMe ForeignPtr Word8
fptr


{-| O(size). Copy a `ByteString` of RGBA data into a bitmap with the given
  width and height.

  The boolean flag controls whether Brillo should cache the data
  between frames for speed. If you are programatically generating
  the image for each frame then use `False`. If you have loaded it
  from a file then use `True`.
-}
bitmapOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> Picture
bitmapOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> Picture
bitmapOfByteString Int
width Int
height BitmapFormat
fmt ByteString
bs Bool
cacheMe =
  BitmapData -> Picture
Bitmap (BitmapData -> Picture) -> BitmapData -> Picture
forall a b. (a -> b) -> a -> b
$
    Int -> Int -> BitmapFormat -> ByteString -> Bool -> BitmapData
bitmapDataOfByteString Int
width Int
height BitmapFormat
fmt ByteString
bs Bool
cacheMe


bitmapDataOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> BitmapData
bitmapDataOfByteString :: Int -> Int -> BitmapFormat -> ByteString -> Bool -> BitmapData
bitmapDataOfByteString Int
width Int
height BitmapFormat
fmt ByteString
bs Bool
cacheMe =
  IO BitmapData -> BitmapData
forall a. IO a -> a
unsafePerformIO (IO BitmapData -> BitmapData) -> IO BitmapData -> BitmapData
forall a b. (a -> b) -> a -> b
$
    do
      let len :: Int
len = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
      Ptr Word8
ptr <- Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
len
      ForeignPtr Word8
fptr <- FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FinalizerPtr a
finalizerFree Ptr Word8
ptr

      ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BSU.unsafeUseAsCString ByteString
bs ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        \CString
cstr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
ptr (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
cstr) Int
len

      BitmapData -> IO BitmapData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitmapData -> IO BitmapData) -> BitmapData -> IO BitmapData
forall a b. (a -> b) -> a -> b
$ Int
-> BitmapFormat
-> (Int, Int)
-> Bool
-> ForeignPtr Word8
-> BitmapData
BitmapData Int
len BitmapFormat
fmt (Int
width, Int
height) Bool
cacheMe ForeignPtr Word8
fptr
{-# NOINLINE bitmapDataOfByteString #-}


-- | O(size). Copy a `BMP` file into a bitmap.
bitmapOfBMP :: BMP -> Picture
bitmapOfBMP :: BMP -> Picture
bitmapOfBMP BMP
bmp =
  BitmapData -> Picture
Bitmap (BitmapData -> Picture) -> BitmapData -> Picture
forall a b. (a -> b) -> a -> b
$ BMP -> BitmapData
bitmapDataOfBMP BMP
bmp


-- | O(size). Copy a `BMP` file into a bitmap.
bitmapDataOfBMP :: BMP -> BitmapData
bitmapDataOfBMP :: BMP -> BitmapData
bitmapDataOfBMP BMP
bmp =
  IO BitmapData -> BitmapData
forall a. IO a -> a
unsafePerformIO (IO BitmapData -> BitmapData) -> IO BitmapData -> BitmapData
forall a b. (a -> b) -> a -> b
$
    do
      let (Int
width, Int
height) = BMP -> (Int, Int)
bmpDimensions BMP
bmp
      let bs :: ByteString
bs = BMP -> ByteString
unpackBMPToRGBA32 BMP
bmp
      let len :: Int
len = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4

      Ptr Word8
ptr <- Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
len
      ForeignPtr Word8
fptr <- FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FinalizerPtr a
finalizerFree Ptr Word8
ptr

      ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BSU.unsafeUseAsCString ByteString
bs ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        \CString
cstr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
ptr (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
cstr) Int
len

      BitmapData -> IO BitmapData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitmapData -> IO BitmapData) -> BitmapData -> IO BitmapData
forall a b. (a -> b) -> a -> b
$ Int
-> BitmapFormat
-> (Int, Int)
-> Bool
-> ForeignPtr Word8
-> BitmapData
BitmapData Int
len (RowOrder -> PixelFormat -> BitmapFormat
BitmapFormat RowOrder
BottomToTop PixelFormat
PxRGBA) (Int
width, Int
height) Bool
True ForeignPtr Word8
fptr
{-# NOINLINE bitmapDataOfBMP #-}


-- | Load an uncompressed 24 or 32bit RGBA BMP file as a bitmap.
loadBMP :: FilePath -> IO Picture
loadBMP :: String -> IO Picture
loadBMP String
filePath =
  do
    Either Error BMP
ebmp <- String -> IO (Either Error BMP)
readBMP String
filePath
    case Either Error BMP
ebmp of
      Left Error
err -> String -> IO Picture
forall a. HasCallStack => String -> a
error (String -> IO Picture) -> String -> IO Picture
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
      Right BMP
bmp -> Picture -> IO Picture
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Picture -> IO Picture) -> Picture -> IO Picture
forall a b. (a -> b) -> a -> b
$ BMP -> Picture
bitmapOfBMP BMP
bmp


{-| Construct a rectangle of the given width and height,
  with the lower left corner at the origin.
-}
rectAtOrigin :: Int -> Int -> Rectangle
rectAtOrigin :: Int -> Int -> Rectangle
rectAtOrigin Int
w Int
h = (Int, Int) -> (Int, Int) -> Rectangle
Rectangle (Int
0, Int
0) (Int
w, Int
h)