packages feed

AC-EasyRaster-GTK (empty) → 1.1.1

raw patch · 5 files changed

+376/−0 lines, 5 filesdep +arraydep +basedep +gtksetup-changed

Dependencies added: array, base, gtk

Files

+ AC-EasyRaster-GTK.cabal view
@@ -0,0 +1,27 @@+Cabal-Version: >= 1.6
+Name:          AC-EasyRaster-GTK
+Version:       1.1.1
+Stability:     Experimental
+Synopsis:      GTK+ pixel plotting.
+
+Description:
+
+  This package is a thin layer over Gtk2hs providing an easy
+  interface for people who want to do bitmapped graphics.
+  Cairo already provides easy access to /vector/ graphics;
+  this package is directed at /bitmap/ graphics (i.e.,
+  reading and writing individual pixels). This is useful for
+  applications such as fractal generators, ray tracers, etc.
+
+Category:      Graphics
+License:       BSD3
+License-file:  Licence.txt
+Author:        Andrew Coppin
+Maintainer:    Andrew Coppin <MathematicalOrchid@hotmail.com>
+Build-Type:    Simple
+Tested-With:   GHC == 6.10.3
+
+Library
+  Exposed-modules: Graphics.EasyRaster.GTK, Graphics.EasyRaster.GTK.Paranoid
+  Build-Depends:   base >= 4 && < 5, array >= 0.2.0.0 && < 0.3, gtk >= 0.10 && < 0.11
+  HS-Source-Dirs:  .
+ Graphics/EasyRaster/GTK.hs view
@@ -0,0 +1,274 @@+{- |
+  This module provides pixel-oriented graphics operations.
+  It defines an 'ImageBuffer' type, which is a thin layer
+  over a GTK+ 'Pixbuf'. It then provides functions for
+  doing pixel-oriented graphics on this without having to
+  do a lot of bit-twiddling math by hand. It also
+  provides for quickly and easily loading and saving
+  images, and displaying them on the screen.
+
+  In the simplest case, you can import this module alone
+  and never need to touch the actual GTK modules;
+  however, this module provides access to the underlying
+  GTK resources as well, in case you want to use it as
+  part of a larger GTK program.
+-}
+
+module Graphics.EasyRaster.GTK
+    (
+      init_system,
+      process_event, wait_event, main_loop,
+      Coord, Channel,
+      ImageFileType (..), type_string,
+      ImageBuffer (),
+      ib_new, ib_load, ib_save, ib_display, ib_canvas,
+      ib_size, ib_coords, ib_coords2, ib_valid_coords,
+      ib_write_pixel, ib_read_pixel,
+      ib_pixbuf
+    )
+  where
+
+import Data.Word
+import Data.Array.IO
+import Data.Array.Base (unsafeWrite, unsafeRead)
+import Graphics.UI.Gtk
+
+{- |
+  Initialise the GTK runtime system. This function /must/
+  be called before any other functions in this module.
+  (If not, your program will likely summarily crash with
+  an obscure error to 'stderr'.)
+
+  Note that Gtk2hs by default will crash with a warning
+  message if the program is compiled with the threaded
+  RTS; this module disables that warning. However, be
+  warned: You must /only/ call the GTK-based functions
+  from thread 0.
+-}
+init_system :: IO ()
+init_system = unsafeInitGUIForThreadedRTS >> return ()
+
+{- |
+  Process one GTK event if there are any waiting, otherwise
+  do nothing.
+-}
+process_event :: IO ()
+process_event = mainIterationDo False >> return ()
+
+{- |
+  Process one GTK event. Wait for an event to arrive if
+  necessary.
+-}
+wait_event :: IO ()
+wait_event = mainIterationDo True >> return ()
+
+{- |
+  Run the GTK \"main loop\" until GTK's 'mainQuit'
+  function is called. (Note that this means that
+  thread 0 can do no other work while the main
+  loop is running.)
+-}
+main_loop :: IO ()
+main_loop = mainGUI
+
+-- | The type of pixel coordinates.
+type Coord   = Int
+
+-- | The type of pixel channels.
+type Channel = Word8
+
+{- |
+  An @ImageBuffer@ is a space-efficient grid of 24-bit
+  RGB pixels (i.e., 8 bits per channel) that the GTK
+  library can also access. (The latter gives us the
+  ability to load/save/display the graphics, rather
+  than just manipulate it in memory.)
+-}
+data ImageBuffer = ImageBuffer
+  {
+    pixbuf :: Pixbuf,
+    sizeX, sizeY :: Coord,
+    rowstride :: Coord,
+    raw :: PixbufData Coord Channel
+  }
+
+{- |
+  Used to indicate image file type.
+-}
+data ImageFileType =
+    IFT_PNG | -- ^ PNG image.
+    IFT_JPEG  -- ^ JPEG image.
+  deriving (Eq, Enum, Bounded, Read, Show)
+
+{- |
+  Convert an 'ImageFileType' to a plain string (all
+  lower-case).
+-}
+type_string :: ImageFileType -> String
+type_string IFT_PNG  = "png"
+type_string IFT_JPEG = "jpeg"
+
+{- |
+  Make a new 'ImageBuffer' of the specified size. Valid
+  coordinates will be in the range (0,0) to (x-1, y-1),
+  with (0,0) being the top-left corner of the image.
+-}
+ib_new :: (Int,Int) -> IO ImageBuffer
+ib_new (x,y) = do
+  core <- pixbufNew ColorspaceRgb False 8 x y
+  build core
+
+{- |
+  Load a graphics file into a newly created 'ImageBuffer'.
+  The file type is determined automatically (any type that
+  GTK+ supports), as is the size for the 'ImageBuffer'.
+  (This can be queried later.)
+-}
+ib_load :: FilePath -> IO ImageBuffer
+ib_load f = do
+  core <- pixbufNewFromFile f
+  build core
+
+{- |
+  Save an 'ImageBuffer' into a file with the specified
+  file type. Note that the filename should include an
+  appropriate suffix (e.g., @.png@). The type of file is
+  determined by the 'ImageFileType' argument, /not/ by
+  the filename.
+-}
+ib_save :: ImageBuffer -> ImageFileType -> FilePath -> IO ()
+ib_save buf t f = do
+  pixbufSave (pixbuf buf) f (type_string t) []
+  return ()
+
+{- |
+  Returns a GTK+ canvas object which displays the graphcs
+  in the 'ImageBuffer' and will automatically repaint
+  itself in response of damage.
+-}
+ib_canvas :: ImageBuffer -> IO DrawingArea
+ib_canvas ib = do
+    canvas <- drawingAreaNew
+    canvas `onExposeRect` (redraw canvas)
+    return canvas
+  where
+    redraw canvas _ = do
+      dc <- widgetGetDrawWindow canvas
+      gc <- gcNew dc
+      drawPixbuf dc gc (pixbuf ib) 0 0 0 0 (-1) (-1) RgbDitherNone 0 0
+      return ()
+
+{- |
+  This is a quick shortcut for displaying an image
+  on screen. Given an 'ImageBuffer' and a window
+  title, this will display the image in a new window.
+  Clicking the window's close button will call GTK's
+  'mainQuit' function. For example,
+
+  @
+    ib_display buf "My Window Title"
+    main_loop
+  @
+
+  will display @buf@ on screen and halt the program
+  (or at least thread 0) until the user clicks the
+  close button. Crude, but useful for quick testing.
+-}
+ib_display :: ImageBuffer -> String -> IO ()
+ib_display ib title = do
+  window <- windowNew
+  windowSetTitle window title
+  windowSetDefaultSize window (sizeX ib) (sizeY ib)
+  canvas <- ib_canvas ib
+  containerAdd window canvas
+  window `onDestroy` mainQuit
+  widgetShowAll window
+
+build :: Pixbuf -> IO ImageBuffer
+build core = do
+  sx <- pixbufGetWidth     core
+  sy <- pixbufGetHeight    core
+  s  <- pixbufGetRowstride core
+  r  <- pixbufGetPixels    core
+  return $ ImageBuffer
+    {
+      pixbuf = core,
+      sizeX = sx,
+      sizeY = sy,
+      rowstride = s,
+      raw = r
+    }
+
+{- |
+  Return the underlying GTK 'Pixbuf' used by an 'ImageBuffer'.
+  (In case you want to do something to it with GTK.)
+-}
+ib_pixbuf :: ImageBuffer -> Pixbuf
+ib_pixbuf = pixbuf
+
+{- |
+  Query the size of an 'ImageBuffer'. This returns the width
+  and height in pixels. Valid coordinates for this @ImageBuffer@
+  are from (0,0) to (x-1, y-1), where (x,y) is the value returned
+  from @ib_size@.
+-}
+ib_size :: ImageBuffer -> (Coord,Coord)
+ib_size buf = (sizeX buf, sizeY buf)
+
+{- |
+  Determine whether the specified pixel coordinates are valid
+  for this 'ImageBuffer' (i.e., check they're not off the
+  edge of the image).
+-}
+ib_valid_coords :: ImageBuffer -> (Coord,Coord) -> Bool
+ib_valid_coords buf (x,y) = x < sizeX buf && y < sizeY buf
+
+{- |
+  Return a list containing all valid coordinates for this 'ImageBuffer'.
+  Useful when you want to process all pixels in the image; now you
+  can just use 'mapM' or whatever.
+-}
+ib_coords :: ImageBuffer -> [(Coord,Coord)]
+ib_coords buf = [ (x,y) | y <- [0 .. (sizeY buf) - 1], x <- [0 .. (sizeX buf) - 1] ]
+
+{- |
+  Return all valid coordinates as a list of lists instead of a single
+  flat list. (In case you need to do something at the end of each row.)
+-}
+ib_coords2 :: ImageBuffer -> [[(Coord,Coord)]]
+ib_coords2 buf = [ [ (x,y) | x <- [0 .. (sizeX buf) - 1] ] | y <- [0 .. (sizeY buf) - 1] ]
+
+{- |
+  Overwrite the specified pixel with the specified colour (R, G, B).
+
+  Note that pixel coordinates are /not/ checked, for efficiency reasons.
+  However, supplying invalid pixel coordinates may result in behaviour ranging
+  from corrupted graphical output to random program crashes. See
+  "Graphics.EasyRaster.GTK.Paranoid" for a version of this function with
+  bounds checking turned on.
+-}
+ib_write_pixel :: ImageBuffer -> (Coord,Coord) -> (Channel,Channel,Channel) -> IO ()
+ib_write_pixel buf (x,y) (r,g,b) = do
+  -- Caution: No range checks!!
+  let p = y * rowstride buf + x * 3
+  unsafeWrite (raw buf) (p + 0) r
+  unsafeWrite (raw buf) (p + 1) g
+  unsafeWrite (raw buf) (p + 2) b
+
+{- |
+  Read the current (R, G, B) colour valid of the specified pixel.
+
+  Note that pixel coordinates are /not/ checked, for efficiency reasons.
+  However, supplying invalid pixel coordinates will at best result in
+  gibberish being returned, and at works a segmentation fault. See
+  "Graphics.EasyRaster.Paranoid" for a version of this function with
+  bounds checking turned on.
+-}
+ib_read_pixel :: ImageBuffer -> (Coord,Coord) -> IO (Channel,Channel,Channel)
+ib_read_pixel buf (x,y) = do
+  -- Cation: No range checks!!
+  let p = y * rowstride buf + x * 3
+  r <- unsafeRead (raw buf) (p + 0)
+  g <- unsafeRead (raw buf) (p + 1)
+  b <- unsafeRead (raw buf) (p + 2)
+  return (r,g,b)
+ Graphics/EasyRaster/GTK/Paranoid.hs view
@@ -0,0 +1,62 @@+{- |
+  This module provides exactly the same interface as
+  "Graphics.EasyRaster.GTK", but with more runtime sanity
+  checks. Typically you will use this module while
+  developing and debugging your application, and them
+  change your import statement when you're happy that
+  any bugs have been corrected.
+-}
+
+module Graphics.EasyRaster.GTK.Paranoid
+    (
+      init_system,
+      ER.process_event, ER.wait_event, ER.main_loop,
+      ER.Coord, ER.Channel,
+      ER.ImageFileType (..), ER.type_string,
+      ER.ImageBuffer (),
+      ER.ib_new, ER.ib_load, ER.ib_save, ER.ib_display, ER.ib_canvas,
+      ER.ib_size, ER.ib_coords, ER.ib_coords2, ER.ib_valid_coords,
+      ib_write_pixel, ib_read_pixel,
+      ER.ib_pixbuf
+    )
+  where
+
+import Control.Monad (when)
+import Graphics.UI.Gtk
+import qualified Graphics.EasyRaster.GTK as ER
+
+{- |
+  Initialise the GTK runtime system. This function /must/
+  be called before any other functions in this module.
+  (If not, your program will likely summarily crash with
+  an obscure error to 'stderr'.)
+
+  Note that Gtk2hs will crash with a warning message if
+  the program is compiled with the threaded RTS. (Use
+  the non-paranoid version of @init_system@ to turn this
+  warning off.)
+-}
+init_system :: IO ()
+init_system = initGUI >> return ()
+
+{- |
+  Overwrite the specified pixel with the (R, G, B) colour.
+
+  If the pixel coordinates are out of range, the 'error'
+  function is called.
+-}
+ib_write_pixel :: ER.ImageBuffer -> (ER.Coord, ER.Coord) -> (ER.Channel, ER.Channel, ER.Channel) -> IO ()
+ib_write_pixel buf (x,y) (r,g,b) = do
+  when (not $ ER.ib_valid_coords buf (x,y)) $ error "ib_write_pixel: invalid coordinates."
+  ER.ib_write_pixel buf (x,y) (r,g,b)
+
+{- |
+  Read the (R, G, B) colour of the specified pixel.
+
+  If the pixel coordinates are out of range, the 'error'
+  function is called.
+-}
+ib_read_pixel :: ER.ImageBuffer -> (ER.Coord, ER.Coord) -> IO (ER.Channel, ER.Channel, ER.Channel)
+ib_read_pixel buf (x,y) = do
+  when (not $ ER.ib_valid_coords buf (x,y)) $ error "ib_write_pixel: invalid coordinates."
+  ER.ib_read_pixel buf (x,y)
+ Licence.txt view
@@ -0,0 +1,10 @@+Copyright (c) 2009, Andrew Coppin
+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 Andrew Coppin nor the names of the 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 HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple
+
+main = defaultMain