module ImageTypes
where

-- ----------------------------------------

type Lightness  = Double

type Channel    = Int -> Int -> Lightness

data Geo
    = Geo { width  :: ! Int
          , height :: ! Int
          }
      deriving (Eq)

data Image
    = Image { geo :: ! Geo
            , img :: Channel
            }

-- ----------------------------------------

-- mothers little helper

on2             :: (a -> b) ->
                   (c -> d -> a) -> (c -> d -> b)
f `on2` c       = \ x y -> f (c x y)

merge           :: (a -> b -> c) ->
                   (x -> y -> a) ->
                   (x -> y -> b) ->
                   (x -> y -> c)

merge op f1 f2  = \ x y -> f1 x y `op` f2 x y

-- ----------------------------------------

-- predefined Lightness values

dark            :: Lightness
dark            = 0.0

light           :: Lightness
light           = 1.0

grey            :: Lightness
grey            = 0.5

lightOrDark     :: Lightness -> Lightness
lightOrDark c
    | c <= 0.5  = 0.0
    | otherwise = 1.0

gammaLight      :: Lightness -> Lightness -> Lightness
gammaLight g x  = x ** (1/g)

invertLight     :: Lightness -> Lightness
invertLight     = (1.0 -)

reduceLight     :: Int -> Lightness -> Lightness
reduceLight n c = fromIntegral c' / fromIntegral (n - 1)
                where
                c' :: Int
                c' = floor (fromIntegral n * c)

-- ----------------------------------------

-- predefined channel values and combinators

uniChan         :: Lightness -> Channel
uniChan         = const . const

darkChan        :: Channel
darkChan        = uniChan dark

lightChan       :: Channel
lightChan       = uniChan light

mergeChan       :: Lightness -> Channel -> Channel -> Channel
mergeChan a c1 c2
                = \ x y -> a * c1 x y + (1 - a) * c2 x y

addChan         :: Channel -> Channel -> Channel
addChan         = mergeChan grey

addChans        :: [Channel] -> Channel
addChans cs     = \ x y ->
                  sum (map (\ c -> c x y) cs)
                  / fromIntegral (length cs)

rectangleChan   :: Geo -> Channel
rectangleChan (Geo w h)
                = \ x y ->
                  if 0 <= x && x < w && 0 <= y && y < h
                  then light
                  else dark

-- ----------------------------------------
--
-- predefined geometry values anf functions

instance Show Geo where
    show (Geo w h) = show w ++ "x" ++ show h

mkGeo   :: Int -> Int -> Geo
mkGeo w h
    | w > 0 && h > 0    = Geo w h
    | otherwise         = error $ "illegal geometry " ++ show (Geo w h)

maxGeo                                  :: Geo -> Geo -> Geo
(Geo w1 h1) `maxGeo` (Geo w2 h2)        = Geo (w1 `max` w2) (h1 `max` h2)

minGeo                                  :: Geo -> Geo -> Geo
(Geo w1 h1) `minGeo` (Geo w2 h2)        = Geo (w1 `min` w2) (h1 `min` h2)

flipGeo                 :: Geo -> Geo
flipGeo (Geo w h)       = Geo h w

scaleGeo                :: Int -> Int -> Geo -> Geo
scaleGeo n m (Geo w h)  = mkGeo (n * w) (m * h)

shiftGeo                :: Int -> Int -> Geo -> Geo
shiftGeo n m (Geo w h)  = mkGeo (w + n) (h + m)

-- ----------------------------------------

mkBitmap        :: Geo -> (Int -> Int -> Bool) -> Image
mkBitmap g f    = Image g ((fromIntegral . fromEnum) `on2` f)


-- ----------------------------------------

invert          :: Image -> Image
invert  (Image g c)
                = Image g $ \ x y -> 1 - c x y

gamma           :: Lightness -> Image -> Image
gamma           = undefined

bitmap          :: Image -> Image
bitmap          = undefined

reduceColors    :: Int -> Image -> Image
reduceColors n  = transLight (reduceLight n)

transLight :: (Lightness -> Lightness) ->
              Image -> Image
transLight tf (Image g c)
                = Image g $ tf `on2` c

-- ----------------------------------------

flipV           :: Image -> Image
flipV (Image g@(Geo w _h) c)
                = Image g $ \ x y -> c (w - x - 1) y

flipH           :: Image -> Image
flipH (Image g i)
                = undefined

rot90           :: Image -> Image
rot90 (Image g i)
                = undefined

rot180          :: Image -> Image
rot180          = undefined

rot270          :: Image -> Image
rot270          = undefined

-- das Bild um n Spalten nach rechts rotieren und
-- um m Zeilen nach unten

shiftRot        :: Int -> Int -> Image -> Image
shiftRot n m (Image g i)
                = undefined

-- das Bild n mal in der Wagerechten und
-- m mal in der Senkrechten wiederhohlen
-- (kacheln)

tile            :: Int -> Int -> Image -> Image
tile n m (Image g i)
                = undefined

-- das gleiche wie tile, nur mit abwechselnd gespiegelten
-- Bildern, so dass keine sichtbaren Kanten an den Bildgrenzen
-- entstehen

tileMirr        :: Int -> Int -> Image -> Image
tileMirr n m (Image g i)
                = undefined

-- Groesse halbieren

halfSize        :: Image -> Image
halfSize (Image (Geo w h) i)
                = undefined

-- vergroessern um die Faktoren n un m

scale           :: Int -> Int -> Image -> Image
scale n m (Image g i)
                = undefined

-- Zwei Bilder kombinieren, z.B. addieren

merge2          :: (Lightness -> Lightness -> Lightness) ->
                   Image -> Image -> Image
merge2 op (Image g1 i1) (Image g2 i2)
                = undefined

-- ----------------------------------------