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

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

        -- * Bitmaps
        , BitmapData, PixelFormat(..), BitmapFormat(..), RowOrder(..)
        , bitmapOfForeignPtr
        , bitmapOfByteString
        , bitmapOfBMP
        , loadBMP)
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 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 thickness and radius.
        --   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 with a width, height and some 32-bit RGBA
        --   bitmap data.
        --
        --  The boolean flag controls whether Gloss should cache the data
        --  in GPU memory between frames. If you are programatically generating
        --  the image for each frame then use @False@. If you have loaded it
        --  from a file then use @True@.
        --  Setting @False@ for static images will make rendering slower
        --  than it needs to be.
        --  Setting @True@  for dynamically generated images will cause a
        --  GPU memory leak.
        | Bitmap        Int     Int     BitmapData Bool

        -- 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 (Show, Eq, Data, Typeable)


-- Instances ------------------------------------------------------------------
instance Monoid Picture where
  mempty          = Blank
  mappend a b     = Pictures [a, b]
  mconcat         = Pictures

#if __GLASGOW_HASKELL__ >= 800
instance Semigroup Picture where
  a <> b          = Pictures [a, b]
  sconcat         = Pictures . toList
  stimes          = 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 width height fmt fptr cacheMe
 = let  len     = width * height * 4
        bdata   = BitmapData len fmt fptr
   in   Bitmap width height bdata cacheMe


-- | 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 width height fmt bs cacheMe
 = unsafePerformIO
 $ do   let len = width * height * 4
        ptr     <- mallocBytes len
        fptr    <- newForeignPtr finalizerFree ptr

        BSU.unsafeUseAsCString bs
         $ \cstr -> copyBytes ptr (castPtr cstr) len

        let bdata = BitmapData len fmt fptr
        return $ Bitmap width height bdata cacheMe
{-# NOINLINE bitmapOfByteString #-}


-- | O(size). Copy a `BMP` file into a bitmap.
bitmapOfBMP :: BMP -> Picture
bitmapOfBMP bmp
 = unsafePerformIO
 $ do   let (width, height)     = bmpDimensions bmp
        let bs                  = unpackBMPToRGBA32 bmp
        let len                 = width * height * 4

        ptr     <- mallocBytes len
        fptr    <- newForeignPtr finalizerFree ptr

        BSU.unsafeUseAsCString bs
         $ \cstr -> copyBytes ptr (castPtr cstr) len

        let bdata = BitmapData len (BitmapFormat BottomToTop PxRGBA) fptr

        return $ Bitmap width height bdata True
{-# NOINLINE bitmapOfBMP #-}


-- | Load an uncompressed 24 or 32bit RGBA BMP file as a bitmap.
loadBMP :: FilePath -> IO Picture
loadBMP filePath
 = do   ebmp    <- readBMP filePath
        case ebmp of
         Left err       -> error $ show err
         Right bmp      -> return $ bitmapOfBMP bmp