never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Parser
    2   ( processImage
    3   , processImageWithLog
    4   ) where
    5 
    6 import           HelVM.HelMA.Automata.Piet.Types.Color
    7 import           HelVM.HelMA.Automata.Piet.Types.Image
    8 
    9 import qualified Codec.Picture                         as Picture
   10 
   11 import           Control.Monad.Logger
   12 
   13 import           Data.MonoTraversable
   14 
   15 processImageWithLog ∷ MonadLogger m ⇒ Maybe Natural → Picture.DynamicImage → m (Image Color)
   16 processImageWithLog codelInfo dynamicImage = imageFromJuicy actualCodelLength img <$ logDebugN ("Actual codel length: " <> show actualCodelLength) where
   17   actualCodelLength = calculateActualCodelLength codelInfo img
   18   img = Picture.convertRGBA8 dynamicImage
   19 
   20 processImage ∷  Maybe Natural → Picture.DynamicImage → Image Color
   21 processImage codelInfo dynamicImage = imageFromJuicy actualCodelLength img where
   22   actualCodelLength = calculateActualCodelLength codelInfo img
   23   img = Picture.convertRGBA8 dynamicImage
   24 
   25 calculateActualCodelLength ∷ Maybe Natural → Picture.Image Picture.PixelRGBA8 → Int
   26 calculateActualCodelLength codelInfo img  = max 1 $ maybe defaultCodelInfo fromIntegral codelInfo where
   27     defaultCodelInfo = imageGuessCodelLength img
   28 
   29 imageFromJuicy ∷ Int → Picture.Image Picture.PixelRGBA8 → Image Color
   30 imageFromJuicy codelLength img = newImage (width, height) pixels where
   31   width  = Picture.imageWidth img `div` codelLength
   32   height = Picture.imageHeight img `div` codelLength
   33 
   34   pixels = [ ((x, y), extractColor x y) | x <- [0 .. width-1], y <- [0 .. height-1] ]
   35 
   36   extractColor x y = checkAlpha (Picture.pixelAt img (x * codelLength) (y * codelLength))
   37   checkAlpha (Picture.PixelRGBA8 r g b _) = rgb2Color r g b
   38 
   39 imageGuessCodelLength ∷ Picture.Image Picture.PixelRGBA8 → Int
   40 imageGuessCodelLength img = lastUntil isOne $ scanl gcd (gcd width height) $ fmap olength (group rows) <> fmap olength (group cols) where
   41   width  = Picture.imageWidth img
   42   height = Picture.imageHeight img
   43   isOne  = (== 1)
   44 
   45   rows = [ [ Picture.pixelAt img x y | x <- [0 .. width-1] ]  | y <- [0 .. height-1] ]
   46   cols = [ [ Picture.pixelAt img x y | y <- [0 .. height-1] ] | x <- [0 .. width-1] ]
   47 
   48   lastUntil _ [x]    = x
   49   lastUntil p (x:xs) = guardPred (p x) p x xs
   50   lastUntil _ _      = error "empty list in lastUntil helper (imageGuessCodelLength)"
   51 
   52   guardPred True  _  x _  = x
   53   guardPred False p' _ xs = lastUntil p' xs