JuicyCairo (empty) → 0.1.0.0

raw patch · 7 files changed

+359/−0 lines, 7 filesdep +JuicyCairodep +JuicyPixelsdep +basesetup-changed

Dependencies added: JuicyCairo, JuicyPixels, base, cairo-image, primitive

Files

ChangeLog.md +3/−0
JuicyCairo.cabal +58/−0
LICENSE +30/−0
README.md +1/−0
Setup.hs +2/−0
src/Data/JuicyCairo.hs +263/−0
test/Spec.hs +2/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for JuicyCairo++## Unreleased changes

+ JuicyCairo.cabal view

@@ -0,0 +1,58 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: fdf814924b10146aaccdb6e7704fef8c2898705b9c40d7feefdf670bb5da0367++name:           JuicyCairo+version:        0.1.0.0+synopsis:       To use images of JuicyPixels from Cairo+description:    Please see the README on GitHub at <https://github.com/githubuser/JuicyCairo#readme>+category:       Graphics+homepage:       https://github.com/githubuser/JuicyCairo#readme+bug-reports:    https://github.com/githubuser/JuicyCairo/issues+author:         YoshikuniJujo+maintainer:     yoshikuni.jujo@gmail.com+copyright:      2021 Yoshikuni Jujo+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/githubuser/JuicyCairo++library+  exposed-modules:+      Data.JuicyCairo+  other-modules:+      Paths_JuicyCairo+  hs-source-dirs:+      src+  build-depends:+      JuicyPixels+    , base >=4.7 && <5+    , cairo-image+    , primitive+  default-language: Haskell2010++test-suite JuicyCairo-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_JuicyCairo+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      JuicyCairo+    , JuicyPixels+    , base >=4.7 && <5+    , cairo-image+    , primitive+  default-language: Haskell2010

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,1 @@+# JuicyCairo

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/Data/JuicyCairo.hs view

