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