module Main where import Prelude as P import Graphics.Image import Graphics.Image.Interface as I import Graphics.Image.ColorSpace as C import Data.Bits import Data.Strings import Text.XML.HXT.DOM.Util import Data.List.Split segmentation = 8 seed = "49474354467B54686973546865536563726574466C61677D" main :: IO () main = do rawImage <- readImageRGB VU "./original_gimped.jpg" let (width, height) = dims rawImage let segmented = segment rawImage let xorred = xorColor segmented let newImage = segmentToImage xorred height ret <- writeImage "./output.jpg" newImage return ret segment :: Image VU RGB Double -> [[Pixel RGB Double]] segment image = reverse $ I.foldl (\(head:tail) -> \val -> if length head < segmentation then (val:head):tail else [val]:(reverse head):tail ) [[]] image xorColor :: [[Pixel RGB Double]] -> [[Pixel RGB Double]] xorColor segments = P.map (\pixels -> P.zipWith doXorring [0..] pixels) segments doXorring :: Int -> Pixel RGB Double -> Pixel RGB Double doXorring index pixel@(PixelRGB red green blue) = let step = index * 6 seedPartRed = hexStringToInt $ strDrop(step) $ strTake(step + 2) seed seedPartGreen = hexStringToInt $ strDrop(step + 2) $ strTake(step + 4) seed seedPartBlue = hexStringToInt $ strDrop(step + 4) $ strTake(step + 4) seed redHex = round $ red * 255 :: Int greenHex = round $ green * 255 :: Int blueHex = round $ blue * 255 :: Int xorRed = (fromIntegral (redHex `xor` seedPartRed)) / 255 xorGreen = (fromIntegral (greenHex `xor` seedPartGreen)) / 255 xorBlue = (fromIntegral (blueHex `xor` seedPartBlue)) / 255 in PixelRGB xorRed xorGreen xorBlue segmentToImage :: [[Pixel RGB Double]] -> Int -> Image VU RGB Double segmentToImage segments width = fromLists (chunksOf width (concat segments))