fixed foldl1-bug on empty list

This commit is contained in:
Nicole Dresselhaus 2015-12-07 16:35:04 +01:00
parent da4f435242
commit d574d49f27

View File

@ -4,7 +4,7 @@ import Codec.Picture
import Codec.Picture.Types import Codec.Picture.Types
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Word (Word8) import Data.Word (Word8)
import Data.List (transpose) import Data.List as L (transpose,foldl')
import Text.Printf (printf) import Text.Printf (printf)
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Options.Applicative import Options.Applicative
@ -97,14 +97,15 @@ pixelize tw th im@(Image iw ih id) =
windowh = fromIntegral ih / fromIntegral th windowh = fromIntegral ih / fromIntegral th
folder :: ((PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int)) -> Double -> Double -> Image PixelRGB8 -> Int -> Int -> (Image PixelRGB8, PixelRGB8) folder :: ((PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8, Int, Int)) -> Double -> Double -> Image PixelRGB8 -> Int -> Int -> (Image PixelRGB8, PixelRGB8)
folder f ww wh im@(Image iw ih id) x y = (im,(\(a,_,_) -> a) $ foldl1 f folder f ww wh im@(Image iw ih id) x y = (im,(\(a,_,_) -> a) $ L.foldl' f (pixelAt im x' y',0,0)
[ (pixelAt im (x'+dx) (y'+dy),dx,dy) [ (pixelAt im (x'+dx) (y'+dy),dx,dy)
| dx <- [-(floor $ ww / 2)..(floor $ ww*0.5)] | dx <- [-dw..dw]
, dy <- [-(floor $ ww / 2)..(floor $ ww*0.5)] , dy <- [-dw..dw]
, x'+dx > 0 && x'+dx < iw , x'+dx > 0 && x'+dx < iw
, y'+dy > 0 && y'+dy < ih , y'+dy > 0 && y'+dy < ih
]) ])
where where
dw = floor $ ww
x' = floor $ fromIntegral x * ww x' = floor $ fromIntegral x * ww
y' = floor $ fromIntegral y * wh y' = floor $ fromIntegral y * wh