@@ -0,0 +1,263 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.JuicyCairo (+	-- * Immutable+	-- ** Cairo Image =\> JuicyPixels Image+	cairoToJuicy,+	cairoArgb32ToJuicyRGBA8, cairoRgb24ToJuicyRGB8,+	cairoA8ToJuicyRGBA8, cairoA8ToJuicyYA8,+	cairoA1ToJuicyRGBA8, cairoA1ToJuicyYA8,+	cairoRgb16_565ToJuicyRGB8, cairoRgb30ToJuicyRGB16,+	-- ** JuicyPixels Image =\> Cairo Image+	juicyToCairo,+	juicyRGBA8ToCairoArgb32, juicyRGB8ToCairoRgb24,+	juicyRGBA8ToCairoA8, juicyYA8ToCairoA8,+	juicyRGBA8ToCairoA1, juicyYA8ToCairoA1,+	juicyRGB8ToCairoRgb16_565, juicyRGB16ToCairoRgb30,++	-- * Mutable+	-- ** Cairo Mutable Image =\> JuicyPixels Image+	cairoMutToJuicy,+	cairoArgb32MutToJuicyRGBA8, cairoRgb24MutToJuicyRGB8,+	cairoA8MutToJuicyRGBA8, cairoA8MutToJuicyYA8,+	cairoA1MutToJuicyRGBA8, cairoA1MutToJuicyYA8,+	cairoRgb16_565MutToJuicyRGB8, cairoRgb30MutToJuicyRGB16,+	-- ** JuicyPixels Image =\> Cairo Mutable Image+	juicyToCairoMut,+	juicyRGBA8ToCairoArgb32Mut, juicyRGB8ToCairoRgb24Mut,+	juicyRGBA8ToCairoA8Mut, juicyYA8ToCairoA8Mut,+	juicyRGBA8ToCairoA1Mut, juicyYA8ToCairoA1Mut,+	juicyRGB8ToCairoRgb16_565Mut, juicyRGB16ToCairoRgb30Mut ) where++import Control.Arrow ((***))+import Control.Monad.Primitive (PrimMonad, PrimState)+import Data.Foldable (for_)+import Data.Bool (bool)+import Data.Maybe (fromJust)+import Data.Word (Word8)++import qualified Data.CairoImage as C+import qualified Codec.Picture as J++---------------------------------------------------------------------------++-- * CAIRO IMAGE => JUICY IMAGE+-- * JUICY IMAGE => CAIRO IMAGE+-- * CAIRO MUTABLE IMAGE => JUICY IMAGE+-- * JUICY IMAGE => CAIRO MUTABLE IMAGE+-- * CAIRO PIXEL => JUICY PIXEL+-- * JUICY PIXEL => CAIRO PIXEL++---------------------------------------------------------------------------+-- CAIRO IMAGE => JUICY IMAGE+---------------------------------------------------------------------------++cairoToJuicy :: (C.Image i, J.Pixel p) => (C.Pixel i -> p) -> i -> J.Image p+cairoToJuicy c i = (uncurry . J.generateImage)+	(\(fromIntegral -> x) (fromIntegral -> y) ->+		c . fromJust $ C.pixelAt i x y)+	(fromIntegral *** fromIntegral $ C.imageSize i)++cairoArgb32ToJuicyRGBA8 :: C.Argb32 -> J.Image J.PixelRGBA8+cairoArgb32ToJuicyRGBA8 = cairoToJuicy pixelArgb32ToPixelRGBA8++cairoRgb24ToJuicyRGB8 :: C.Rgb24 -> J.Image J.PixelRGB8+cairoRgb24ToJuicyRGB8 = cairoToJuicy pixelRgb24ToPixelRGB8++cairoA8ToJuicyRGBA8 :: Word8 -> Word8 -> Word8 -> C.A8 -> J.Image J.PixelRGBA8+cairoA8ToJuicyRGBA8 r g b = cairoToJuicy $ pixelA8ToPixelRGBA8 r g b++cairoA8ToJuicyYA8 :: Word8 -> C.A8 -> J.Image J.PixelYA8+cairoA8ToJuicyYA8 = cairoToJuicy . pixelA8ToPixelYA8++cairoA1ToJuicyRGBA8 :: Word8 -> Word8 -> Word8 -> C.A1 -> J.Image J.PixelRGBA8+cairoA1ToJuicyRGBA8 r g b = cairoToJuicy $ pixelA1ToPixelRGBA8 r g b++cairoA1ToJuicyYA8 :: Word8 -> C.A1 -> J.Image J.PixelYA8+cairoA1ToJuicyYA8 = cairoToJuicy . pixelA1ToPixelYA8++cairoRgb16_565ToJuicyRGB8 :: C.Rgb16_565 -> J.Image J.PixelRGB8+cairoRgb16_565ToJuicyRGB8 = cairoToJuicy pixelRgb16_565ToPixelRGB8++cairoRgb30ToJuicyRGB16 :: C.Rgb30 -> J.Image J.PixelRGB16+cairoRgb30ToJuicyRGB16 = cairoToJuicy pixelRgb30ToPixelRGB16++---------------------------------------------------------------------------+-- JUICY IMAGE => CAIRO IMAGE+---------------------------------------------------------------------------++juicyToCairo :: (J.Pixel p, C.Image i) => (p -> C.Pixel i) -> J.Image p -> i+juicyToCairo c i = C.generateImage+	(fromIntegral $ J.imageWidth i) (fromIntegral $ J.imageHeight i)+	\(fromIntegral -> x) (fromIntegral -> y) -> c $ J.pixelAt i x y++juicyRGBA8ToCairoArgb32 :: J.Image J.PixelRGBA8 -> C.Argb32+juicyRGBA8ToCairoArgb32 = juicyToCairo pixelRGBA8ToPixelArgb32++juicyRGB8ToCairoRgb24 :: J.Image J.PixelRGB8 -> C.Rgb24+juicyRGB8ToCairoRgb24 = juicyToCairo pixelRGB8ToPixelRgb24++juicyRGBA8ToCairoA8 :: J.Image J.PixelRGBA8 -> C.A8+juicyRGBA8ToCairoA8 = juicyToCairo pixelRGBA8ToPixelA8++juicyYA8ToCairoA8 :: J.Image J.PixelYA8 -> C.A8+juicyYA8ToCairoA8 = juicyToCairo pixelYA8ToPixelA8++juicyRGBA8ToCairoA1 :: Word8 -> J.Image J.PixelRGBA8 -> C.A1+juicyRGBA8ToCairoA1 = juicyToCairo . pixelRGBA8ToPixelA1++juicyYA8ToCairoA1 :: Word8 -> J.Image J.PixelYA8 -> C.A1+juicyYA8ToCairoA1 = juicyToCairo . pixelYA8ToPixelA1++juicyRGB8ToCairoRgb16_565 :: J.Image J.PixelRGB8 -> C.Rgb16_565+juicyRGB8ToCairoRgb16_565 = juicyToCairo pixelRGB8ToPixelRgb16_565++juicyRGB16ToCairoRgb30 :: J.Image J.PixelRGB16 -> C.Rgb30+juicyRGB16ToCairoRgb30 = juicyToCairo pixelRGB16ToPixelRgb30++---------------------------------------------------------------------------+-- CAIRO MUTABLE IMAGE => JUICY IMAGE+---------------------------------------------------------------------------++cairoMutToJuicy :: (PrimMonad m, C.ImageMut im, J.Pixel p) =>+	(C.PixelMut im -> p) -> im (PrimState m) -> m (J.Image p)+cairoMutToJuicy c i = uncurry J.withImage+	(fromIntegral *** fromIntegral $ C.imageMutSize i)+	\(fromIntegral -> x) (fromIntegral -> y) ->+		c . fromJust <$> C.getPixel i x y++cairoArgb32MutToJuicyRGBA8 :: PrimMonad m =>+	C.Argb32Mut (PrimState m) -> m (J.Image J.PixelRGBA8)+cairoArgb32MutToJuicyRGBA8 = cairoMutToJuicy pixelArgb32ToPixelRGBA8++cairoRgb24MutToJuicyRGB8 :: PrimMonad m =>+	C.Rgb24Mut (PrimState m) -> m (J.Image J.PixelRGB8)+cairoRgb24MutToJuicyRGB8 = cairoMutToJuicy pixelRgb24ToPixelRGB8++cairoA8MutToJuicyRGBA8 :: PrimMonad m => Word8 -> Word8 -> Word8 ->+	C.A8Mut (PrimState m) -> m (J.Image J.PixelRGBA8)+cairoA8MutToJuicyRGBA8 r g b = cairoMutToJuicy $ pixelA8ToPixelRGBA8 r g b++cairoA8MutToJuicyYA8 :: PrimMonad m =>+	Word8 -> C.A8Mut (PrimState m) -> m (J.Image J.PixelYA8)+cairoA8MutToJuicyYA8 = cairoMutToJuicy . pixelA8ToPixelYA8++cairoA1MutToJuicyRGBA8 :: PrimMonad m => Word8 -> Word8 -> Word8 ->+	C.A1Mut (PrimState m) -> m (J.Image J.PixelRGBA8)+cairoA1MutToJuicyRGBA8 r g b = cairoMutToJuicy $ pixelA1ToPixelRGBA8 r g b++cairoA1MutToJuicyYA8 :: PrimMonad m =>+	Word8 -> C.A1Mut (PrimState m) -> m (J.Image J.PixelYA8)+cairoA1MutToJuicyYA8 = cairoMutToJuicy . pixelA1ToPixelYA8++cairoRgb16_565MutToJuicyRGB8 :: PrimMonad m =>+	C.Rgb16_565Mut (PrimState m) -> m (J.Image J.PixelRGB8)+cairoRgb16_565MutToJuicyRGB8 = cairoMutToJuicy pixelRgb16_565ToPixelRGB8++cairoRgb30MutToJuicyRGB16 :: PrimMonad m =>+	C.Rgb30Mut (PrimState m) -> m (J.Image J.PixelRGB16)+cairoRgb30MutToJuicyRGB16 = cairoMutToJuicy pixelRgb30ToPixelRGB16++---------------------------------------------------------------------------+-- JUICY IMAGE => CAIRO MUTABLE IMAGE+---------------------------------------------------------------------------++juicyToCairoMut :: (PrimMonad m, J.Pixel p, C.ImageMut im) =>+	(p -> C.PixelMut im) -> J.Image p -> m (im (PrimState m))+juicyToCairoMut c i = C.newImageMut w' h' >>= \im ->+	im <$ for_ ys \(y, y') -> for_ xs \(x, x') ->+		C.putPixel im x' y' $ c (J.pixelAt i x y)+	where+	w = J.imageWidth i; h = J.imageHeight i+	w' = fromIntegral w; h' = fromIntegral h'+	xs = zip [0 .. w] [0 .. w']; ys = zip [0 .. h] [0 .. h']++juicyRGBA8ToCairoArgb32Mut :: PrimMonad m =>+	J.Image J.PixelRGBA8 -> m (C.Argb32Mut (PrimState m))+juicyRGBA8ToCairoArgb32Mut = juicyToCairoMut pixelRGBA8ToPixelArgb32++juicyRGB8ToCairoRgb24Mut :: PrimMonad m =>+	J.Image J.PixelRGB8 -> m (C.Rgb24Mut (PrimState m))+juicyRGB8ToCairoRgb24Mut = juicyToCairoMut pixelRGB8ToPixelRgb24++juicyRGBA8ToCairoA8Mut :: PrimMonad m =>+	J.Image J.PixelRGBA8 -> m (C.A8Mut (PrimState m))+juicyRGBA8ToCairoA8Mut = juicyToCairoMut pixelRGBA8ToPixelA8++juicyYA8ToCairoA8Mut :: PrimMonad m =>+	J.Image J.PixelYA8 -> m (C.A8Mut (PrimState m))+juicyYA8ToCairoA8Mut = juicyToCairoMut pixelYA8ToPixelA8++juicyRGBA8ToCairoA1Mut :: PrimMonad m =>+	Word8 -> J.Image J.PixelRGBA8 -> m (C.A1Mut (PrimState m))+juicyRGBA8ToCairoA1Mut = juicyToCairoMut . pixelRGBA8ToPixelA1++juicyYA8ToCairoA1Mut :: PrimMonad m =>+	Word8 -> J.Image J.PixelYA8 -> m (C.A1Mut (PrimState m))+juicyYA8ToCairoA1Mut = juicyToCairoMut . pixelYA8ToPixelA1++juicyRGB8ToCairoRgb16_565Mut :: PrimMonad m =>+	J.Image J.PixelRGB8 -> m (C.Rgb16_565Mut (PrimState m))+juicyRGB8ToCairoRgb16_565Mut = juicyToCairoMut pixelRGB8ToPixelRgb16_565++juicyRGB16ToCairoRgb30Mut :: PrimMonad m =>+	J.Image J.PixelRGB16 -> m (C.Rgb30Mut (PrimState m))+juicyRGB16ToCairoRgb30Mut = juicyToCairoMut pixelRGB16ToPixelRgb30++---------------------------------------------------------------------------+-- CAIRO PIXEL => JUICY PIXEL+---------------------------------------------------------------------------++pixelArgb32ToPixelRGBA8 :: C.PixelArgb32 -> J.PixelRGBA8+pixelArgb32ToPixelRGBA8 (C.PixelArgb32Straight a r g b) = J.PixelRGBA8 r g b a++pixelRgb24ToPixelRGB8 :: C.PixelRgb24 -> J.PixelRGB8+pixelRgb24ToPixelRGB8 (C.PixelRgb24 r g b) = J.PixelRGB8 r g b++pixelA8ToPixelRGBA8 :: Word8 -> Word8 -> Word8 -> C.PixelA8 -> J.PixelRGBA8+pixelA8ToPixelRGBA8 r g b (C.PixelA8 a) = J.PixelRGBA8 r g b a++pixelA8ToPixelYA8 :: Word8 -> C.PixelA8 -> J.PixelYA8+pixelA8ToPixelYA8 y (C.PixelA8 a) = J.PixelYA8 y a++pixelA1ToPixelRGBA8 :: Word8 -> Word8 -> Word8 -> C.PixelA1 -> J.PixelRGBA8+pixelA1ToPixelRGBA8 r g b (C.PixelA1 a) = J.PixelRGBA8 r g b $ C.bit 0x00 0xff a++pixelA1ToPixelYA8 :: Word8 -> C.PixelA1 -> J.PixelYA8+pixelA1ToPixelYA8 y (C.PixelA1 a) = J.PixelYA8 y $ C.bit 0x00 0xff a++pixelRgb16_565ToPixelRGB8 :: C.PixelRgb16_565 -> J.PixelRGB8+pixelRgb16_565ToPixelRGB8 (C.PixelRgb16_565 r g b) = J.PixelRGB8 r g b++pixelRgb30ToPixelRGB16 :: C.PixelRgb30 -> J.PixelRGB16+pixelRgb30ToPixelRGB16 (C.PixelRgb30 r g b) = J.PixelRGB16 r g b++---------------------------------------------------------------------------+-- JUICY PIXEL => CAIRO PIXEL+---------------------------------------------------------------------------++pixelRGBA8ToPixelArgb32 :: J.PixelRGBA8 -> C.PixelArgb32+pixelRGBA8ToPixelArgb32 (J.PixelRGBA8 r g b a) = C.PixelArgb32Straight a r g b++pixelRGB8ToPixelRgb24 :: J.PixelRGB8 -> C.PixelRgb24+pixelRGB8ToPixelRgb24 (J.PixelRGB8 r g b) = C.PixelRgb24 r g b++pixelRGBA8ToPixelA8 :: J.PixelRGBA8 -> C.PixelA8+pixelRGBA8ToPixelA8 (J.PixelRGBA8 _ _ _ a) = C.PixelA8 a++pixelYA8ToPixelA8 :: J.PixelYA8 -> C.PixelA8+pixelYA8ToPixelA8 (J.PixelYA8 _ a) = C.PixelA8 a++pixelRGBA8ToPixelA1 :: Word8 -> J.PixelRGBA8 -> C.PixelA1+pixelRGBA8ToPixelA1 t (J.PixelRGBA8 _ _ _ a) = C.PixelA1 . bool C.O C.I $ t <= a++pixelYA8ToPixelA1 :: Word8 -> J.PixelYA8 -> C.PixelA1+pixelYA8ToPixelA1 t (J.PixelYA8 _ a) = C.PixelA1 . bool C.O C.I $ t <= a++pixelRGB8ToPixelRgb16_565 :: J.PixelRGB8 -> C.PixelRgb16_565+pixelRGB8ToPixelRgb16_565 (J.PixelRGB8 r g b) = C.PixelRgb16_565 r g b++pixelRGB16ToPixelRgb30 :: J.PixelRGB16 -> C.PixelRgb30+pixelRGB16ToPixelRgb30 (J.PixelRGB16 r g b) = C.PixelRgb30 r g b

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"