Drezil/img2ascii
1
1
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixed foldl1-bug on empty list

Browse Source
This commit is contained in:
Nicole Dresselhaus 2015-12-07 16:35:04 +01:00
parent da4f435242
commit d574d49f27
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Main.hs
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,16 +97,17 @@ 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
x' = floor $ fromIntegral x *ww dw = floor $ ww
y' = floor $ fromIntegral y *wh x' = floor $ fromIntegral x * ww
y' = floor $ fromIntegral y * wh
filterfun :: (PixelRGB8,Int,Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8,Int,Int) filterfun :: (PixelRGB8,Int,Int) -> (PixelRGB8, Int, Int) -> (PixelRGB8,Int,Int)
filterfun (x@(PixelRGB8 r g b),_,_) (y@(PixelRGB8 r' g' b'),_,_) = if computeLuma x > computeLuma y then (x,0,0) else (y,0,0) filterfun (x@(PixelRGB8 r g b),_,_) (y@(PixelRGB8 r' g' b'),_,_) = if computeLuma x > computeLuma y then (x,0,0) else (y,0,0)