module Graphics.UI.FreeGame.Data.Bitmap (
Bitmap(..)
, _BitmapArray
, _BitmapHash
,bitmapSize
,loadBitmapFromFile
,toBitmap
,toStableBitmap
,makeStableBitmap
,onBitmapWithHashable
,cropBitmap
) where
import Control.Applicative
import Codec.Picture.Repa
import Data.Array.Repa as R
import qualified Data.Array.Repa.Repr.ForeignPtr as RF
import Data.Word
import System.Random
import Data.Hashable
import Control.Monad.IO.Class
data Bitmap = BitmapData (R.Array RF.F DIM3 Word8) (Maybe Int)
instance Show Bitmap where
show (BitmapData _ h) = "<BitmapData #" Prelude.++ show h Prelude.++ ">"
instance Eq Bitmap where
BitmapData _ h == BitmapData _ h' = h == h'
instance Ord Bitmap where
BitmapData _ h <= BitmapData _ h' = h <= h'
_BitmapArray :: Functor f => (R.Array RF.F DIM3 Word8 -> f (R.Array RF.F DIM3 Word8)) -> Bitmap -> f Bitmap
_BitmapArray f (BitmapData a h) = fmap (\a' -> BitmapData a' h) (f a)
_BitmapHash :: Functor f => (Maybe Int -> f (Maybe Int)) -> Bitmap -> f Bitmap
_BitmapHash f (BitmapData a h) = fmap (\h' -> BitmapData a h') (f h)
toBitmap :: R.Array RF.F DIM3 Word8 -> Bitmap
toBitmap ar = BitmapData ar Nothing
toStableBitmap :: R.Array RF.F DIM3 Word8 -> Bitmap
toStableBitmap ar = BitmapData ar $ Just $ foldAllS combine 0 $ R.map fromIntegral ar where
combine p q = hash (p, q)
makeStableBitmap :: R.Array RF.F DIM3 Word8 -> IO Bitmap
makeStableBitmap ar = BitmapData ar <$> Just <$> randomIO
bitmapSize :: Bitmap -> (Int, Int)
bitmapSize (BitmapData a _) = let (Z :. h :. w :. _) = R.extent a in (w, h)
loadBitmapFromFile :: MonadIO m => FilePath -> m Bitmap
loadBitmapFromFile path = liftIO $ readImageRGBA path >>= either fail return >>= makeStableBitmap . imgData . reverseColorChannel
onBitmapWithHashable :: Hashable h => h -> (R.Array RF.F DIM3 Word8 -> R.Array RF.F DIM3 Word8) -> Bitmap -> Bitmap
onBitmapWithHashable v f (BitmapData ar h) = BitmapData (f ar) (hash <$> (,) v <$> h)
cropBitmap :: Bitmap
-> (Int, Int)
-> (Int, Int)
-> Bitmap
cropBitmap bmp (w, h) (x, y) = onBitmapWithHashable (w*4421,h*4441,x*3581,y*3571) (computeS . extract (Z :. y :. x :. 0) (Z :. h :. w :. 4)) bmp