diff options
| author | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-20 21:32:49 +0000 |
|---|---|---|
| committer | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-20 21:32:49 +0000 |
| commit | c46ce73d69be5e9b5c5c393031b9034ec9aa0c6e (patch) | |
| tree | 9f2e9d2efb73dad970f5a24b99ed556c8e977de3 | |
| parent | cbb92d2859d8f0fc577ded630a05eacc257876dd (diff) | |
| download | median-cut-c46ce73d69be5e9b5c5c393031b9034ec9aa0c6e.tar.gz median-cut-c46ce73d69be5e9b5c5c393031b9034ec9aa0c6e.zip | |
Fix length bug
| -rw-r--r-- | data/final.ppm | bin | 0 -> 1572880 bytes | |||
| -rw-r--r-- | src/Main.hs | 29 |
2 files changed, 20 insertions, 9 deletions
diff --git a/data/final.ppm b/data/final.ppm Binary files differnew file mode 100644 index 0000000..56d7fe7 --- /dev/null +++ b/data/final.ppm diff --git a/src/Main.hs b/src/Main.hs index 94d2d9a..12fb064 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,8 +1,9 @@ module Main where -import qualified Data.ByteString as B -import Data.List (transpose) -import qualified Data.Text as T +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Data.List (transpose) +import qualified Data.Text as T import PFM data Direction = Horizontal | Vertical @@ -46,16 +47,22 @@ findSplitLine d | otherwise = Cut Vertical . findSplitLine' $ transpose d drawCut' :: PFMColour -> Cut -> (Int, Int) -> PFMColour -> PFMColour -drawCut' c (Cut Vertical n) (x, _) c' - | x == n || x == n - 1 = c +drawCut' c (Cut Vertical n) (_, x) c' + | x == n = c | otherwise = c' -drawCut' c (Cut Horizontal n) (_, y) c' - | y == n || y == n - 1 = c +drawCut' c (Cut Horizontal n) (y, _) c' + | y == n = c | otherwise = c' drawCut :: PFMColour -> Cut -> [[PFMColour]] -> [[PFMColour]] drawCut c cut colour = - + (zipWith . zipWith) (drawCut' c cut) [ [ (y, x) | x <- [0..length $ head colour] ] | y <- [0..length colour] ] colour + +applyGamma :: Float -> PFMImage -> PFMImage +applyGamma g (PFMImage w h c) = + PFMImage w h $ fmap gc <$> c + where + gc (PFMColour r gr b) = PFMColour (gamma g r) (gamma g gr) (gamma g b) main :: IO () main = do @@ -63,4 +70,8 @@ main = do let grace = revColour $ parse im let height = pfmHeight grace - 1 let fixedIntensities = zipWith (cfmap $ fixIntensity height) [0..] $ pfmColour grace - print . findSplitLine $ fixedIntensities + let cut = findSplitLine fixedIntensities + let newColour = drawCut (PFMColour 0 1 0) cut $ pfmColour grace + print $ length newColour + print cut + BL.writeFile "data/final.ppm" . encodePPM . clampImage . applyGamma 2.2 $ PFMImage (pfmWidth grace) (pfmHeight grace) newColour |