blob: 94d2d9ae080aaaed712f3a44f6dab56738869073 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
module Main where
import qualified Data.ByteString as B
import Data.List (transpose)
import qualified Data.Text as T
import PFM
data Direction = Horizontal | Vertical
deriving (Show, Eq)
data Cut = Cut Direction Int
deriving (Show, Eq)
clamp :: PFMColour -> PPMColour
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
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
fixIntensity _ _ _ = error "Mono not supported"
findSplit :: [Double] -> Int
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
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
drawCut' :: PFMColour -> Cut -> (Int, Int) -> PFMColour -> PFMColour
drawCut' c (Cut Vertical n) (x, _) c'
| x == n || x == n - 1 = c
| otherwise = c'
drawCut' c (Cut Horizontal n) (_, y) c'
| y == n || y == n - 1 = c
| otherwise = c'
drawCut :: PFMColour -> Cut -> [[PFMColour]] -> [[PFMColour]]
drawCut c cut colour =
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
print . findSplitLine $ fixedIntensities
|
