50 lines
1.9 KiB
Haskell
50 lines
1.9 KiB
Haskell
|
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))
|