patch-image 0.3.3.3 → 0.3.4
raw patch · 4 files changed
+562/−204 lines, 4 filesdep ~pqueue
Dependency ranges changed: pqueue
Files
- README.md +4/−4
- patch-image.cabal +4/−3
- src/Knead.hs +492/−168
- src/Knead/Color.hs +62/−29
README.md view
@@ -133,10 +133,10 @@ Options: * `--output`:- Path of the output JPEG image with the weighted collage.+ Path of the output image with the weighted collage. * `--output-hard`:- Alternative output of a JPEG collage+ Alternative output of a collage where the image parts are simply averaged. You will certainly see bumps in brightness at the borders of the image parts.@@ -175,7 +175,7 @@ Options: * `--output-shaped`:- Path of the output JPEG image with smoothly blended image parts+ Path of the output image with smoothly blended image parts along curves of low image difference. * `--output-shaped-hard`:@@ -196,7 +196,7 @@ General options: * `--quality`:- JPEG quality percentage for writing the images.+ Quality percentage for writing images in JPEG format. # Semi-Automatic mode: inspection and correction
patch-image.cabal view
@@ -1,5 +1,5 @@ Name: patch-image-Version: 0.3.3.3+Version: 0.3.4 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -28,7 +28,8 @@ . Restrictions: .- * Only supports JPEG format.+ * Requires that all input pictures use the same color space+ and that color channel depth is 8 bit. . * Images must be approximately correctly oriented. .@@ -41,7 +42,7 @@ README.md Source-Repository this- Tag: 0.3.3.3+ Tag: 0.3.4 Type: darcs Location: https://hub.darcs.net/thielema/patch-image/
src/Knead.hs view
@@ -20,7 +20,7 @@ import Knead.Shape (Size, Vec2(Vec2), Dim1, Dim2, Shape2, Shape2ZB, Index2, Ix2, Factor2, verticalSize, verticalVal, horizontalVal)-import Knead.Color (YUV)+import Knead.Color (YUV, RGB) import Degree (Degree(Degree), getDegree) import qualified Numeric.FFTW.Rank2 as Trafo2@@ -75,6 +75,7 @@ import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Bool8 as Bool8+import qualified Data.Char as Char import Data.Monoid ((<>)) import Data.Maybe.HT (toMaybe) import Data.Maybe (mapMaybe, isJust, isNothing)@@ -98,10 +99,23 @@ type Plane = Phys.Array Dim2 type Planes tuple = Plane (Tuple tuple) type SymbPlane = Symb.Array Dim2-type ColorImage a = Phys.Array Dim2 (YUV a)-type ColorImage8 = ColorImage Word8+type Image = Phys.Array Dim2+type GreyImage a = Image a+type GreyImage8 = GreyImage Word8+type YUVImage a = Image (YUV a)+type YUVImage8 = YUVImage Word8+type RGBImage a = Image (RGB a)+type RGBImage8 = RGBImage Word8 +data InColorSpace f a =+ InGreySpace (f a)+ | InYUVSpace (f (YUV a))+ | InRGBSpace (f (RGB a)) +type ColorImage = InColorSpace (Phys.Array Dim2)+++ shape2 :: (Integral i) => i -> i -> Dim2 shape2 height width = Vec2@@ -109,25 +123,101 @@ (Shape.ZeroBased $ fromIntegral width) -readImage :: Verbosity -> FilePath -> IO ColorImage8+pixelFormatName :: Pic.DynamicImage -> String+pixelFormatName pic =+ case pic of+ Pic.ImageY8 _ -> "Greyscale 8-bit"+ Pic.ImageY16 _ -> "Greyscale 16-bit"+ Pic.ImageY32 _ -> "Greyscale 32-bit"+ Pic.ImageYF _ -> "Greyscale Floating Point"+ Pic.ImageYA8 _ -> "Luminance + Alpha 8-bit"+ Pic.ImageYA16 _ -> "Luminance + Alpha 16-bit"+ Pic.ImageRGB8 _ -> "RGB 8-bit"+ Pic.ImageRGB16 _ -> "RGB 16-bit"+ Pic.ImageRGBA8 _ -> "RGBA 8-bit"+ Pic.ImageRGBA16 _ -> "RGBA 16-bit"+ Pic.ImageYCbCr8 _ -> "YCbCr 8-bit"+ Pic.ImageCMYK8 _ -> "CMYK 8-bit"+ Pic.ImageCMYK16 _ -> "CMYK 16-bit"+ Pic.ImageRGBF _ -> "RGB Floating Point"++noImage :: Pic.Image a+noImage = error "no image"++failFormatMismatch :: Pic.DynamicImage -> Pic.DynamicImage -> IO a+failFormatMismatch expected got =+ fail $+ "Inconsistent input pixel formats: "+ +++ printf+ "Expected pixel format '%s' but got '%s'."+ (pixelFormatName expected)+ (pixelFormatName got)++castImage ::+ (Pic.PixelBaseComponent a ~ abase, SV.Storable abase) =>+ Verbosity -> String -> Pic.Image a -> IO (ComfortArray.Array Dim2 b)+castImage verbosity typ pic = do+ let dat = Pic.imageData pic+ CmdLine.info verbosity $+ printf "%s %dx%d, size %d\n"+ typ+ (Pic.imageWidth pic)+ (Pic.imageHeight pic)+ (SV.length dat)+ return $+ ComfortArray.Array+ (shape2 (Pic.imageHeight pic) (Pic.imageWidth pic))+ (castForeignPtr $ fst $ SV.unsafeToForeignPtr0 dat)++readGreyImage :: Verbosity -> FilePath -> IO GreyImage8+readGreyImage verbosity path = do+ epic <- Pic.readImage path+ case epic of+ Left msg -> fail msg+ Right dynpic ->+ case dynpic of+ Pic.ImageY8 pic -> castImage verbosity "grey" pic+ _ -> failFormatMismatch (Pic.ImageY8 noImage) dynpic++readYUVImage :: Verbosity -> FilePath -> IO YUVImage8+readYUVImage verbosity path = do+ epic <- Pic.readImage path+ case epic of+ Left msg -> fail msg+ Right dynpic ->+ case dynpic of+ Pic.ImageYCbCr8 pic -> castImage verbosity "yuv" pic+ _ -> failFormatMismatch (Pic.ImageYCbCr8 noImage) dynpic++readRGBImage :: Verbosity -> FilePath -> IO RGBImage8+readRGBImage verbosity path = do+ epic <- Pic.readImage path+ case epic of+ Left msg -> fail msg+ Right dynpic ->+ case dynpic of+ Pic.ImageRGB8 pic -> castImage verbosity "rgb" pic+ _ -> failFormatMismatch (Pic.ImageRGB8 noImage) dynpic++readImage :: Verbosity -> FilePath -> IO (ColorImage Word8) readImage verbosity path = do epic <- Pic.readImage path case epic of- Left msg -> ioError $ userError msg+ Left msg -> fail msg Right dynpic -> case dynpic of- Pic.ImageYCbCr8 pic -> do- let dat = Pic.imageData pic- CmdLine.info verbosity $- printf "yuv %dx%d, size %d\n"- (Pic.imageWidth pic)- (Pic.imageHeight pic)- (SV.length dat)- return $- ComfortArray.Array- (shape2 (Pic.imageHeight pic) (Pic.imageWidth pic))- (castForeignPtr $ fst $ SV.unsafeToForeignPtr0 dat)- _ -> ioError $ userError "unsupported image type"+ Pic.ImageY8 pic ->+ fmap InGreySpace $ castImage verbosity "grey" pic+ Pic.ImageYCbCr8 pic ->+ fmap InYUVSpace $ castImage verbosity "yuv" pic+ Pic.ImageRGB8 pic ->+ fmap InRGBSpace $ castImage verbosity "rgb" pic+ _ ->+ fail $+ printf+ "color space '%s' unsupported or more than 8 bit"+ (pixelFormatName dynpic) vectorStorableFrom ::@@ -150,17 +240,35 @@ Pic.imageData = vectorStorableFrom castArray img } -writeImage :: Int -> FilePath -> ColorImage8 -> IO ()-writeImage quality path img =- Pic.saveJpgImage quality path $ Pic.ImageYCbCr8 $+saveImage :: Int -> FilePath -> Pic.DynamicImage -> IO ()+saveImage quality path img =+ case map Char.toLower $ FilePath.takeExtension path of+ ".png" -> Pic.savePngImage path img+ ".jpg" -> Pic.saveJpgImage quality path img+ ".jpeg" -> Pic.saveJpgImage quality path img+ ".bmp" -> Pic.saveBmpImage path img+ ".gif" -> either fail id $ Pic.saveGifImage path img+ ".tiff" -> Pic.saveTiffImage path img+ ".tif" -> Pic.saveTiffImage path img+ ".hdr" -> Pic.saveRadianceImage path img+ ext -> fail $ "Unknown file name extension: " ++ ext++writeYUVImage :: Int -> FilePath -> YUVImage8 -> IO ()+writeYUVImage quality path img =+ saveImage quality path $ Pic.ImageYCbCr8 $ imageFromArray castForeignPtr img +writeRGBImage :: Int -> FilePath -> RGBImage8 -> IO ()+writeRGBImage quality path img =+ Pic.saveJpgImage quality path $ Pic.ImageRGB8 $+ imageFromArray castForeignPtr img+ writeGrey :: Int -> FilePath -> Plane Word8 -> IO () writeGrey quality path img =- Pic.saveJpgImage quality path $ Pic.ImageY8 $ imageFromArray id img+ saveImage quality path $ Pic.ImageY8 $ imageFromArray id img -colorImageExtent :: ColorImage8 -> (Size, Size)+colorImageExtent :: Image a -> (Size, Size) colorImageExtent pic = case Phys.shape pic of Vec2 (Shape.ZeroBased height) (Shape.ZeroBased width) -> (width, height)@@ -203,6 +311,15 @@ imageByteFromFloat = Symb.map byteFromFloat +yuvImageFloatFromByte ::+ (Symb.C array, Shape.C sh,+ NiceValue.NativeFloating a ar, a ~ ar,+ NiceValue.PseudoRing a, NiceValue.Real a,+ NiceValue.RationalConstant a) =>+ array sh (YUV Word8) -> array sh (YUV a)+yuvImageFloatFromByte = Symb.map $ Color.map floatFromByte++ yuvByteFromFloat :: (NiceValue.NativeFloating a ar, a ~ ar, NiceValue.Field a, NiceValue.Real a,@@ -210,23 +327,75 @@ Exp (YUV a) -> Exp (YUV Word8) yuvByteFromFloat = Color.map byteFromFloat -colorImageFloatFromByte ::- (Symb.C array, Shape.C sh,- NiceValue.NativeFloating a ar, a ~ ar,- NiceValue.PseudoRing a, NiceValue.Real a,- NiceValue.RationalConstant a) =>- array sh (YUV Word8) -> array sh (YUV a)-colorImageFloatFromByte = Symb.map $ Color.map floatFromByte--colorImageByteFromFloat ::+yuvImageByteFromFloat :: (Symb.C array, Shape.C sh, NiceValue.NativeFloating a ar, a ~ ar, NiceValue.Field a, NiceValue.Real a, NiceValue.RationalConstant a) => array sh (YUV a) -> array sh (YUV Word8)-colorImageByteFromFloat = Symb.map yuvByteFromFloat+yuvImageByteFromFloat = Symb.map yuvByteFromFloat +yuvBrightnessFromByte :: Exp (YUV Word8) -> Exp Float+yuvBrightnessFromByte = floatFromByte . Color.luma++rgbBrightnessFromByte :: Exp (RGB Word8) -> Exp Float+rgbBrightnessFromByte = Color.brightness . Color.map floatFromByte++++data ColorSpaceDict v8 a v =+ ColorSpaceDict {+ csFloatFromByte :: Exp v8 -> Exp v,+ csByteFromFloat :: Exp v -> Exp v8,+ csBrightness :: Exp v -> Exp a,+ csBrightnessFromByte :: Exp v8 -> Exp a,+ csVectorSpace :: VecExp a v+ }++csImageFloatFromByte ::+ (Shape.C sh) =>+ ColorSpaceDict v8 a v -> Symb.Array sh v8 -> Symb.Array sh v+csImageFloatFromByte cs = Symb.map (csFloatFromByte cs)++csImageByteFromFloat ::+ (Shape.C sh) =>+ ColorSpaceDict v8 a v -> Symb.Array sh v -> Symb.Array sh v8+csImageByteFromFloat cs = Symb.map (csByteFromFloat cs)+++greyColorSpaceDict :: ColorSpaceDict Word8 Float Float+greyColorSpaceDict =+ ColorSpaceDict {+ csFloatFromByte = floatFromByte,+ csByteFromFloat = byteFromFloat,+ csBrightness = id,+ csBrightnessFromByte = floatFromByte,+ csVectorSpace = vecGrey+ }++yuvColorSpaceDict :: ColorSpaceDict (YUV Word8) Float (YUV Float)+yuvColorSpaceDict =+ ColorSpaceDict {+ csFloatFromByte = Color.map floatFromByte,+ csByteFromFloat = yuvByteFromFloat,+ csBrightness = Color.brightness,+ csBrightnessFromByte = yuvBrightnessFromByte,+ csVectorSpace = vecC3+ }++rgbColorSpaceDict :: ColorSpaceDict (RGB Word8) Float (RGB Float)+rgbColorSpaceDict =+ ColorSpaceDict {+ csFloatFromByte = Color.map floatFromByte,+ csByteFromFloat = Color.map byteFromFloat,+ csBrightness = Color.brightness,+ csBrightnessFromByte = rgbBrightnessFromByte,+ csVectorSpace = vecC3+ }+++ fastRound :: (NiceValue.NativeInteger i ir, NiceValue.NativeFloating a ar) => Exp a -> Exp i@@ -307,11 +476,19 @@ type VecExp a v = Arith.Vec (Exp a) (Exp v) -vecYUV ::+vecGrey :: (NiceValue.PseudoRing a) => VecExp a a+vecGrey =+ Arith.Vec {+ Arith.vecZero = Expr.zero,+ Arith.vecAdd = Expr.add,+ Arith.vecScale = Expr.mul+ }++vecC3 :: (NiceValue.PseudoRing a, LLVM.IsArithmetic a, LLVM.IsPrimitive a, LLVM.IsConst a, NiceValue.Repr a ~ LLVM.Value a) =>- VecExp a (YUV a)-vecYUV =+ VecExp a (Color.C3 space a)+vecC3 = Arith.Vec { Arith.vecZero = Expr.zero, Arith.vecAdd = Expr.liftReprM2 LLVMArith.add,@@ -488,30 +665,23 @@ img -runRotate :: IO (Degree Float -> ColorImage8 -> IO ColorImage8)+runRotate :: IO (Degree Float -> YUVImage8 -> IO YUVImage8) runRotate = do rot <- RenderP.run $ \rot ->- colorImageByteFromFloat . rotate vecYUV rot . colorImageFloatFromByte+ yuvImageByteFromFloat . rotate vecC3 rot . yuvImageFloatFromByte return $ \ angle img -> rot (Degree.cis angle) img -brightnessPlane ::- (Symb.C array, Shape.C size) =>- (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>- array size (YUV a) -> array size a-brightnessPlane = Symb.map Color.brightness- rowHistogram :: (Symb.C array, NiceValue.Additive a) => (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>- array Dim2 (YUV a) -> array Dim1 a+ array Dim2 a -> array Dim1 a rowHistogram = Symb.fold1 Expr.add . ShapeDep.backpermute (Expr.modify atomDim2 $ \(Vec2 h w) -> (h,w))- (Expr.modify (atom,atom) $ \(y,x) -> Vec2 y x) .- brightnessPlane+ (Expr.modify (atom,atom) $ \(y,x) -> Vec2 y x) tailArr :: (Symb.C array) => array Dim1 a -> array Dim1 a@@ -529,17 +699,23 @@ scoreHistogram = Symb.fold1All Expr.add . Symb.map Expr.sqr . differentiate -runScoreRotation :: IO (Degree Float -> ColorImage8 -> IO Float)-runScoreRotation = do+runScoreRotation ::+ (Storable.C v) =>+ (Exp v -> Exp Float) ->+ IO (Degree Float -> Image v -> IO Float)+runScoreRotation brightness = do rot <- RenderP.run $ \rot ->- rowHistogram . rotate vecYUV rot . colorImageFloatFromByte+ rowHistogram . rotate vecGrey rot . Symb.map brightness score <- RenderP.run scoreHistogram return $ \ angle img -> score =<< rot (Degree.cis angle) img -findOptimalRotation :: IO ([Degree Float] -> ColorImage8 -> IO (Degree Float))-findOptimalRotation = do- scoreRotation <- runScoreRotation+findOptimalRotation ::+ (Storable.C v) =>+ (Exp v -> Exp Float) ->+ IO ([Degree Float] -> Image v -> IO (Degree Float))+findOptimalRotation brightness = do+ scoreRotation <- runScoreRotation brightness return $ \angles pic -> fmap (fst . List.maximumBy (comparing snd)) $ forM angles $ \angle -> (,) angle <$> scoreRotation angle pic@@ -647,9 +823,11 @@ prepareOverlapMatching ::- IO (Int -> (Degree Float, ColorImage8) -> IO ((Float, Float), Plane Float))-prepareOverlapMatching = do- bright <- RenderP.run $ brightnessPlane . colorImageFloatFromByte . Symb.fix+ (Storable.C v8) =>+ (Exp v8 -> Exp Float) ->+ IO (Int -> (Degree Float, Image v8) -> IO ((Float, Float), Plane Float))+prepareOverlapMatching brightness = do+ bright <- RenderP.run $ Symb.map brightness . Symb.fix hp <- highpassMulti rotat <- RenderP.run $ rotate Arith.vecScalar return $ \radius (angle, img) ->@@ -1037,28 +1215,34 @@ (Expr.ifThenElse inPicB (b!pb) (Arith.vecZero vec)) composeOverlap ::+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v -> IO ((Size, Size) ->- ((Degree Float, ColorImage8), (Degree Float, ColorImage8)) ->- IO ColorImage8)-composeOverlap = do+ ((Degree Float, Image v8), (Degree Float, Image v8)) ->+ IO (Image v8))+composeOverlap cs = do+ let vec = csVectorSpace cs over <- RenderP.run $ \displacement (ra, picA) (rb, picB) ->- colorImageByteFromFloat $- overlap2 vecYUV displacement- (rotate vecYUV ra $ colorImageFloatFromByte picA,- rotate vecYUV rb $ colorImageFloatFromByte picB)+ csImageByteFromFloat cs $+ overlap2 vec displacement+ (rotate vec ra $ csImageFloatFromByte cs picA,+ rotate vec rb $ csImageFloatFromByte cs picB) return $ \displacement ((angleA,picA), (angleB,picB)) -> over displacement (Degree.cis angleA, picA) (Degree.cis angleB, picB) -emptyCountCanvas :: IO (Dim2 -> IO (Planes (Word32, YUV Float)))-emptyCountCanvas =- RenderP.run $ \sh -> Symb.fill sh (Expr.tuple $ Expr.zip 0 $ Color.yuv 0 0 0)+emptyCountCanvas ::+ (Storable.C v) =>+ VecExp a v -> IO (Dim2 -> IO (Planes (Word32, v)))+emptyCountCanvas vec =+ RenderP.run $ \sh ->+ Symb.fill sh (Expr.tuple $ Expr.zip 0 $ Arith.vecZero vec) -type RotatedImage = ((Float,Float), (Float,Float), ColorImage8)+type RotatedImage v8 = ((Float,Float), (Float,Float), Image v8) addToCountCanvas :: (NiceValue.PseudoRing a, NiceValue.NativeFloating a ar) =>@@ -1074,23 +1258,29 @@ Arith.vecScale vec (Expr.floatFromBool8 mask) pic)) updateCountCanvas ::- IO (RotatedImage -> Planes (Word32, YUV Float) ->- IO (Planes (Word32, YUV Float)))-updateCountCanvas =+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (RotatedImage v8 -> Planes (Word32, v) ->+ IO (Planes (Word32, v)))+updateCountCanvas cs = RenderP.run $ \(rot, mov, pic) countCanvas -> Symb.map Expr.tuple $- addToCountCanvas vecYUV- (rotateStretchMove vecYUV rot mov (Symb.shape countCanvas) $- colorImageFloatFromByte pic)+ addToCountCanvas (csVectorSpace cs)+ (rotateStretchMove (csVectorSpace cs) rot mov (Symb.shape countCanvas)+ $+ csImageFloatFromByte cs pic) (Symb.map Expr.untuple countCanvas) -finalizeCountCanvas :: IO (Planes (Word32, YUV Float) -> IO ColorImage8)-finalizeCountCanvas =+finalizeCountCanvas ::+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (Planes (Word32, v) -> IO (Image v8))+finalizeCountCanvas cs = RenderP.run $- colorImageByteFromFloat .+ csImageByteFromFloat cs . Symb.map (Expr.modify (Tuple (atom,atom)) $ \(Tuple (count, pixel)) ->- Arith.vecScale vecYUV (recip $ fromInt count) pixel) .+ Arith.vecScale (csVectorSpace cs) (recip $ fromInt count) pixel) . Symb.fix @@ -1098,58 +1288,70 @@ diffAbs = Expr.liftM2 $ \x y -> NiceValue.abs =<< NiceValue.sub x y diffWithCanvas ::- IO (RotatedImage -> Plane (YUV Float) -> IO (Planes (Bool8, Float)))-diffWithCanvas =+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (RotatedImage v8 -> Plane v -> IO (Planes (Bool8, Float)))+diffWithCanvas cs = RenderP.run $ \(rot, mov, pic) avg -> Symb.zipWith (Expr.modify2 (atom,atom) atom $ \(b,x) y ->- Tuple (b, diffAbs (Color.brightness x) (Color.brightness y)))- (rotateStretchMove vecYUV rot mov (Symb.shape avg) $- colorImageFloatFromByte pic)+ Tuple (b, diffAbs (csBrightness cs x) (csBrightness cs y)))+ (rotateStretchMove (csVectorSpace cs) rot mov (Symb.shape avg) $+ csImageFloatFromByte cs pic) avg finalizeCountCanvasFloat ::- IO ((Planes (Word32, YUV Float)) -> IO (Plane (YUV Float)))-finalizeCountCanvasFloat =+ (Storable.C v) =>+ VecExp Float v -> IO ((Planes (Word32, v)) -> IO (Plane v))+finalizeCountCanvasFloat vec = RenderP.run $ Symb.map (Expr.modify (Tuple (atom,atom)) $ \(Tuple (count, pixel)) ->- Arith.vecScale vecYUV (recip $ fromInt count) pixel)+ Arith.vecScale vec (recip $ fromInt count) pixel) . Symb.fix -emptyCanvas :: IO (Dim2 -> IO ColorImage8)-emptyCanvas = RenderP.run $ \sh -> Symb.fill sh (Color.yuv 0 0 0)+emptyCanvas ::+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (Dim2 -> IO (Image v8))+emptyCanvas cs = RenderP.run $ \sh ->+ Symb.fill sh $ csByteFromFloat cs $ Arith.vecZero $ csVectorSpace cs addMaskedToCanvas ::- IO (RotatedImage ->+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (RotatedImage v8 -> Plane Bool8 ->- ColorImage8 ->- IO ColorImage8)-addMaskedToCanvas =+ Image v8 ->+ IO (Image v8))+addMaskedToCanvas cs = RenderP.run $ \(rot, mov, pic) mask canvas -> Symb.zipWith3 Expr.ifThenElse (Symb.map Expr.boolPFrom8 mask)- (Symb.map (yuvByteFromFloat . Expr.snd) $- rotateStretchMove vecYUV rot mov (Symb.shape canvas) $- colorImageFloatFromByte pic)+ (Symb.map (csByteFromFloat cs . Expr.snd) $+ rotateStretchMove (csVectorSpace cs) rot mov (Symb.shape canvas) $+ csImageFloatFromByte cs pic) canvas updateShapedCanvas ::- IO (RotatedImage ->+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (RotatedImage v8 -> Plane Float ->- Planes (Float, YUV Float) ->- IO (Planes (Float, YUV Float)))-updateShapedCanvas =+ Planes (Float, v) ->+ IO (Planes (Float, v)))+updateShapedCanvas cs = RenderP.run $ \(rot, mov, pic) shape weightCanvas -> Symb.map Expr.tuple $- addToWeightedCanvas vecYUV+ addToWeightedCanvas (csVectorSpace cs) (Symb.zipWith (Expr.modify2 atom (atom,atom) $ \s (b,x) -> (Expr.floatFromBool8 b * s, x)) shape $- rotateStretchMove vecYUV rot mov (Symb.shape weightCanvas) $- colorImageFloatFromByte pic)+ rotateStretchMove (csVectorSpace cs) rot mov (Symb.shape weightCanvas)+ $+ csImageFloatFromByte cs pic) (Symb.map Expr.untuple weightCanvas) @@ -1439,10 +1641,12 @@ Symb.map (pow gamma) $ distanceMap sh this others points -emptyWeightedCanvas :: IO (Dim2 -> IO (Planes (Float, YUV Float)))-emptyWeightedCanvas =+emptyWeightedCanvas ::+ (Storable.C v) =>+ VecExp Float v -> IO (Dim2 -> IO (Planes (Float, v)))+emptyWeightedCanvas vec = RenderP.run $ \sh ->- Symb.fill sh $ Expr.tuple $ Expr.zip 0 $ Color.yuv 0 0 0+ Symb.fill sh $ Expr.tuple $ Expr.zip 0 $ Arith.vecZero vec addToWeightedCanvas :: (NiceValue.PseudoRing a, NiceValue.NativeFloating a ar) =>@@ -1458,14 +1662,16 @@ Arith.vecAdd vec canvas $ Arith.vecScale vec weight pic)) updateWeightedCanvas ::+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v -> IO (Float -> Geometry Float -> [Geometry Float] -> [Arith.Point2 Float] ->- ColorImage8 ->- Planes (Float, YUV Float) ->- IO (Planes (Float, YUV Float)))-updateWeightedCanvas = do+ Image v8 ->+ Planes (Float, v) ->+ IO (Planes (Float, v)))+updateWeightedCanvas cs = do distances <- RenderP.run $ \gamma shape this ->@@ -1476,12 +1682,12 @@ RenderP.run $ \this pic dist weightSumCanvas -> let (rot, mov, _) = Expr.unzip3 this in Symb.map Expr.tuple $- addToWeightedCanvas vecYUV+ addToWeightedCanvas (csVectorSpace cs) (Symb.zip dist $ Symb.map Expr.snd $- rotateStretchMove vecYUV rot mov+ rotateStretchMove (csVectorSpace cs) rot mov (Symb.shape weightSumCanvas) $- colorImageFloatFromByte pic)+ csImageFloatFromByte cs pic) (Symb.map Expr.untuple weightSumCanvas) return $ \gamma this others points pic weightSumCanvas -> do@@ -1493,40 +1699,46 @@ update this pic dists weightSumCanvas -finalizeWeightedCanvas :: IO (Planes (Float, YUV Float) -> IO ColorImage8)-finalizeWeightedCanvas =+finalizeWeightedCanvas ::+ (Storable.C v8, Storable.C v) =>+ ColorSpaceDict v8 Float v ->+ IO (Planes (Float, v) -> IO (Image v8))+finalizeWeightedCanvas cs = RenderP.run $- colorImageByteFromFloat .+ csImageByteFromFloat cs . Symb.map (Expr.modify (Tuple (atom,atom)) $ \(Tuple (weightSum, pixel)) ->- Arith.vecScale vecYUV (recip weightSum) pixel) .+ Arith.vecScale (csVectorSpace cs) (recip weightSum) pixel) . Symb.fix data- Picture param =+ Picture param v8 = Picture { picPath :: FilePath, picParam :: param,- picColored :: (Degree Float, ColorImage8),+ picColored :: (Degree Float, Image v8), picPlane :: ((Float, Float), Plane Float) } -mapPicParam :: (a -> b) -> Picture a -> Picture b+mapPicParam :: (a -> b) -> Picture a v8 -> Picture b v8 mapPicParam f pic = pic{picParam = f $ picParam pic} processOverlap ::+ (Storable.C v8, Storable.C v) => Option.Args ->- IO ([FilePath], [(Degree Float, ColorImage8)],+ ColorSpaceDict v8 Float v ->+ (Int -> FilePath -> Image v8 -> IO ()) ->+ PictureList (State.NoAngleCorrection, (Maybe Float, Maybe Float)) v8 ->+ IO ([FilePath], [(Degree Float, Image v8)], [((Float, Float), Complex Float)])-processOverlap args = do+processOverlap args cs writeImage (PictureList rotPics) = do let opt = Option.option args let info = CmdLine.info (Option.verbosity opt) - pics <-- map (mapPicParam (\(State.NoAngleCorrection, pos) -> pos)) <$>- processRotation args+ let pics =+ map (mapPicParam (\(State.NoAngleCorrection, pos) -> pos)) rotPics let padSize = Shape.ZeroBased $ fromIntegral $ Option.padSize opt (maybeAllOverlapsShared, optimalOverlapShared) <- case Just $ Vec2 padSize padSize of@@ -1550,7 +1762,7 @@ (State.readDisplacement (map picPath pics)) (Option.relations opt) - composeOver <- composeOverlap+ composeOver <- composeOverlap cs overlapDiff <- overlapDifferenceRun let open = map ((\(mx,my) -> isNothing mx || isNothing my) . picParam) pics displacements <-@@ -1624,16 +1836,15 @@ processOverlapRotate :: Option.Args ->- IO ([FilePath], [(Degree Float, ColorImage8)],+ PictureList (State.AngleCorrection, (Maybe Float, Maybe Float)) v8 ->+ IO ([FilePath], [(Degree Float, Image v8)], [((Float, Float), Complex Float)])-processOverlapRotate args = do+processOverlapRotate args (PictureList rotPics) = do let opt = Option.option args let info = CmdLine.info (Option.verbosity opt) let infoPlain = when (Option.verbosity opt >= Verbosity.verbose) . putStr - pics <-- map (mapPicParam (mapFst State.getAngleCorrection)) <$>- processRotation args+ let pics = map (mapPicParam (mapFst State.getAngleCorrection)) rotPics let padSize = Option.padSize opt let stampSize = Option.stampSize opt optimalOverlapShared <-@@ -1713,36 +1924,117 @@ return (map picPath pics, map picColored pics, posRots) +runRotater ::+ (angleCorr ~ Degree Float) =>+ Option.Option ->+ ([angleCorr] -> pic -> IO angleCorr) ->+ FilePath ->+ Maybe angleCorr -> pic -> IO (angleCorr, pic)+runRotater opt findOptRot path maybeAngle pic = do+ let info = CmdLine.info (Option.verbosity opt)+ let maxAngle = Option.maximumAbsoluteAngle opt+ let angles = Degree.linearScale (Option.numberAngleSteps opt) maxAngle+ angle <-+ case maybeAngle of+ Just angle -> return angle+ Nothing -> findOptRot angles pic+ info $ printf "%s %f\176\n" path (getDegree angle)+ return (angle, pic)++-- alternatively we could use Functor.Compose DecoratedList Plane+newtype ImageList a v8 = ImageList [(a, ComfortArray.Array Dim2 v8)]++imageListMetadata :: InColorSpace (ImageList a) v8 -> [a]+imageListMetadata x =+ case x of+ InGreySpace (ImageList xs) -> map fst xs+ InYUVSpace (ImageList xs) -> map fst xs+ InRGBSpace (ImageList xs) -> map fst xs++newtype PictureList a v8 = PictureList [Picture a v8]+ processRotation :: (State.AngleCorrected angleCorr) =>- Option.Args -> IO [Picture (angleCorr, (Maybe Float, Maybe Float))]+ Option.Args ->+ IO (InColorSpace (PictureList (angleCorr, (Maybe Float, Maybe Float))) Word8) processRotation args = do let opt = Option.option args let notice = CmdLine.notice (Option.verbosity opt)- let info = CmdLine.info (Option.verbosity opt) inputs <- Option.images args notice "\nfind rotation angles\n"- findOptRot <- findOptimalRotation picAngles <-- forM inputs $ \(State.Proposed path (maybeAngle, _) _) -> do- pic <- readImage (Option.verbosity opt) path- let maxAngle = Option.maximumAbsoluteAngle opt- let angles = Degree.linearScale (Option.numberAngleSteps opt) maxAngle- angle <-- case maybeAngle of- Just angle -> return angle- Nothing -> findOptRot angles pic- info $ printf "%s %f\176\n" path (getDegree angle)- return (angle, pic)+ case inputs of+ [] -> do+ return $ InGreySpace $ ImageList [] + State.Proposed path0 (maybeAngle0, _) _ : inputs0 -> do+ let retrieveImagesAndRotationInColorSpace ::+ (Storable.C v8) =>+ (Exp v8 -> Exp Float) ->+ (Verbosity -> FilePath -> IO (Image v8)) ->+ Image v8 -> IO (ImageList (Degree Float) v8)+ retrieveImagesAndRotationInColorSpace+ brightnessFromByte readSpecImage pic0 = do+ findOptRot <- findOptimalRotation brightnessFromByte+ fmap ImageList $+ liftA2 (:)+ (runRotater opt findOptRot path0 maybeAngle0 pic0)+ (forM inputs0 $+ \(State.Proposed path (maybeAngle, _) _) -> do+ pic <- readSpecImage (Option.verbosity opt) path+ runRotater opt findOptRot path maybeAngle pic)++ dynpic0 <- readImage (Option.verbosity opt) path0+ case dynpic0 of+ InGreySpace pic0 ->+ fmap InGreySpace $+ retrieveImagesAndRotationInColorSpace+ floatFromByte readGreyImage pic0+ InYUVSpace pic0 ->+ fmap InYUVSpace $+ retrieveImagesAndRotationInColorSpace+ yuvBrightnessFromByte readYUVImage pic0+ InRGBSpace pic0 ->+ fmap InRGBSpace $+ retrieveImagesAndRotationInColorSpace+ rgbBrightnessFromByte readRGBImage pic0+ forM_ (Option.outputState opt) $ \format -> State.write (printf format "angle") $- zipWith State.Angle (map State.propPath inputs) (map fst picAngles)+ zipWith State.Angle+ (map State.propPath inputs)+ (imageListMetadata picAngles) + case picAngles of+ InGreySpace picAnglesGrey ->+ fmap InGreySpace $+ processRotationInColorSpace args+ inputs picAnglesGrey floatFromByte+ InYUVSpace picAnglesYUV ->+ fmap InYUVSpace $+ processRotationInColorSpace args+ inputs picAnglesYUV yuvBrightnessFromByte+ InRGBSpace picAnglesRGB ->+ fmap InRGBSpace $+ processRotationInColorSpace args+ inputs picAnglesRGB rgbBrightnessFromByte++processRotationInColorSpace ::+ (Storable.C v8) =>+ Option.Args ->+ [State.Proposed a] ->+ ImageList (Degree Float) v8 ->+ (Exp v8 -> Exp Float) ->+ IO (PictureList (a, (Maybe Float, Maybe Float)) v8)+processRotationInColorSpace args+ inputs (ImageList picAngles) brightnessFromByte = do+ let opt = Option.option args+ let notice = CmdLine.notice (Option.verbosity opt)+ notice "\nfind relative placements\n"- prepOverlapMatching <- prepareOverlapMatching+ prepOverlapMatching <- prepareOverlapMatching brightnessFromByte rotated <- mapM (prepOverlapMatching (Option.smooth opt)) picAngles when False $ do@@ -1769,7 +2061,7 @@ writeGrey (Option.quality opt) "/tmp/convolution.jpeg" =<< (makeByteImage 0.1 =<< correlate pic0 pic1) - return $+ return $ PictureList $ zipWith3 (\(State.Proposed path (_,angleCorr) maybePos) colored plane -> Picture path (angleCorr, maybePos) colored plane)@@ -1780,15 +2072,46 @@ IO.hSetBuffering IO.stdout IO.LineBuffering IO.hSetBuffering IO.stderr IO.LineBuffering + if Option.finetuneRotate (Option.option args)+ then do+ picsCS <- processRotation args+ case picsCS of+ InGreySpace pics ->+ processInColorSpace args greyColorSpaceDict writeGrey+ =<< processOverlapRotate args pics+ InYUVSpace pics ->+ processInColorSpace args yuvColorSpaceDict writeYUVImage+ =<< processOverlapRotate args pics+ InRGBSpace pics ->+ processInColorSpace args rgbColorSpaceDict writeRGBImage+ =<< processOverlapRotate args pics+ else do+ picsCS <- processRotation args+ case picsCS of+ InGreySpace pics ->+ processInColorSpace args greyColorSpaceDict writeGrey+ =<< processOverlap args greyColorSpaceDict writeGrey pics+ InYUVSpace pics ->+ processInColorSpace args yuvColorSpaceDict writeYUVImage+ =<< processOverlap args yuvColorSpaceDict writeYUVImage pics+ InRGBSpace pics ->+ processInColorSpace args rgbColorSpaceDict writeRGBImage+ =<< processOverlap args rgbColorSpaceDict writeRGBImage pics++processInColorSpace ::+ (Storable.C v8, Storable.C v) =>+ Option.Args ->+ ColorSpaceDict v8 Float v ->+ (Int -> FilePath -> Image v8 -> IO ()) ->+ ([FilePath],+ [(Degree Float, Image v8)],+ [((Float, Float), Complex Float)]) ->+ IO ()+processInColorSpace args cs writeImage (paths, picAngles, posRots) = do let opt = Option.option args let notice = CmdLine.notice (Option.verbosity opt) let info = CmdLine.info (Option.verbosity opt) - (paths, picAngles, posRots) <-- if Option.finetuneRotate opt- then processOverlapRotate args- else processOverlap args- forM_ (Option.outputState opt) $ \format -> State.write (printf format "position") $ zipWith3@@ -1804,10 +2127,11 @@ let canvasShape = shape2 canvasHeight canvasWidth mapM_ info canvasMsgs + let vec = csVectorSpace cs forM_ (Option.outputHard opt) $ \path -> do- emptyCanv <- emptyCountCanvas- updateCanv <- updateCountCanvas- finalizeCanv <- finalizeCountCanvas+ emptyCanv <- emptyCountCanvas vec+ updateCanv <- updateCountCanvas cs+ finalizeCanv <- finalizeCountCanvas cs empty <- emptyCanv canvasShape writeImage (Option.quality opt) path =<< finalizeCanv =<<@@ -1850,9 +2174,9 @@ forM_ (Option.output opt) $ \path -> do notice "\nweighted composition\n"- emptyCanv <- emptyWeightedCanvas- updateCanv <- updateWeightedCanvas- finalizeCanv <- finalizeWeightedCanvas+ emptyCanv <- emptyWeightedCanvas vec+ updateCanv <- updateWeightedCanvas cs+ finalizeCanv <- finalizeWeightedCanvas cs empty <- emptyCanv canvasShape writeImage (Option.quality opt) path =<< finalizeCanv =<<@@ -1864,15 +2188,15 @@ when (isJust (Option.outputShaped opt) || isJust (Option.outputShapedHard opt)) $ do notice "\nmatch shapes\n"- emptyCanv <- emptyCountCanvas- updateCanv <- updateCountCanvas- finalizeCanv <- finalizeCountCanvasFloat+ emptyCanv <- emptyCountCanvas vec+ updateCanv <- updateCountCanvas cs+ finalizeCanv <- finalizeCountCanvasFloat vec empty <- emptyCanv canvasShape sumImg <- foldM (flip updateCanv) empty rotMovPics avg <- finalizeCanv sumImg- diff <- diffWithCanvas+ diff <- diffWithCanvas cs picDiffs <- mapM (flip diff avg) rotMovPics getSnd <- RenderP.run $ Symb.map (Expr.snd . Expr.untuple) . Symb.fix lp <- lowpassMulti@@ -1896,8 +2220,8 @@ arrayVecFromPair $ ComfortArray.map (\b -> if Bool8.toBool b then 255 else 0) shape - emptyPlainCanv <- emptyCanvas- addMasked <- addMaskedToCanvas+ emptyPlainCanv <- emptyCanvas cs+ addMasked <- addMaskedToCanvas cs emptyPlain <- emptyPlainCanv canvasShape writeImage (Option.quality opt) path =<< foldM@@ -1917,9 +2241,9 @@ writeGrey (Option.quality opt) (printf format name) =<< makeByteImage shape - emptyWeightedCanv <- emptyWeightedCanvas- updateWeightedCanv <- updateShapedCanvas- finalizeWeightedCanv <- finalizeWeightedCanvas+ emptyWeightedCanv <- emptyWeightedCanvas vec+ updateWeightedCanv <- updateShapedCanvas cs+ finalizeWeightedCanv <- finalizeWeightedCanvas cs emptyWeighted <- emptyWeightedCanv canvasShape writeImage (Option.quality opt) path =<< finalizeWeightedCanv =<<@@ -1932,16 +2256,16 @@ rotateTest :: IO () rotateTest = do rot <- runRotate- img <- readImage Verbosity.normal "/tmp/bild/artikel0005.jpeg"+ img <- readYUVImage Verbosity.normal "/tmp/bild/artikel0005.jpeg" forM_ [0..11] $ \k -> do let path = printf "/tmp/rotated/%04d.jpeg" k putStrLn path- writeImage 100 path =<< rot (Degree $ fromInteger k * 30) img+ writeYUVImage 100 path =<< rot (Degree $ fromInteger k * 30) img scoreTest :: IO () scoreTest = do- score <- runScoreRotation- img <- readImage Verbosity.normal "/tmp/bild/artikel0005.jpeg"+ score <- runScoreRotation yuvBrightnessFromByte+ img <- readYUVImage Verbosity.normal "/tmp/bild/artikel0005.jpeg" forM_ [-10..10] $ \k -> do print =<< score (Degree $ fromInteger k / 10) img
src/Knead/Color.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE EmptyDataDecls #-} module Knead.Color where import qualified Data.Array.Knead.Expression as Expr@@ -31,56 +32,59 @@ -data YUV a = YUV a a a+data C3 space a = C3 a a a -instance Functor YUV where- fmap f (YUV y u v) = YUV (f y) (f u) (f v)+type YUV = C3 SpaceYUV; data SpaceYUV+type RGB = C3 SpaceRGB; data SpaceRGB -instance Foldable YUV where- foldMap f (YUV y u v) = f y <> f u <> f v+instance Functor (C3 space) where+ fmap f (C3 y u v) = C3 (f y) (f u) (f v) -instance Traversable YUV where- traverse f (YUV y u v) = liftA3 YUV (f y) (f u) (f v)+instance Foldable (C3 space) where+ foldMap f (C3 y u v) = f y <> f u <> f v -instance Applicative YUV where- pure a = YUV a a a- YUV fy fu fv <*> YUV y u v = YUV (fy y) (fu u) (fv v)+instance Traversable (C3 space) where+ traverse f (C3 y u v) = liftA3 C3 (f y) (f u) (f v) +instance Applicative (C3 space) where+ pure a = C3 a a a+ C3 fy fu fv <*> C3 y u v = C3 (fy y) (fu u) (fv v) -instance (Storable a) => Storable (YUV a) where++instance (Storable a) => Storable (C3 space a) where sizeOf = StoreTrav.sizeOf . lazyElements alignment = StoreTrav.alignment peek = StoreTrav.peekApplicative poke = StoreTrav.poke -lazyElements :: YUV a -> YUV a-lazyElements ~(YUV y u v) = YUV y u v+lazyElements :: C3 space a -> C3 space a+lazyElements ~(C3 y u v) = C3 y u v instance (Storable.Vector a, LLVM.IsPrimitive a, LLVM.IsConst a, NiceVector.C a, NiceVector.Repr TypeNum.D3 a ~ LLVM.Value (LLVM.Vector TypeNum.D3 a)) =>- Storable.C (YUV a) where+ Storable.C (C3 space a) where load = fmap NiceValue.cast . Storable.load <=< castVectorPtr store x = Storable.store (NiceValue.cast x) <=< castVectorPtr castVectorPtr ::- LLVM.Value (Ptr (YUV a)) ->+ LLVM.Value (Ptr (C3 space a)) -> LLVM.CodeGenFunction r (LLVM.Value (Ptr (LLVM.Vector TypeNum.D3 a))) castVectorPtr = LLVM.bitcast instance (LLVM.IsPrimitive a, LLVM.IsConst a) =>- Tuple.Value (YUV a) where- type ValueOf (YUV a) = LLVM.Value (LLVM.Vector TypeNum.D3 a)- valueOf (YUV a0 a1 a2) = LLVM.valueOf $ LLVM.consVector a0 a1 a2+ Tuple.Value (C3 space a) where+ type ValueOf (C3 space a) = LLVM.Value (LLVM.Vector TypeNum.D3 a)+ valueOf (C3 a0 a1 a2) = LLVM.valueOf $ LLVM.consVector a0 a1 a2 instance (LLVM.IsPrimitive a, LLVM.IsConst a) =>- NiceValue.C (YUV a) where- type Repr (YUV a) = LLVM.Value (LLVM.Vector TypeNum.D3 a)- cons (YUV a0 a1 a2) =+ NiceValue.C (C3 space a) where+ type Repr (C3 space a) = LLVM.Value (LLVM.Vector TypeNum.D3 a)+ cons (C3 a0 a1 a2) = NiceValue.Cons $ LLVM.valueOf $ LLVM.consVector a0 a1 a2 undef = NiceValue.undefTuple zero = NiceValue.zeroTuple@@ -88,26 +92,55 @@ addPhi = NiceValue.addPhiTuple -yuv ::+cons :: (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>- Exp a -> Exp a -> Exp a -> Exp (YUV a)-yuv =+ Exp a -> Exp a -> Exp a -> Exp (C3 space a)+cons = Expr.liftReprM3 (\y u v -> do arr0 <- LLVM.insertelement Tuple.undef y (LLVM.valueOf 0) arr1 <- LLVM.insertelement arr0 u (LLVM.valueOf 1) LLVM.insertelement arr1 v (LLVM.valueOf 2)) -brightness ::+yuv :: (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>+ Exp a -> Exp a -> Exp a -> Exp (YUV a)+yuv = cons++rgb ::+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>+ Exp a -> Exp a -> Exp a -> Exp (RGB a)+rgb = cons++class Space space where+ brightness ::+ (NiceValue.Field a, NiceValue.RationalConstant a, NiceValue.Real a,+ LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>+ Exp (C3 space a) -> Exp a++luma ::+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) => Exp (YUV a) -> Exp a-brightness =- Expr.liftReprM (flip LLVM.extractelement (LLVM.valueOf 0))+luma = Expr.liftReprM (flip LLVM.extractelement (LLVM.valueOf 0)) +instance Space SpaceYUV where+ brightness = luma++red, green, blue ::+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) =>+ Exp (RGB a) -> Exp a+red = Expr.liftReprM (flip LLVM.extractelement (LLVM.valueOf 0))+green = Expr.liftReprM (flip LLVM.extractelement (LLVM.valueOf 1))+blue = Expr.liftReprM (flip LLVM.extractelement (LLVM.valueOf 2))++instance Space SpaceRGB where+ brightness c = 0.299 * red c + 0.587 * green c + 0.114 * blue c++ mapPlain :: (LLVM.IsPrimitive a, LLVM.IsPrimitive b) => (forall r. LLVM.Value a -> LLVM.CodeGenFunction r (LLVM.Value b)) ->- Exp (YUV a) -> Exp (YUV b)+ Exp (C3 space a) -> Exp (C3 space b) mapPlain f = Expr.liftReprM (Vector.map f) exprUnliftM1 ::@@ -119,5 +152,5 @@ map :: (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a, LLVM.IsPrimitive b, NiceValue.Repr b ~ LLVM.Value b) =>- (Exp a -> Exp b) -> Exp (YUV a) -> Exp (YUV b)+ (Exp a -> Exp b) -> Exp (C3 space a) -> Exp (C3 space b) map f = mapPlain (exprUnliftM1 f)