diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for sdl2-cairo-image + +## 0.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2015 Yun-Yan Chi + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +# sdl2-cairo-image + +An image loading and rendering library for sdl2 / sdl2-cairo + +## Installation + +This module can easily install via **Cabal**. + +``` bash +> cabal update +> cabal install sdl2-cairo-image +``` + +## Usage + +### Loading image + +Assume one import this module as + +``` haskell +import qualified SDL.Cairo.Image as I +``` + +One can load an image within an `IO a`. +For example, + +``` haskell +main = do + img <- I.loadRGBA8 PNG "wherever/your/image/is/img.png" +``` + +If this file is loaded correctly then `img` will be a `Image PixelRGBA8`. +If failed, `img` will be a default 5x5 image (i.e. `I.defImageRGBA8`). + +### Displaying image + +Please read [here](https://hackage.haskell.org/package/sdl2-cairo-image/docs/SDL-Cairo-Image-Render.html)! diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/sdl2-cairo-image.cabal b/sdl2-cairo-image.cabal new file mode 100644 --- /dev/null +++ b/sdl2-cairo-image.cabal @@ -0,0 +1,46 @@ +Name: sdl2-cairo-image +Synopsis: An image loading and rendering library for sdl2 / sdl2-cairo +Description: An image loading and rendering library for sdl2 / sdl2-cairo +Version: 1.0 +Author: Yun-Yan Chi +Maintainer: Yun-Yan Chi +License: MIT +License-File: LICENSE +Cabal-Version: >= 1.10 +category: Graphics +Build-Type: Simple +Extra-Source-Files: README.md, ChangeLog.md + +source-repository head + type: git + location: https://github.com/jaiyalas/sdl2-cairo-image +-- +library + Default-Language: Haskell2010 + HS-Source-Dirs: src + GHC-Options: -Wall + Exposed-Modules: SDL.Cairo.Image + SDL.Cairo.Image.Load + SDL.Cairo.Image.Render + Build-Depends: base >= 4 && < 5 + , vector >= 0.11 + , linear >= 1.19 + , JuicyPixels >= 3.2 + , sdl2 >= 2.0 + , sdl2-cairo >= 0.1 + , cairo >= 0.13 + , convertible >= 1.1 +-- +executable main + default-language: Haskell2010 + hs-source-dirs: src + main-is: Main.hs + ghc-options: -w -threaded + Build-Depends: base >= 4 && < 5 + , vector >= 0.11 + , linear >= 1.19 + , JuicyPixels >= 3.2 + , sdl2 >= 2.0 + , sdl2-cairo >= 0.1 + , cairo >= 0.13 + , convertible >= 1.1 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified SDL +import SDL.Cairo (createCairoTexture) +import SDL.Cairo.Canvas +-- +import Linear.V2 (V2(..)) +-- +import Data.Maybe (catMaybes) +import Control.Concurrent (threadDelay) +import Control.Monad (unless,void,mapM) +import Control.Monad.Fix (fix) +-- +import qualified SDL.Cairo.Image as I +-- +main :: IO () +main = do + -- + SDL.initialize [SDL.InitEverything] + window <- SDL.createWindow "Hello!" winConfig + renderer <- SDL.createRenderer window (-1) rdrConfig + texture <- createCairoTexture renderer (V2 640 480) + -- + -- img1 <- L.loadPNGRGBA "/Users/jaiyalas/img/xd.png" + -- img2 <- L.loadPNGRGBA "/Users/jaiyalas/img/char.png" + img3 <- I.loadRGBA8 I.PNG "./img/newton.png" + img4 <- I.loadRGB8 I.PNG "./img/newton.png" + -- + fix $ \loop -> do + threadDelay 100000 + withCanvas texture $ do + background $ gray 102 + I.renderImgCanvas (V2 10 50) img3 + I.renderImgCanvas (V2 10 200) img4 + -- R.drawImg texture (V2 50 120) img3 + -- R.drawImgC texture (V2 50 220) img3 + SDL.copy renderer texture Nothing Nothing + SDL.present renderer + qb <- quitPredicate + unless qb loop +-- +-- ################################ +-- +quitPredicate :: IO Bool +quitPredicate = do + events <- SDL.pollEvents + return $ elem SDL.KeycodeEscape $ events2Kcodes events +-- +events2Kcodes :: [SDL.Event] -> [SDL.Keycode] +events2Kcodes = catMaybes . map event2Kcode +-- +event2Kcode :: SDL.Event -> Maybe SDL.Keycode +event2Kcode e = case SDL.eventPayload e of + SDL.KeyboardEvent edata -> if isPressed edata + then return $ getKeycode edata + else Nothing + otherwise -> Nothing +-- +isPressed :: SDL.KeyboardEventData -> Bool +isPressed edata = SDL.keyboardEventKeyMotion edata == SDL.Pressed +-- +getKeycode :: SDL.KeyboardEventData -> SDL.Keycode +getKeycode = SDL.keysymKeycode . SDL.keyboardEventKeysym +-- +-- ################################## +-- +winConfig = SDL.defaultWindow + { SDL.windowPosition = SDL.Centered + , SDL.windowInitialSize = V2 640 480 + } + +rdrConfig = SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = True + } diff --git a/src/SDL/Cairo/Image.hs b/src/SDL/Cairo/Image.hs new file mode 100644 --- /dev/null +++ b/src/SDL/Cairo/Image.hs @@ -0,0 +1,16 @@ +{-| +Module : SDL.Cairo.Image +Copyright : Copyright (c) 2015 Yun-Yan Chi +License : MIT +Maintainer : jaiyalas@gmail.com + +This module is provided as a convenience to import the most +important parts of the API all at once. +-} +module SDL.Cairo.Image + ( module SDL.Cairo.Image.Render + , module SDL.Cairo.Image.Load + ) where + +import SDL.Cairo.Image.Render +import SDL.Cairo.Image.Load diff --git a/src/SDL/Cairo/Image/Load.hs b/src/SDL/Cairo/Image/Load.hs new file mode 100644 --- /dev/null +++ b/src/SDL/Cairo/Image/Load.hs @@ -0,0 +1,191 @@ + +-------------------------------------------------------------------- +{-| +Module : SDL.Cairo.Image.Loader +Copyright : Copyright (c) 2015 Yun-Yan Chi +License : MIT +Maintainer : jaiyalas@gmail.com + +This module exposes wrapper functions to load image files into memory +by using JuicyPixel (See ). + +So far, supported file formats are only PNG, JPG, BMP. +Plus, merely four pixel formats +'PixelRGB8', 'PixelRGB16', 'PixelRGBA8' and 'PixelRGBA16' +are supported. +-} +-------------------------------------------------------------------- +module SDL.Cairo.Image.Load + ( + -- * loading 'Image' + loadRGB8 + , loadRGB16 + , loadRGBA8 + , loadRGBA16 + -- * loadable format + , ImgType (..) + -- * Default 5x5 'Image' + , defImageRGB8 + , defImageRGB16 + , defImageRGBA8 + , defImageRGBA16 + ) where +-- +import Codec.Picture +import qualified Data.Vector.Storable as VecS (fromList) +-- + +-- | +data ImgType = PNG | JPG | BMP deriving (Show,Eq) + +loadRGB8 :: ImgType -> FilePath -> IO (Image PixelRGB8) +loadRGB8 PNG fp = do + ei <- readPng fp + case ei of + Right (ImageRGB8 img) -> do + return img + _ -> do + return defImageRGB8 +-- +loadRGB8 JPG fp = do + ei <- readJpeg fp + case ei of + Right (ImageRGB8 img) -> do + return img + _ -> do + return defImageRGB8 +-- +loadRGB8 BMP fp = do + ei <- readBitmap fp + case ei of + Right (ImageRGB8 img) -> do + return img + _ -> do + return defImageRGB8 +-- +loadRGB16 :: ImgType -> FilePath -> IO (Image PixelRGB16) +loadRGB16 PNG fp = do + ei <- readPng fp + case ei of + Right (ImageRGB16 img) -> do + return img + _ -> do + return defImageRGB16 +-- +loadRGB16 JPG fp = do + ei <- readJpeg fp + case ei of + Right (ImageRGB16 img) -> do + return img + _ -> do + return defImageRGB16 +-- +loadRGB16 BMP fp = do + ei <- readBitmap fp + case ei of + Right (ImageRGB16 img) -> do + return img + _ -> do + return defImageRGB16 +-- +loadRGBA8 :: ImgType -> FilePath -> IO (Image PixelRGBA8) +loadRGBA8 PNG fp = do + ei <- readPng fp + case ei of + Right (ImageRGBA8 img) -> do + return img + _ -> do + return defImageRGBA8 +-- +loadRGBA8 JPG fp = do + ei <- readJpeg fp + case ei of + Right (ImageRGBA8 img) -> do + return img + _ -> do + return defImageRGBA8 +-- +loadRGBA8 BMP fp = do + ei <- readBitmap fp + case ei of + Right (ImageRGBA8 img) -> do + return img + _ -> do + return defImageRGBA8 +-- +loadRGBA16 :: ImgType -> FilePath -> IO (Image PixelRGBA16) +loadRGBA16 PNG fp = do + ei <- readPng fp + case ei of + Right (ImageRGBA16 img) -> do + return img + _ -> do + return defImageRGBA16 +-- +loadRGBA16 JPG fp = do + ei <- readJpeg fp + case ei of + Right (ImageRGBA16 img) -> do + return img + _ -> do + return defImageRGBA16 +-- +loadRGBA16 BMP fp = do + ei <- readBitmap fp + case ei of + Right (ImageRGBA16 img) -> do + return img + _ -> do + return defImageRGBA16 +-- +defImageRGB8 :: Image PixelRGB8 +defImageRGB8 = Image + { imageWidth = 5 + , imageHeight = 5 + , imageData = VecS.fromList + [ 255,0,0, 0,0,0, 0,0,0, 0,0,0, 255,0,0 + , 0,0,0, 255,0,0, 0,0,0, 255,0,0, 0,0,0 + , 0,0,0, 0,0,0, 255,0,0, 0,0,0, 0,0,0 + , 0,0,0, 255,0,0, 0,0,0, 255,0,0, 0,0,0 + , 255,0,0, 0,0,0, 0,0,0, 0,0,0, 255,0,0 + ] + } +-- +defImageRGB16 :: Image PixelRGB16 +defImageRGB16 = Image + { imageWidth = 5 + , imageHeight = 5 + , imageData = VecS.fromList + [ 255,0,0, 0,0,0, 0,0,0, 0,0,0, 255,0,0 + , 0,0,0, 255,0,0, 0,0,0, 255,0,0, 0,0,0 + , 0,0,0, 0,0,0, 255,0,0, 0,0,0, 0,0,0 + , 0,0,0, 255,0,0, 0,0,0, 255,0,0, 0,0,0 + , 255,0,0, 0,0,0, 0,0,0, 0,0,0, 255,0,0 + ] + } +-- +defImageRGBA8 :: Image PixelRGBA8 +defImageRGBA8 = Image + { imageWidth = 5 + , imageHeight = 5 + , imageData = VecS.fromList + [ 255,0,0,255, 0,0,0,255, 0,0,0,255, 0,0,0,255, 255,0,0,255 + , 0,0,0,255, 255,0,0,255, 0,0,0,255, 255,0,0,255, 0,0,0,255 + , 0,0,0,255, 0,0,0,255, 255,0,0,255, 0,0,0,255, 0,0,0,255 + , 0,0,0,255, 255,0,0,255, 0,0,0,255, 255,0,0,255, 0,0,0,255 + , 255,0,0,255, 0,0,0,255, 0,0,0,255, 0,0,0,255, 255,0,0,255 + ] + } +-- +defImageRGBA16 :: Image PixelRGBA16 +defImageRGBA16 = Image + { imageWidth = 5 + , imageHeight = 5 + , imageData = VecS.fromList + [ 255,0,0,255, 0,0,0,255, 0,0,0,255, 0,0,0,255, 255,0,0,255 + , 0,0,0,255, 255,0,0,255, 0,0,0,255, 255,0,0,255, 0,0,0,255 + , 0,0,0,255, 0,0,0,255, 255,0,0,255, 0,0,0,255, 0,0,0,255 + , 0,0,0,255, 255,0,0,255, 0,0,0,255, 255,0,0,255, 0,0,0,255 + , 255,0,0,255, 0,0,0,255, 0,0,0,255, 0,0,0,255, 255,0,0,255 + ] + } diff --git a/src/SDL/Cairo/Image/Render.hs b/src/SDL/Cairo/Image/Render.hs new file mode 100644 --- /dev/null +++ b/src/SDL/Cairo/Image/Render.hs @@ -0,0 +1,225 @@ +{-| +Module : SDL.Cairo.Image.Renderer +Copyright : Copyright (c) 2015 Yun-Yan Chi +License : MIT +Maintainer : jaiyalas@gmail.com + +This module provides functions for directly/indirectly +rendering a JuicyPixel's 'Image' onto a sdl2's 'Texture'. + +This module is actually implemented with both of 'Render' and 'Canvas', +therefore it provides functions in both way. +In fact, There are three simple ways to use this module. +Assume we alread have following code, + +>import SDL +>import Linear.V2 (V2(..)) +>import SDL.Cairo +>import SDL.Cairo.Canvas +>import SDL.Cairo.Image.Renderer +>import Codec.Picture +> +>main :: IO () +>main = do +> initialize [InitEverything] +> window <- createWindow "SDL2 Cairo Canvas" defaultWindow +> renderer <- createRenderer window (-1) defaultRenderer +> texture <- createCairoTexture' renderer window +> withCanvas texture $ do +> background $ gray 102 +> -- location A +> +> Right (ImageRGB8 img) <- readPng "pic.png" +> -- location B +> +> copy renderer texture Nothing Nothing +> present renderer +> delay 5000 + +[using @renderImgCanvas@] + + The first way to draw image is replacing + + > -- location A + + by + + >renderImgCanvas (V2 50 50) img + +[using @drawImg@ or @drawImgC@] + + The other ways are replacing + + > -- location B + + by + + >drawImg texture (V2 50 50) img + + or + + >drawImgC texture (V2 50 50) img + + +-} +module SDL.Cairo.Image.Render + ( + -- * draw 'Image' in 'IO' () + drawImg + , drawImgC + -- * draw 'Image' in 'Canvas' () + , renderImgCanvas + -- * draw 'Image' in 'Render' () + , renderImgCairo + , renderOnTexture + -- * Type class + , RenderablePixel (drawPx) + , RenderablePixelC (renderPx) + ) where +-- +import Control.Monad (void) +-- +import qualified Data.Convertible as CVT +-- +import Linear.V2 (V2(..)) +import Linear.V4 (V4(..)) +import SDL (Texture) +import SDL.Cairo.Canvas + ( withCanvas, renderCairo + , Dim (..), Canvas + , rect, noStroke, fill, rgb) +-- +import qualified Graphics.Rendering.Cairo as Cairo +import Codec.Picture + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +-- | draw a __JuicyPixel__ 'Image' on the given __SDL__ 'Texture' +-- (at the specified coordinate). +drawImg :: RenderablePixel a => + Texture -- ^ a 'Texture' + -> V2 Int -- ^ a 'V2' coordinate of the top left corner + -> Image a -- ^ an 'Image' + -> IO () +drawImg st v2 img = withCanvas st $ renderImgCanvas v2 img + +-- | draw a __JuicyPixel__ 'Image' on the given __SDL__ 'Texture' +-- (at the specified coordinate). +-- Using Cairo's 'Render' underneath. +drawImgC :: RenderablePixelC a => + Texture -- ^ a 'Texture' + -> V2 Int -- ^ a 'V2' coordinate of the top left corner + -> Image a -- ^ an 'Image' + -> IO () +drawImgC st v2 img = renderOnTexture st $ renderImgCairo v2 img + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +-- | render an __JuicyPixel__ 'Image' through __Cairo__ 'Canvas' +renderImgCanvas :: RenderablePixel a => + V2 Int -- ^ a 'V2' coordinate of the top left corner + -> Image a -- ^ an 'Image' + -> Canvas () -- ^ a 'Canvas' action +renderImgCanvas (V2 _x _y) img@(Image _w _h _) = do + let ps = [(V2 (_x+offx) (_y+ offy) + ,pixelAt img offx offy) + | offx <- [0..(_w-1)], offy <- [0..(_h-1)]] + void $ mapM drawPx ps + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +-- | perform a 'Render' action on the given 'Texture' +renderOnTexture :: Texture -- ^ target 'Texture' + -> Cairo.Render () -- ^ a 'Render' action + -> IO () +renderOnTexture st = withCanvas st . renderCairo + +-- | render an 'Image' through __Cairo__ 'Render' +renderImgCairo :: RenderablePixelC a => + V2 Int -- ^ a 'V2' coordinate of the top left corner + -> Image a -- ^ a JuicyPixel 'Image' + -> Cairo.Render () -- ^ an Cairo 'Render' action +renderImgCairo (V2 _x _y) img@(Image _w _h _) = do + let ps = [(V2 (_x+offx) (_y+ offy) + ,pixelAt img offx offy) + | offx <- [0..(_w-1)], offy <- [0..(_h-1)]] + void $ mapM renderPx ps + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +-- | A pixel structure is 'RenderablePixel' if +-- how to draw on 'Canvas' is defined. +class Pixel px => RenderablePixel px where + drawPx :: (V2 Int, px) -- ^ (coordinate, pixel) + -> Canvas () +-- +instance RenderablePixel PixelRGB8 where + drawPx (V2 _x _y, PixelRGB8 _r _g _b) = do + fill $ rgb _r _g _b + noStroke + rect $ D (fromIntegral _x) (fromIntegral _y) 1 1 +-- +instance RenderablePixel PixelRGB16 where + drawPx (V2 _x _y, PixelRGB16 _r _g _b) = do + fill $ rgb (CVT.convert _r) (CVT.convert _g) (CVT.convert _b) + noStroke + rect $ D (fromIntegral _x) (fromIntegral _y) 1 1 +-- +instance RenderablePixel PixelRGBA8 where + drawPx (V2 _x _y, PixelRGBA8 _r _g _b _a) = do + fill $ V4 _r _g _b _a + noStroke + rect $ D (fromIntegral _x) (fromIntegral _y) 1 1 +-- +instance RenderablePixel PixelRGBA16 where + drawPx (V2 _x _y, PixelRGBA16 _r _g _b _a) = do + fill $ V4 (CVT.convert _r) (CVT.convert _g) (CVT.convert _b) (CVT.convert _a) + noStroke + rect $ D (fromIntegral _x) (fromIntegral _y) 1 1 + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +-- | A pixel structure is 'RenderablePixelC' if +-- how to render on 'Render' can be provided. +class Pixel px => RenderablePixelC px where + renderPx :: (V2 Int, px) -- ^ (coordinate, pixel) + -> Cairo.Render () +-- +instance RenderablePixelC PixelRGB8 where + renderPx (V2 _x _y, PixelRGB8 _r _g _b) = do + Cairo.rectangle (fromIntegral _x) (fromIntegral _y) 1 1 + Cairo.setSourceRGB + ((/255) $ fromIntegral _r) + ((/255) $ fromIntegral _g) + ((/255) $ fromIntegral _b) + Cairo.fill +-- +instance RenderablePixelC PixelRGB16 where + renderPx (V2 _x _y, PixelRGB16 _r _g _b) = do + Cairo.rectangle (fromIntegral _x) (fromIntegral _y) 1 1 + Cairo.setSourceRGB + ((/255) $ fromIntegral _r) + ((/255) $ fromIntegral _g) + ((/255) $ fromIntegral _b) + Cairo.fill +-- +instance RenderablePixelC PixelRGBA8 where + renderPx (V2 _x _y, PixelRGBA8 _r _g _b _a) = do + Cairo.rectangle (fromIntegral _x) (fromIntegral _y) 1 1 + Cairo.setSourceRGBA + ((/255) $ fromIntegral _r) + ((/255) $ fromIntegral _g) + ((/255) $ fromIntegral _b) + ((/255) $ fromIntegral _a) + Cairo.fill +-- +instance RenderablePixelC PixelRGBA16 where + renderPx (V2 _x _y, PixelRGBA16 _r _g _b _a) = do + Cairo.rectangle (fromIntegral _x) (fromIntegral _y) 1 1 + Cairo.setSourceRGBA + ((/255) $ fromIntegral _r) + ((/255) $ fromIntegral _g) + ((/255) $ fromIntegral _b) + ((/255) $ fromIntegral _a) + Cairo.fill +--