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

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

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

import Graphics.Gloss.Internals.Data.Color
import Graphics.Gloss.Internals.Rendering.Bitmap
import Codec.BMP
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Data.Word
import Data.Monoid
import Data.ByteString
import Data.Data
import System.IO.Unsafe
import qualified Data.ByteString.Unsafe as BSU
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 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

        -- | Some 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
  mappend :: Picture -> Picture -> Picture
mappend Picture
a Picture
b     = [Picture] -> Picture
Pictures [Picture
a, Picture
b]
  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 Gloss 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 Gloss 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)