patch-image 0.3.2 → 0.3.2.1
raw patch · 3 files changed
+37/−27 lines, 3 files
Files
- patch-image.cabal +2/−2
- src/Knead.hs +33/−25
- src/Knead/Shape.hs +2/−0
patch-image.cabal view
@@ -1,5 +1,5 @@ Name: patch-image-Version: 0.3.2+Version: 0.3.2.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -41,7 +41,7 @@ README.md Source-Repository this- Tag: 0.3.2+ Tag: 0.3.2.1 Type: darcs Location: http://hub.darcs.net/thielema/patch-image/
src/Knead.hs view
@@ -16,7 +16,7 @@ layoutFromPairDisplacements, fixAtLeastOneAnglePosition, ) import Knead.Shape- (Size, Vec2(Vec2), Dim1, Dim2, Shape2, Index2, Ix2,+ (Size, Vec2(Vec2), Dim1, Dim2, Shape2, Index2, Ix2, Factor2, verticalVal, horizontalVal) import Degree (Degree(Degree), getDegree) @@ -244,8 +244,17 @@ atomIx2 :: Index2 (Atom i) atomIx2 = Vec2 atom atom +atomFactor2 :: Factor2 (Atom i)+atomFactor2 = Vec2 atom atom++decomposeDim2 :: Exp (Shape2 i) -> Shape2 (Exp i)+decomposeDim2 = Expr.decompose atomDim2++decomposeFactor2 :: Exp (Factor2 i) -> Factor2 (Exp i)+decomposeFactor2 = Expr.decompose atomFactor2+ dim2 :: Exp i -> Exp i -> Exp (Shape2 i)-dim2 y x = Expr.compose (Vec2 y x)+dim2 h w = Expr.compose (Vec2 h w) ix2 :: Exp i -> Exp i -> Exp (Index2 i) ix2 y x = Expr.compose (Vec2 y x)@@ -260,7 +269,7 @@ indexLimit :: SymbPlane a -> Index2 (Exp Size) -> Exp a indexLimit img (Vec2 y x) =- let (Vec2 height width) = Expr.decompose atomDim2 $ Symb.shape img+ let (Vec2 height width) = decomposeDim2 $ Symb.shape img xc = Expr.max 0 $ Expr.min (width -1) x yc = Expr.max 0 $ Expr.min (height-1) y in img ! ix2 yc xc@@ -270,8 +279,8 @@ Exp Dim2 -> array sh Ix2 -> array sh Ix2 limitIndices sh = Symb.map- (case Expr.decompose atomDim2 sh of- (Vec2 height width) ->+ (case decomposeDim2 sh of+ Vec2 height width -> Expr.modify atomIx2 $ \(Vec2 y x) -> let xc = Expr.max 0 $ Expr.min (width -1) x@@ -446,7 +455,7 @@ SymbPlane (Bool8, v) rotateStretchMove vec rot mov sh img = let coords = rotateStretchMoveCoords rot mov sh- (Vec2 heightSrc widthSrc) = Expr.decompose atomDim2 $ Symb.shape img+ (Vec2 heightSrc widthSrc) = decomposeDim2 $ Symb.shape img in Symb.zip (validCoords (widthSrc, heightSrc) coords) (gatherFrac vec img $@@ -462,7 +471,7 @@ SymbPlane v -> SymbPlane v rotate vec rot img =- let (Vec2 height width) = Expr.decompose atomDim2 $ Symb.shape img+ let (Vec2 height width) = decomposeDim2 $ Symb.shape img ((left, right), (top, bottom)) = Arith.boundingBoxOfRotatedGen (Expr.min, Expr.max) (Expr.unzip rot) (fromSize2 (width, height))@@ -563,14 +572,14 @@ -- counterpart to 'clip' pad :: (MultiValue.C a) => Exp a -> Exp Dim2 -> SymbPlane a -> SymbPlane a pad a sh img =- let Vec2 height width = Expr.decompose atomDim2 $ Symb.shape img+ let Vec2 height width = decomposeDim2 $ Symb.shape img in generate sh $ \p -> let Vec2 y x = Expr.decompose atomIx2 p in Expr.ifThenElse (y<*height &&* x<*width) (img ! p) a cyclicReverse2d :: (MultiValue.C a) => SymbPlane a -> SymbPlane a cyclicReverse2d spec =- let (Vec2 height width) = Expr.decompose atomDim2 $ Symb.shape spec+ let (Vec2 height width) = decomposeDim2 $ Symb.shape spec in Symb.backpermute (Symb.shape spec) (Expr.modify atomIx2 $ \(Vec2 y x) -> Vec2@@ -642,7 +651,7 @@ displacementMap :: Exp Size -> Exp Size -> Exp Dim2 -> SymbPlane (Size, Size) displacementMap xsplit ysplit sh =- let Vec2 height width = Expr.decompose atomDim2 sh+ let Vec2 height width = decomposeDim2 sh in generate sh $ Expr.modify atomIx2 $ \(Vec2 y x) -> (wrap width xsplit x, wrap height ysplit y) @@ -683,8 +692,8 @@ SymbPlane (Float, (Size, Size)) allOverlapsFromCorrelation (Vec2 height width) minOverlapPortion = \sha shb correlated ->- let (Vec2 heighta widtha) = Expr.decompose atomDim2 sha- (Vec2 heightb widthb) = Expr.decompose atomDim2 shb+ let (Vec2 heighta widtha) = decomposeDim2 sha+ (Vec2 heightb widthb) = decomposeDim2 shb half = flip Expr.idiv 2 minOverlap = fastRound $@@ -749,7 +758,7 @@ shrink :: (MultiValue.Field a, MultiValue.RationalConstant a, MultiValue.Real a, MultiValue.NativeFloating a ar) =>- Shape2 (Exp Size) -> SymbPlane a -> SymbPlane a+ Factor2 (Exp Size) -> SymbPlane a -> SymbPlane a shrink (Vec2 yk xk) = Symb.map (/ (fromInt xk * fromInt yk)) . Symb.fold1 Expr.add .@@ -767,7 +776,7 @@ independent from whether minOverlap is zero or not. -} shrinkFactors ::- (Integral a) => Dim2 -> Float -> Shape2 a -> Shape2 a -> Shape2 a+ (Integral a) => Dim2 -> Float -> Shape2 a -> Shape2 a -> Factor2 a shrinkFactors (Vec2 heightPad widthPad) minOverlapPortion (Vec2 heighta widtha) (Vec2 heightb widthb) = let minOverlap =@@ -785,7 +794,7 @@ since we expect that the user chooses an FFT friendly target size. -} shrinkFactorsAlt ::- (Bits a, Integral a) => Float -> Dim2 -> Shape2 a -> Shape2 a -> Shape2 a+ (Bits a, Integral a) => Float -> Dim2 -> Shape2 a -> Shape2 a -> Factor2 a shrinkFactorsAlt minOverlapPortion (Vec2 heightPad widthPad) a b = let (widthc,heightc) = Arith.correlationSize minOverlapPortion $@@ -798,7 +807,7 @@ optimalOverlapBig :: Dim2 -> IO (Float -> Plane Float -> Plane Float -> IO (Float, (Size, Size))) optimalOverlapBig padExtent = do- shrnk <- RenderP.run $ shrink . Expr.decompose atomDim2+ shrnk <- RenderP.run $ shrink . decomposeFactor2 optOverlap <- optimalOverlap padExtent return $ \minimumOverlap a b -> do let factors@(Vec2 yk xk) =@@ -815,8 +824,7 @@ (Exp Size, Exp Size) -> SymbPlane a -> SymbPlane a clip (left,top) (width,height) =- Symb.backpermute- (Expr.compose $ Vec2 height width)+ Symb.backpermute (dim2 height width) (Expr.modify (Vec2 atom atom) $ \(Vec2 y x) -> Vec2 (y+top) (x+left)) @@ -877,7 +885,7 @@ IO (Float -> Maybe Float -> Plane Float -> Plane Float -> IO [(Float, (Size, Size), (Size, Size))]) optimalOverlapBigMulti padExtent (Vec2 heightStamp widthStamp) numCorrs = do- shrnk <- RenderP.run $ shrink . Expr.decompose atomDim2+ shrnk <- RenderP.run $ shrink . decomposeFactor2 optOverlap <- optimalOverlap padExtent overDiff <- overlapDifferenceRun clp <- RenderP.run clip@@ -944,8 +952,8 @@ (Exp Size, Exp Size) -> SymbPlane a -> SymbPlane a -> Exp a overlapDifference (dx,dy) a b =- let (Vec2 heighta widtha) = Expr.decompose atomDim2 $ Symb.shape a- (Vec2 heightb widthb) = Expr.decompose atomDim2 $ Symb.shape b+ let (Vec2 heighta widtha) = decomposeDim2 $ Symb.shape a+ (Vec2 heightb widthb) = decomposeDim2 $ Symb.shape b leftOverlap = Expr.max 0 dx topOverlap = Expr.max 0 dy rightOverlap = Expr.min widtha (widthb + dx)@@ -973,8 +981,8 @@ (Exp Size, Exp Size) -> (SymbPlane v, SymbPlane v) -> SymbPlane v overlap2 vec (dx,dy) (a,b) =- let (Vec2 heighta widtha) = Expr.decompose atomDim2 $ Symb.shape a- (Vec2 heightb widthb) = Expr.decompose atomDim2 $ Symb.shape b+ let (Vec2 heighta widtha) = decomposeDim2 $ Symb.shape a+ (Vec2 heightb widthb) = decomposeDim2 $ Symb.shape b left = Expr.min 0 dx; right = Expr.max widtha (widthb + dx) top = Expr.min 0 dy; bottom = Expr.max heighta (heightb + dy) width = right - left@@ -1291,8 +1299,8 @@ SymbPlane a -> SymbPlane Word8 scaleDistanceMap img = let scale =- case Expr.decompose atomDim2 $ Symb.shape img of- Vec2 y x -> 4 / fromInt (Expr.min x y)+ case decomposeDim2 $ Symb.shape img of+ Vec2 h w -> 4 / fromInt (Expr.min w h) in imageByteFromFloat $ Symb.map (scale*) img
src/Knead/Shape.hs view
@@ -51,9 +51,11 @@ data ShapeTag data IndexTag+data FactorTag type Shape2 = Vec2 ShapeTag type Index2 = Vec2 IndexTag+type Factor2 = Vec2 FactorTag