module PictureLK (Picture, printPic, flipD, 
   lambda, blume, smilie, white, superimpose) where

type Picture = [[(Char,Int)]]

-- Bildschirmausgabe
printPic :: Picture -> IO ()
printPic pic = putStr (concat (map (++"\n") (map convert pic)))

-- Umwandlung Lauflängenkodierung in Zeichenkette
convert :: [(Char,Int)] -> String
convert []         = []
convert ((c,n):ls) = replicate n c ++ convert ls 

-- Beispielbilder
lambda, blume, smilie, white :: Picture
lambda = map llk lambdaalt
lambdaalt=["................",
        "..###...........",
        ".#..##..........",
        ".....##.........",
        "......##........",
        ".....####.......",
        "....###.##......",
        "...###...##.....",
        "..###.....##..#.",
        ".###.......###..",
        "................"
        ]

white = take 16 (repeat [('.',16)])

blume = map llk blumealt
blumealt=  ["................",
        ".......###......",
        "......#####.....",
        ".......###......",
        "....#...#.......",
        ".....##.#..#....",
        "......##.##.....",
        "......##........",
        ".....#..........",
        "....#...........",
        "................"]

smilie = map llk smiliealt
smiliealt=["................",
        "....########....",
        "...#........#...",
        "..#..#....#..#..",
        "..#..........#..",
        "..#..........#..",
        "..#..#....#..#..",
        "..#...####...#..",
        "...#........#...",
        "....########....",
        "................"]

-- Umwandlung von Zeichenketten in Lauflaengenkodierung
llk :: String -> [(Char,Int)]
llk "" = []
llk (c:cs) = makellk (c,1) cs 

makellk :: (Char,Int) -> String -> [(Char,Int)]
makellk (c,k) (x:xs) 
  | c == x    = makellk (c,k+1) xs
  | otherwise = (c,k):makellk (x,1) xs
makellk (c,k) [] = [(c,k)]



-- diagonales Spiegeln (Umweg über Zeichenketten) 
flipD :: Picture -> Picture
flipD = map llk . flipD1 . map convert

flipD1 :: [String] -> [String]
flipD1 []     = []
flipD1 ([]:_) = []
flipD1 pic    = (map head pic) : flipD1 (map mytail pic)
                where   mytail [] = []
                        mytail xs = tail xs

-- Übereinanderlegen zweier Bilder (gleichen Ausmasses)
-- hier Umweg über explizite Zeichenkettendarstellung
superimpose :: Picture  -> Picture  -> Picture
superimpose p1 p2 = map llk $ superimpose1 
                            (map convert p1) (map convert p2)

superimpose1 :: [String] -> [String] -> [String] 
superimpose1 = zipWith (zipWith blackOverWhite)
  where blackOverWhite '#' _ = '#'
        blackOverWhite '.' c = c

