Adjust webResourceGetFrameName.

Adjust webResourceGetFrameName.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
--  Module      :  Graphics.UI.Gtk.WebKit.WebResource
--  Author      :  Andy Stewart
--  Copyright   :  (c) 2010 Andy Stewart <lazycat.manatee@gmail.com>
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Note:
--
-- Function `webkit_web_resource_get_data` haven't binding
-- no idea how to handle `GString`.
--
-- Access to the WebKit Web Resource
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebResource (
-- * Description
-- | A web resource encapsulates the data of the download as well as the URI, MIME type and frame name of
-- the resource.

-- * Types
  WebResource,
  WebResourceClass,

-- * Constructors
  webResourceNew,

-- * Methods
  webResourceGetEncoding,
  webResourceGetFrameName,
  webResourceGetMimeType,
  webResourceGetUri,
) where

import Control.Monad		(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import Graphics.UI.Gtk.Gdk.Events

{#import Graphics.UI.Gtk.Abstract.Object#}	(makeNewObject)
{#import Graphics.UI.Gtk.WebKit.Types#}
{#import System.Glib.GObject#}

{#context lib="webkit" prefix ="webkit"#}

-- | Returns a new WebKitWebResource.
-- The @encoding@ can be empty.
-- The @frameName@ can be used if the resource represents contents of an
-- entire HTML frame, otherwise pass empty.
webResourceNew :: String -> Int -> String -> String -> String -> String -> IO WebResource
webResourceNew resData size uri mimeType encoding frameName =
   withCString resData $ \dataPtr ->
   withCString uri $ \uriPtr ->
   withCString mimeType $ \mimePtr ->
   withCString encoding $ \encodingPtr ->
   withCString frameName $ \framePtr ->
   wrapNewGObject mkWebResource $
     {#call web_resource_new#} dataPtr (fromIntegral size) uriPtr mimePtr encodingPtr framePtr

-- | Get encoding.
webResourceGetEncoding ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetEncoding wr =
  {#call web_resource_get_encoding#} (toWebResource wr) >>= maybePeek peekCString

-- | Get frame name.
webResourceGetFrameName ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetFrameName wr =
  {#call web_resource_get_frame_name#} (toWebResource wr) >>= maybePeek peekCString

-- | Get mime type.
webResourceGetMimeType ::
   WebResourceClass self => self
 -> IO String
webResourceGetMimeType wr =
  {#call web_resource_get_mime_type#} (toWebResource wr) >>= peekCString

-- | Get uri.
webResourceGetUri ::
   WebResourceClass self => self
 -> IO String
webResourceGetUri wr =
  {#call web_resource_get_uri#} (toWebResource wr) >>= peekCString

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
-----------------------------------------------------------------------------
--  Module      :  Graphics.UI.Gtk.WebKit.WebResource
--  Author      :  Andy Stewart
--  Copyright   :  (c) 2010 Andy Stewart <lazycat.manatee@gmail.com>
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Note:
--
-- Function `webkit_web_resource_get_data` haven't binding
-- no idea how to handle `GString`.
--
-- Access to the WebKit Web Resource
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.WebKit.WebResource (
-- * Description
-- | A web resource encapsulates the data of the download as well as the URI, MIME type and frame name of
-- the resource.

-- * Types
  WebResource,
  WebResourceClass,

-- * Constructors
  webResourceNew,

-- * Methods
  webResourceGetEncoding,
  webResourceGetFrameName,
  webResourceGetMimeType,
  webResourceGetUri,
) where

import Control.Monad		(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.GError
import Graphics.UI.Gtk.Gdk.Events

{#import Graphics.UI.Gtk.Abstract.Object#}	(makeNewObject)
{#import Graphics.UI.Gtk.WebKit.Types#}
{#import System.Glib.GObject#}

{#context lib="webkit" prefix ="webkit"#}

-- | Returns a new WebKitWebResource.
-- The @encoding@ can be empty.
-- The @frameName@ can be used if the resource represents contents of an
-- entire HTML frame, otherwise pass empty.
webResourceNew :: String -> Int -> String -> String -> String -> String -> IO WebResource
webResourceNew resData size uri mimeType encoding frameName =
   withCString resData $ \dataPtr ->
   withCString uri $ \uriPtr ->
   withCString mimeType $ \mimePtr ->
   withCString encoding $ \encodingPtr ->
   withCString frameName $ \framePtr ->
   wrapNewGObject mkWebResource $
     {#call web_resource_new#} dataPtr (fromIntegral size) uriPtr mimePtr encodingPtr framePtr

-- | Get encoding.
webResourceGetEncoding ::
   WebResourceClass self => self
 -> IO (Maybe String)
webResourceGetEncoding wr =
  {#call web_resource_get_encoding#} (toWebResource wr) >>= maybePeek peekCString

-- | Get frame name.
webResourceGetFrameName ::
   WebResourceClass self => self
 -> IO String
webResourceGetFrameName wr =
  {#call web_resource_get_frame_name#} (toWebResource wr) >>= peekCString

-- | Get mime type.
webResourceGetMimeType ::
   WebResourceClass self => self
 -> IO String
webResourceGetMimeType wr =
  {#call web_resource_get_mime_type#} (toWebResource wr) >>= peekCString

-- | Get uri.
webResourceGetUri ::
   WebResourceClass self => self
 -> IO String
webResourceGetUri wr =
  {#call web_resource_get_uri#} (toWebResource wr) >>= peekCString


openRepoObjDb && discover

openRepoObjDb && discover

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}

#include "git2.h"

module Git2 where

import Data.Primitive
import Foreign
import Foreign.C.String
import Foreign.C.Types

type OffT    = {#type git_off_t#}
type TimeT   = {#type git_time_t#}
type Ptr2Int = Ptr () -> IO CInt

newtype ObjDB      = ObjDB { unODB :: Ptr () }
newtype Repository = Repository { unRepository :: Ptr () }
newtype Index      = Index { unIndex :: Ptr () }

{#enum git_otype as OType {underscoreToCase}#}
{#enum git_rtype as RType {underscoreToCase}#}
{#enum git_repository_pathid as RepositoryPathID {underscoreToCase}#}
{#enum git_error as GitError {underscoreToCase}#}
{#enum git_odb_streammode as ODBStreamMode {underscoreToCase}#}

deriving instance Show GitError

repoIs :: Ptr2Int -> Repository -> IO Bool
repoIs ffi (Repository ptr) = return . toBool =<< ffi ptr

openRepo :: String -> IO (Either GitError Repository)
openRepo path = alloca $ \pprepo -> do
  pstr <- newCString path
  res  <- {#call git_repository_open#} pprepo pstr
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

openRepoObjDir :: String -> String -> String -> String -> IO (Either GitError Repository)
openRepoObjDir dir objDir idxFile workTree = alloca $ \pprepo -> do
  dirStr     <- newCString dir
  objDirStr  <- newCString objDir
  idxFileStr <- newCString idxFile
  wtreeStr   <- newCString workTree
  res  <- {#call git_repository_open2#} pprepo dirStr objDirStr idxFileStr wtreeStr
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

openRepoObjDb :: String -> ObjDB -> String -> String -> IO (Either GitError Repository)
openRepoObjDb dir (ObjDB db) idxFile workTree = alloca $ \pprepo -> do
  dirStr     <- newCString dir
  idxFileStr <- newCString idxFile
  wtreeStr   <- newCString workTree
  res  <- {#call git_repository_open3#} pprepo dirStr db idxFileStr wtreeStr
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

-- TODO: size? GIT_EXTERN(int) git_repository_discover(char *repository_path, size_t size, const char *start_path, int across_fs, const char *ceiling_dirs);
discover :: String -> Bool -> String -> IO (Either GitError String)
discover startPath acrossFs ceilingDirs = alloca $ \path -> do
  spStr  <- newCString startPath
  cdsStr <- newCString ceilingDirs
  res <-{#call git_repository_discover#} path undefined spStr (fromBool acrossFs) cdsStr
  if res == 0
    then undefined
    else return . Left . toEnum . fromIntegral $ res

database :: Repository -> IO ObjDB
database (Repository r) = return . ObjDB =<< {#call git_repository_database#} r

index :: Repository -> IO (Either GitError Index)
index (Repository r) = alloca $ \idx -> do
  res  <- {#call git_repository_index#} idx r
  if res == 0
    then fmap (Right . Index) $ peek idx
    else return . Left . toEnum . fromIntegral $ res

free :: Repository -> IO ()
free (Repository r) = {#call git_repository_free#} r

-- TODO: Refactor some bits
init :: String -> Bool -> IO (Either GitError Repository)
init path isBare = alloca $ \pprepo -> do
  pstr <- newCString path
  res  <- {#call git_repository_init#} pprepo pstr (fromBool isBare)
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

isHeadDetached :: Repository -> IO Bool
isHeadDetached = repoIs {#call git_repository_head_detached#}

isHeadOrphan :: Repository -> IO Bool
isHeadOrphan = repoIs {#call git_repository_head_orphan#}

isEmpty :: Repository -> IO Bool
isEmpty = repoIs {#call git_repository_is_empty#}

path :: Repository -> RepositoryPathID -> IO String
path (Repository r) pathID = peekCString =<< {#call git_repository_path#} r p
  where p = fromIntegral $ fromEnum pathID

isBare :: Repository -> IO Bool
isBare = repoIs {#call git_repository_is_bare#}

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}

#include "git2.h"

module Git2 where

import Data.Primitive
import Foreign
import Foreign.C.String
import Foreign.C.Types

type OffT    = {#type git_off_t#}
type TimeT   = {#type git_time_t#}
type Ptr2Int = Ptr () -> IO CInt

newtype ObjDB      = ObjDB { unODB :: Ptr () }
newtype Repository = Repository { unRepository :: Ptr () }
newtype Index      = Index { unIndex :: Ptr () }

{#enum git_otype as OType {underscoreToCase}#}
{#enum git_rtype as RType {underscoreToCase}#}
{#enum git_repository_pathid as RepositoryPathID {underscoreToCase}#}
{#enum git_error as GitError {underscoreToCase}#}
{#enum git_odb_streammode as ODBStreamMode {underscoreToCase}#}

deriving instance Show GitError

repoIs :: Ptr2Int -> Repository -> IO Bool
repoIs ffi (Repository ptr) = return . toBool =<< ffi ptr

openRepo :: String -> IO (Either GitError Repository)
openRepo path = alloca $ \pprepo -> do
  pstr <- newCString path
  res  <- {#call git_repository_open#} pprepo pstr
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

openRepoObjDir :: String -> String -> String -> String -> IO (Either GitError Repository)
openRepoObjDir dir objDir idxFile workTree = alloca $ \pprepo -> do
  dirStr     <- newCString dir
  objDirStr  <- newCString objDir
  idxFileStr <- newCString idxFile
  wtreeStr   <- newCString workTree
  res  <- {#call git_repository_open2#} pprepo dirStr objDirStr idxFileStr wtreeStr
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

openRepoObjDb :: String -> ObjDB -> String -> String -> IO (Either GitError Repository)
openRepoObjDb dir db idxFile workTree = undefined -- git_repository_open3

-- TODO: size? GIT_EXTERN(int) git_repository_discover(char *repository_path, size_t size, const char *start_path, int across_fs, const char *ceiling_dirs);
discover :: String -> Bool -> String -> IO (Either GitError String)
discover startPath acrossFs ceilingDirs = undefined -- git_repository_discover

database :: Repository -> IO ObjDB
database (Repository r) = return . ObjDB =<< {#call git_repository_database#} r

index :: Repository -> IO (Either GitError Index)
index (Repository r) = alloca $ \idx -> do
  res  <- {#call git_repository_index#} idx r
  if res == 0
    then fmap (Right . Index) $ peek idx
    else return . Left . toEnum . fromIntegral $ res

free :: Repository -> IO ()
free (Repository r) = {#call git_repository_free#} r

-- TODO: Refactor some bits
init :: String -> Bool -> IO (Either GitError Repository)
init path isBare = alloca $ \pprepo -> do
  pstr <- newCString path
  res  <- {#call git_repository_init#} pprepo pstr (fromBool isBare)
  if res == 0
    then fmap (Right . Repository) $ peek pprepo
    else return . Left . toEnum . fromIntegral $ res

isHeadDetached :: Repository -> IO Bool
isHeadDetached = repoIs {#call git_repository_head_detached#}

isHeadOrphan :: Repository -> IO Bool
isHeadOrphan = repoIs {#call git_repository_head_orphan#}

isEmpty :: Repository -> IO Bool
isEmpty = repoIs {#call git_repository_is_empty#}

path :: Repository -> RepositoryPathID -> IO String
path (Repository r) pathID = peekCString =<< {#call git_repository_path#} r p
  where p = fromIntegral $ fromEnum pathID

isBare :: Repository -> IO Bool
isBare = repoIs {#call git_repository_is_bare#}


Removed need for -XDatatypeContexts at Histogram.hs.

{-#LANGUAGE ForeignFunctionInterface#-}
#include "cvWrapLEO.h"
module CV.Histogram where

import CV.Image
{#import CV.Image#}

import Data.List
import Data.Array
import Data.Array.ST
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr
import CV.Bindings.Types
import qualified CV.Bindings.ImgProc as I
import System.IO.Unsafe
import Utils.Pointer

-- import Utils.List

newtype HistogramData a = HGD [(a,a)]

-- | Given a set of images, such as the color channels of color image, and
--   a histogram with corresponding number of channels, replace the pixels of
--   the image with the likelihoods from the histogram
backProjectHistogram :: [Image GrayScale D8] -> I.Histogram -> Image GrayScale D8
backProjectHistogram images@(img:_) (I.Histogram hist) = unsafePerformIO $ do
    r <- cloneImage img
    withImage r $ \c_r ->
     withPtrList (map imageFPTR images) $ \ptrs ->
      withForeignPtr hist $ \c_hist ->
        I.c'cvCalcArrBackProject (castPtr ptrs) (castPtr c_r) c_hist
    return r
backProjectHistogram _ _ = error "Empty list of images"

-- | Calculate an opencv histogram object from set of images, each with it's
-- own number of bins.
histogram :: [(Image GrayScale D8, Int)] -> Bool -> Maybe (Image GrayScale D8)
               -> I.Histogram

histogram imageBins accumulate mask  = unsafePerformIO $
 I.creatingHistogram $ do
        hist <-  I.emptyUniformHistogramND ds
        withPtrList (map imageFPTR images) $ \ptrs ->
         case mask of
            Just m -> do
                withImage m $ \c_mask -> do
                I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (castPtr c_mask)
                return hist
            Nothing -> do
                I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (nullPtr)
                return hist
   where
    (images,ds) = unzip imageBins
    c_accumulate = 0

-- getHistogramBin (I.Histogram hs) n = unsafePerformIO $ withForeignPtr hs (\h -> I.c'cvGetHistValue_1D (castPtr h) n)

---- Assume [0,1] distribution and calculate skewness
--skewness bins image = do
--                 hg <- buildHistogram cbins image
--                 bins <-  mapM (getBin hg) [0..cbins-1]
--                 let avg = sum bins / (fromIntegral.length) bins
--                 let u3 = sum.map (\(value,bin) ->
--                                     (value-avg)*(value-avg)*(value-avg)
--                                     *bin) $
--                            zip binValues bins
--                 let u2 = sum.map (\(value,bin) ->
--                                     (value-avg)*(value-avg)
--                                     *bin) $
--                            zip binValues bins
----
--                 return (u3 / (sqrt u2*sqrt u2*sqrt u2))
--                where
--                 cbins :: CInt
--                 cbins = fromIntegral bins
--                 binValues = [0,fstep..1]
--                 fstep = 1/(fromIntegral bins)

values (HGD a) = snd.unzip $ a

-- This does not make any sense!
cmpUnion a b = sum $ zipWith (max) a b

cmpIntersect a b = sum $ zipWith min a b

cmpEuclidian a b = sum $ (zipWith (\x y -> (x-y)^2) a b)
cmpAbs a b = sum $ (zipWith (\x y -> abs (x-y)) a b)

chiSqrHG  a b = chiSqr (values a) (values b)
chiSqr a b = sum $ zipWith (calc) a b
    where
     calc a b = (a-b)*(a-b) `divide` (a+b)
     divide a b | abs(b) > 0.000001 = a/b
                | otherwise = 0

liftBins op (HGD a) = zip (op bins) values
            where (bins,values) = unzip a

liftValues op (HGD a) = zip bins (op values)
            where (bins,values) = unzip a

sub (HGD a) (HGD b) | bins a == bins b
                    = HGD $ zip (bins a) values
                where
                 bins a = map fst a
                 msnd = map snd
                 values = zipWith (-) (msnd a) (msnd b)

noBins (HGD a) = length a

getPositivePart (HGD a) = HGD $ dropWhile ((<0).fst) a
tcumulate [] = []
tcumulate values = tail $ scanl (+) 0 values

--getCumulativeNormalHistogram binCount image
--    = HGD $ zip bins $ tcumulate values
--    where
--        HGD lst = getNormalHistogram binCount image
--        bins :: [Double]
--        values :: [Double]
--        (bins,values) = unzip lst

weightedHistogram img weights start end binCount = unsafePerformIO $
    withImage img $ \i ->
     withImage weights $ \w -> do
      bins <- mallocArray (fromIntegral binCount)
      {#call get_weighted_histogram#} i w (realToFrac start)
                                          (realToFrac end)
                                          (fromIntegral binCount) bins
      r <- peekArray binCount bins >>= return.map realToFrac
      free bins
      return r

-- TODO: Add binary images
simpleGetHistogram :: Image GrayScale D32 -> Maybe (Image GrayScale D8)
                       -> D32 -> D32 -> Int -> Bool -> [D32]
simpleGetHistogram img mask start end binCount cumulative = unsafePerformIO $
    withImage img $ \i -> do
      bins <- mallocArray binCount
      let isCum | cumulative == True  = 1
                | cumulative == False = 0

      case mask of
        (Just msk) -> do
                   withImage msk $ \m -> do
                    {#call get_histogram#} i m (realToFrac start) (realToFrac end)
                                               isCum (fromIntegral binCount) bins
        Nothing  -> {#call get_histogram#} i (nullPtr)
                                             (realToFrac start) (realToFrac end)
                                             isCum (fromIntegral binCount) bins

      r <- peekArray binCount bins >>= return.map realToFrac
      free bins
      return r

--getNormalHistogram bins image = HGD new
--    where
--        (HGD lst) = getHistogram bins image
----
----        value :: [Double]
--        bin   :: [Double]
--        (bin,value) = unzip lst
--        new = zip bin $ map (/size) value
--        size = fromIntegral $ uncurry (*) $ getSize image

--getHistogram :: Int -> Image GrayScale D32 -> HistogramData Double
--getHistogram bins image = unsafePerformIO $ do
--                            h <- buildHistogram cbins image
--                            values <- mapM (getBin h)
--                                        [0..fromIntegral bins-1]
--                            return.HGD $
--                                zip [-1,-1+2/(realToFrac bins)..1] values
--                        where
--                         cbins = fromIntegral bins

{-#LANGUAGE ForeignFunctionInterface#-}
#include "cvWrapLEO.h"
module CV.Histogram where

import CV.Image
{#import CV.Image#}

import Data.List
import Data.Array
import Data.Array.ST
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr
import CV.Bindings.Types
import qualified CV.Bindings.ImgProc as I
import System.IO.Unsafe
import Utils.Pointer

-- import Utils.List

newtype (Num a) => HistogramData a = HGD [(a,a)]

-- | Given a set of images, such as the color channels of color image, and
--   a histogram with corresponding number of channels, replace the pixels of
--   the image with the likelihoods from the histogram
backProjectHistogram :: [Image GrayScale D8] -> I.Histogram -> Image GrayScale D8
backProjectHistogram images@(img:_) (I.Histogram hist) = unsafePerformIO $ do
    r <- cloneImage img
    withImage r $ \c_r ->
     withPtrList (map imageFPTR images) $ \ptrs ->
      withForeignPtr hist $ \c_hist ->
        I.c'cvCalcArrBackProject (castPtr ptrs) (castPtr c_r) c_hist
    return r
backProjectHistogram _ _ = error "Empty list of images"

-- | Calculate an opencv histogram object from set of images, each with it's
-- own number of bins.
histogram :: [(Image GrayScale D8, Int)] -> Bool -> Maybe (Image GrayScale D8)
               -> I.Histogram

histogram imageBins accumulate mask  = unsafePerformIO $
 I.creatingHistogram $ do
        hist <-  I.emptyUniformHistogramND ds
        withPtrList (map imageFPTR images) $ \ptrs ->
         case mask of
            Just m -> do
                withImage m $ \c_mask -> do
                I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (castPtr c_mask)
                return hist
            Nothing -> do
                I.c'cvCalcArrHist (castPtr ptrs) hist c_accumulate (nullPtr)
                return hist
   where
    (images,ds) = unzip imageBins
    c_accumulate = 0

-- getHistogramBin (I.Histogram hs) n = unsafePerformIO $ withForeignPtr hs (\h -> I.c'cvGetHistValue_1D (castPtr h) n)

---- Assume [0,1] distribution and calculate skewness
--skewness bins image = do
--                 hg <- buildHistogram cbins image
--                 bins <-  mapM (getBin hg) [0..cbins-1]
--                 let avg = sum bins / (fromIntegral.length) bins
--                 let u3 = sum.map (\(value,bin) ->
--                                     (value-avg)*(value-avg)*(value-avg)
--                                     *bin) $
--                            zip binValues bins
--                 let u2 = sum.map (\(value,bin) ->
--                                     (value-avg)*(value-avg)
--                                     *bin) $
--                            zip binValues bins
----
--                 return (u3 / (sqrt u2*sqrt u2*sqrt u2))
--                where
--                 cbins :: CInt
--                 cbins = fromIntegral bins
--                 binValues = [0,fstep..1]
--                 fstep = 1/(fromIntegral bins)

values (HGD a) = snd.unzip $ a

-- This does not make any sense!
cmpUnion a b = sum $ zipWith (max) a b

cmpIntersect a b = sum $ zipWith min a b

cmpEuclidian a b = sum $ (zipWith (\x y -> (x-y)^2) a b)
cmpAbs a b = sum $ (zipWith (\x y -> abs (x-y)) a b)

chiSqrHG  a b = chiSqr (values a) (values b)
chiSqr a b = sum $ zipWith (calc) a b
    where
     calc a b = (a-b)*(a-b) `divide` (a+b)
     divide a b | abs(b) > 0.000001 = a/b
                | otherwise = 0

liftBins op (HGD a) = zip (op bins) values
            where (bins,values) = unzip a

liftValues op (HGD a) = zip bins (op values)
            where (bins,values) = unzip a

sub (HGD a) (HGD b) | bins a == bins b
                    = HGD $ zip (bins a) values
                where
                 bins a = map fst a
                 msnd = map snd
                 values = zipWith (-) (msnd a) (msnd b)

noBins (HGD a) = length a

getPositivePart (HGD a) = HGD $ dropWhile ((<0).fst) a
tcumulate [] = []
tcumulate values = tail $ scanl (+) 0 values

--getCumulativeNormalHistogram binCount image
--    = HGD $ zip bins $ tcumulate values
--    where
--        HGD lst = getNormalHistogram binCount image
--        bins :: [Double]
--        values :: [Double]
--        (bins,values) = unzip lst

weightedHistogram img weights start end binCount = unsafePerformIO $
    withImage img $ \i ->
     withImage weights $ \w -> do
      bins <- mallocArray (fromIntegral binCount)
      {#call get_weighted_histogram#} i w (realToFrac start)
                                          (realToFrac end)
                                          (fromIntegral binCount) bins
      r <- peekArray binCount bins >>= return.map realToFrac
      free bins
      return r

-- TODO: Add binary images
simpleGetHistogram :: Image GrayScale D32 -> Maybe (Image GrayScale D8)
                       -> D32 -> D32 -> Int -> Bool -> [D32]
simpleGetHistogram img mask start end binCount cumulative = unsafePerformIO $
    withImage img $ \i -> do
      bins <- mallocArray binCount
      let isCum | cumulative == True  = 1
                | cumulative == False = 0

      case mask of
        (Just msk) -> do
                   withImage msk $ \m -> do
                    {#call get_histogram#} i m (realToFrac start) (realToFrac end)
                                               isCum (fromIntegral binCount) bins
        Nothing  -> {#call get_histogram#} i (nullPtr)
                                             (realToFrac start) (realToFrac end)
                                             isCum (fromIntegral binCount) bins

      r <- peekArray binCount bins >>= return.map realToFrac
      free bins
      return r

--getNormalHistogram bins image = HGD new
--    where
--        (HGD lst) = getHistogram bins image
----
----        value :: [Double]
--        bin   :: [Double]
--        (bin,value) = unzip lst
--        new = zip bin $ map (/size) value
--        size = fromIntegral $ uncurry (*) $ getSize image

--getHistogram :: Int -> Image GrayScale D32 -> HistogramData Double
--getHistogram bins image = unsafePerformIO $ do
--                            h <- buildHistogram cbins image
--                            values <- mapM (getBin h)
--                                        [0..fromIntegral bins-1]
--                            return.HGD $
--                                zip [-1,-1+2/(realToFrac bins)..1] values
--                        where
--                         cbins = fromIntegral bins