minimung-0.1: Data/Image.hs

{-# LANGUAGE ExistentialQuantification #-}

-- |
-- Module     : Data.Image
-- Maintainer : Yakov Zaytsev <yakov@yakov.cc>
-- Stability  : experimental
--
-- Functional image
--
-- To-Do:
--
-- * ???
-- > type ImageT = Image a -> Image b
--

module Data.Image (
                         Image
                       , ColorC
                       , GrayImage
                       , RGB(..)

                       , (.|)
                       , (*|)

                       , (.-)
                       , (.^)

                       , crop

                       , threshold

                       -- * Geometry
                       , intervalAt

                       -- * Misc
                       , square
                       , inW
                       ) where

import Foreign.Ptr
import Foreign.Storable
import qualified Graphics.UI.GLUT as G (Size(..))
import Data.Word

import Data.Geometry

-- |
-- Image with pixels represented as values of type a.
--
-- To-Do
--
-- *
--
-- > instance Num Image a where
--
-- Or make individual operators (-), (+) etc.
--
-- See also 'RGB'.
--
type Image a = Point -> a
-- XXX
-- data Image a = Image (Point -> a)
--              | Image a `Over` Image


-- | Color index.
type ColorC = Word32

type GrayImage = Image ColorC

class RGB c where
    toRGB :: c -> (ColorC, ColorC, ColorC)

-- class Yuv c where
--     getY :: c -> ColorC

intervalAt :: Int -> Int -> [Int]
intervalAt y windowH = [y - windowH `div` 2 .. y + windowH `div` 2]


type Window = Size

inW :: Point -> Window -> Bool
inW (x, y) (w, h) = x >= 0 && x < w && y >= 0 && y < h

square x = x * x

-- |
(*|) :: (Storable a) => Image a -> (Ptr a, G.Size) -> IO ()
f *| (ptr, G.Size w' h') = do
  sequence_ $ map pokeP ps
      where
          w = fromIntegral w'   -- View pattern
          h = fromIntegral h'
          ps = points $ Rectangle (0, 0) (w - 1, h - 1)   -- [(x, y) | y <- [0 .. h - 1], x <- [0 .. w - 1]]
          pokeP p@(x, y) = let idx = (y * w + x) in pokeElemOff ptr idx $ f p

-- -- |
-- -- Example:
-- --
-- -- > let g = toGray frame
-- -- > withArray (g .| frameSize) -> \gg -> displayPixels frameSize (PixelData Luminance UnsignedByte gg) 
-- --
-- (*|) :: Image a -> Size -> [a]
-- f *| (w, h) = f .| ps
--     where
--         ps = [(x, y) | y <- [0 .. h - 1], x <- [0 .. w - 1]]


-- |
-- ???
(.|) :: Image a -> [Point] -> [a]
f .| ps = map f ps


threshold :: (Ord a, Num a) => a -> Image a -> Image a
threshold t f (x, y)
    | ff < t = 0
    | otherwise = ff
    where
        ff = f (x, y)
-- threshold :: ColorC -> GrayImage -> GrayImage
-- threshold t f (x, y)
--     | ff < t = 0
--     | otherwise = ff
--     where
--         ff = f (x, y)

crop' :: a -> Image a -> Region -> Image a
crop' ff f (Rectangle orig window)
            = g
            where
                g p
                    | p `inW` window = f $ translate orig p
                    | otherwise = ff

crop :: forall a . (Num a) => Image a -> Region -> Image a
crop = crop' 0

(.-) :: (Num a) => Image a -> Image a -> Image a
f .- g = h
   where
       h p = f p - g p

(.^) :: (Num a) => Image a -> Int -> Image a
f .^ 2 = g
       where
           g p = (f p) * (f p)  -- ???