aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorYann Herklotz Grave <git@yannherklotzgrave.com>2019-02-20 21:34:19 +0000
committerYann Herklotz Grave <git@yannherklotzgrave.com>2019-02-20 21:34:19 +0000
commitc5fb9042efa93c5f8dfc9440d9ed407370daafa0 (patch)
treeab424c6f7bc89bb30eb071d9b54921017fa37a33
parentc46ce73d69be5e9b5c5c393031b9034ec9aa0c6e (diff)
downloadmedian-cut-c5fb9042efa93c5f8dfc9440d9ed407370daafa0.tar.gz
median-cut-c5fb9042efa93c5f8dfc9440d9ed407370daafa0.zip
Style with Brittany
-rw-r--r--Setup.hs2
-rw-r--r--src/Main.hs54
2 files changed, 26 insertions, 30 deletions
diff --git a/Setup.hs b/Setup.hs
index 9a994af..4467109 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,2 @@
-import Distribution.Simple
+import Distribution.Simple
main = defaultMain
diff --git a/src/Main.hs b/src/Main.hs
index 12fb064..6f8de0f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,27 +13,23 @@ data Cut = Cut Direction Int
deriving (Show, Eq)
clamp :: PFMColour -> PPMColour
-clamp (PFMColour ri gi bi) =
- PPMColour (f ri) (f gi) (f bi)
+clamp (PFMColour ri gi bi) = PPMColour (f ri) (f gi) (f bi)
where
v s = s * 255.0
f s = if v s > 255.0 then 255 else fromInteger (floor (v s))
clamp _ = undefined
clampImage :: PFMImage -> PPMImage
-clampImage (PFMImage w h c) =
- PPMImage w h $ fmap clamp <$> c
+clampImage (PFMImage w h c) = PPMImage w h $ fmap clamp <$> c
fixIntensity :: Int -> Int -> PFMColour -> Double
fixIntensity sizeY y (PFMColour r g b) =
sin (fromIntegral y / fromIntegral sizeY * pi) * (f r + f g + f b) / 3
- where
- f = realToFrac
+ where f = realToFrac
fixIntensity _ _ _ = error "Mono not supported"
findSplit :: [Double] -> Int
-findSplit d =
- (+1) . floor . (/sum d) . sum $ zipWith (*) [0..] d
+findSplit d = (+ 1) . floor . (/ sum d) . sum $ zipWith (*) [0 ..] d
cfmap :: Functor f => (t -> a -> b) -> t -> f a -> f b
cfmap f a b = f a <$> b
@@ -42,36 +38,36 @@ findSplitLine' :: [[Double]] -> Int
findSplitLine' = findSplit . fmap sum
findSplitLine :: [[Double]] -> Cut
-findSplitLine d
- | length d > length (head d) = Cut Horizontal $ findSplitLine' d
- | otherwise = Cut Vertical . findSplitLine' $ transpose d
+findSplitLine d | length d > length (head d) = Cut Horizontal $ findSplitLine' d
+ | otherwise = Cut Vertical . findSplitLine' $ transpose d
drawCut' :: PFMColour -> Cut -> (Int, Int) -> PFMColour -> PFMColour
-drawCut' c (Cut Vertical n) (_, x) c'
- | x == n = c
- | otherwise = c'
-drawCut' c (Cut Horizontal n) (y, _) c'
- | y == n = c
- | otherwise = c'
+drawCut' c (Cut Vertical n) (_, x) c' | x == n = c
+ | otherwise = 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
+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)
+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
im <- B.readFile "data/grace_latlong.pfm"
- let grace = revColour $ parse im
- let height = pfmHeight grace - 1
- let fixedIntensities = zipWith (cfmap $ fixIntensity height) [0..] $ pfmColour grace
- let cut = findSplitLine fixedIntensities
- let newColour = drawCut (PFMColour 0 1 0) cut $ pfmColour grace
+ let grace = revColour $ parse im
+ let height = pfmHeight grace - 1
+ let fixedIntensities = zipWith (cfmap $ fixIntensity height) [0 ..] $ pfmColour grace
+ 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
+ BL.writeFile "data/final.ppm" . encodePPM . clampImage . applyGamma 2.2 $ PFMImage
+ (pfmWidth grace)
+ (pfmHeight grace)
+ newColour