explore 0.0.5.1 → 0.0.6.0
raw patch · 3 files changed
+174/−44 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- Main.hs +80/−33
- README +85/−3
- explore.cabal +9/−8
Main.hs view
@@ -16,7 +16,7 @@ type Name = String -- | 32-bit color representation -data RGBA = RGBA Word8 Word8 Word8 Word8 -- ^ RED BLUE GREEN ALPHA+data RGBA = RGBA !Word8 !Word8 !Word8 !Word8 -- ^ RED BLUE GREEN ALPHA deriving (Show, Read, Eq) -- storable instance for retrieveal @@ -24,9 +24,9 @@ sizeOf _ = sizeOf (0 :: Word8) * 4 alignment _ = 1 peek color = do - let byte :: Ptr Word8 = castPtr color- [r,g,b,a] <- mapM (byte @!) [0..3] - return $ RGBA r g b a + let byte :: Ptr Word8 = castPtr color+ [r,g,b,a] <- mapM (byte @!) [0..3] + return $ RGBA r g b a -- | colour matching behaviour data Matching = S -- ^ strict@@ -37,30 +37,52 @@ -- | scan area -- w = width of the PNG image -- h = height of the PNG image-data ScanArea = F -- ^ search all the area (FULL) | 0 0 w h+data ScanArea = F -- ^ scan all the image area (FULL) | 0 0 w h | O Int Int -- ^ offset from LEFT TOP | L T w h | M Int Int Int Int -- ^ offset from LEFT TOP RIGHT BOTTOM | L T (w-R) (h-B)- | A Int Int Int Int -- ^ area LEFT TOP RIGHT BOTTOM | L T R B+ | B Int Int Int Int -- ^ box LEFT TOP RIGHT BOTTOM | L T R B deriving (Show, Read, Eq) +-- | vertical offset reference line+data VerticalOffsetReferenceLine = Top -- ^ top line of plot box+ | Bottom -- ^ bottom line of plot box+ deriving (Show, Read, Eq)++-- | translation+data Translation = Identity -- ^ identity translation+ | Box VerticalOffsetReferenceLine -- ^ box translation+ deriving (Show, Read, Eq)+ -- | normalizes scan area representations-normalize :: Int -> Int -> ScanArea -> ScanArea-normalize w h F = A 0 0 w h-normalize w h (O l t) = A l t w h-normalize w h (M l t r b) = A l t (w-r) (h-b)-normalize _ _ area = area+normalizeScanArea :: Int -> Int -> ScanArea -> ScanArea+normalizeScanArea w h F = B 0 0 w h+normalizeScanArea w h (O l t) = B l t w h+normalizeScanArea w h (M l t r b) = B l t (w-r) (h-b)+normalizeScanArea _ _ box = box -- | ExPloRe requires PNGs with transparency channel and no interlacing checkAlpha :: PNGImage -> IO ()-checkAlpha img = case hasAlphaChannel img of- True -> return ()- _ -> putStrLn "no alpha channel going on!!!" >> exitWith (ExitFailure 1)+checkAlpha (hasAlphaChannel -> True) = return ()+checkAlpha _ = putStrLn "no alpha channel going on!!!" >> exitWith (ExitFailure 1) - +-- | check presence of arguments, show usage otherwise+checkArgs :: [String] -> IO ()+checkArgs [] = readFile "README" >>= putStrLn >> exitWith (ExitFailure 1)+checkArgs _ = return ()+++-- | main program main :: IO () main = do- putStrLn $ "ExPloRe 0.0.5.1 : Experimental Plot Reconstructor"- args@(imgPath:legendPath:matching_:area_:step_:_) <- getArgs+ putStrLn $ "ExPloRe 0.0.6.0 : Experimental Plot Reconstructor"+ args <- getArgs+ checkArgs args+ let (imgPath:legendPath:matching_:area_:step_:oargs) = args++ -- optional arguments+ let translation = case null oargs of+ True -> Box Bottom+ _ -> read . head $ oargs -- initialize image Right img <- loadPNGFile imgPath @@ -77,7 +99,7 @@ putStrLn $ "" checkAlpha img -- initialize scan- let area@(A l t r b) = normalize w h . read $ area_ :: ScanArea+ let box@(B l t r b) = normalizeScanArea w h . read $ area_ :: ScanArea let start = fromIntegral l :: Double let step = read step_ :: Double let (@#) = make2DIndexer w@@ -86,7 +108,9 @@ let icols = zip [1..] cols let matching = read matching_ :: Matching let (~=) = colorEq matching- putStrLn $ "area : " ++ show area+ putStrLn $ "box : " ++ show box+ putStrLn $ "width : " ++ show (r - l)+ putStrLn $ "height: " ++ show (b - t) putStrLn $ "match : " ++ show matching -- initialize lines@@ -99,30 +123,53 @@ mapM_ (putStrLn . show) lines -- scan bitmap - mapM_ (scan bitmap area icols rows (@#) (~=)) lines + mapM_ (scan bitmap translation box icols rows (@#) (~=)) lines -- | a very simple scanning algorithm that works only if no lines--- occlude each other. -scan bitmap (A l t r b) icols rows (@#) (~=) (name,color) = do +-- occlude each other.+scan bitmap translation box@(B l t r b) icols rows (@#) (~=) (name,color) = do putStrLn $ "" putStrLn $ "-------------------------------------------------------------------"- putStrLn $ show color - putStrLn $ "" putStrLn $ name - putStrLn $ "" - putStrLn $ "point\tx\tmid y\tmatches y" + putStrLn $ ""+ putStrLn $ show color + putStrLn $ ""+ putStrLn $ "box : " ++ show box + putStrLn $ "width : " ++ show (r - l)+ putStrLn $ "height : " ++ show (b - t)+ putStrLn $ "translation: " ++ show translation + putStrLn $ ""+ putStrLn $ "x\tpoint\tmid y\tmatching ys" putStrLn $ "" withStorableArray bitmap $ \byte -> do - let pixel :: Ptr RGBA = castPtr byte + let pixel :: Ptr RGBA = castPtr byte+ let (hof,vof) = makeTranslationFunctions translation box forM_ icols $ \(n,j) -> do - let matches = flip filter rows $ \i -> (pixel @# i) j ~= color - let m = mid matches - t- putStrLn $ case not . null $ matches of - True -> show n ++ "\t" ++ show j ++ "\t" ++ show m ++ "\t" ++ show matches - False -> show n ++ "\t" ++ show j ++ "\t \t[]" + let ys = map vof $ flip filter rows $ \i -> (pixel @# i) j ~= color + let my = mid ys+ let x = hof j+ putStrLn $ case not . null $ ys of + True -> show x ++ "\t" ++ show n ++ "\t" ++ show my ++ "\t" ++ show ys + False -> show x ++ "\t" ++ show n ++ "\t \t[]" +-- | translation functions+type HorizontalTranslationFunction = Int -> Int+type VerticalTranslationFunction = Int -> Int++makeTranslationFunctions :: Translation+ -> ScanArea+ -> (HorizontalTranslationFunction,+ VerticalTranslationFunction)++makeTranslationFunctions Identity _ = (id, id)+makeTranslationFunctions (Box Top ) (B l t r b) = ((− l),(− t))+makeTranslationFunctions (Box Bottom) (B l t r b) = ((− l),(b −))++(−) = (-)++ -- | fuzzy color matching colorEq :: Matching -> RGBA -> RGBA -> Bool colorEq S = compEq 0 0 0 0@@ -139,7 +186,7 @@ fuzzyEq 0 = (==) fuzzyEq t = \x y -> t > (abs $ fromIntegral x - fromIntegral y) --- | gets the middle element of a list+-- | gets the middle element of a list, used as a quick median function mid :: forall a. [a] -> a mid xs = xs !! (fromIntegral . floor . (/ 2) . fromIntegral . length) xs
README view
@@ -1,3 +1,79 @@+SYNOPSIS++ explore image legend tolerance scan-area interval [translation]+++DESCRIPTION+++ image the image file to scan, it should be a 32-bit PNG with an alpha+ channel++++ legend the legend file that contains a list of names and base line+ colors in this format++ [("Frame", RGBA 255 0 0 255),("Line", RGBA 0 0 255 255)]++++ tolerance how much color components can deviate from base colors+ + S strict: allow no deviation (= TC 0 0 0 0)++ TA m maximum delta for all components (= TC m m m m)++ TC r g b a individiual maximum delta values+ for corresponding components++++ scan-area which part of the image is to be scanned++ (w = image width, h = image height)++ F all image area (= B 0 0 w h)++ O l t offset from left and top (= B l t w h)++ M l t r b margins from left, top, (= B l t w-r h-b)+ right and bottom++ B l t r b a plot box; with left, top, right and bottom+ positions in pixels++++ interval horizontal scan interval in pixels, this value is read as+ a floating point number so you can give 4,5 for a scan++ + + translation 2d translation to be applied to the output pixels++ Identity output pixels exactly as they are located+ in the input image; old default with full+ scan area++ Box Bottom output pixel positions relevant to the left+ and bottom lines of the plot box; new default++ Box Top output pixel positions relevant to the left+ and top lines of the plot box+++HISTORY++ 0.0.6+ - Added basic 2D translation support+ - Changed default 2D translation from Identity to "Box Bottom"+ To get old behaviour from previous versions: use Identity++ 0.0.5+ - First version created in collaboration with An Le Thi Thanh++ KNOWN ISSUES - It is only a very early hack ^__^"!!@@ -26,8 +102,14 @@ from Sayoro, Burkina Faso September 2005 + - To create the example outputs: - explore 39-cisse-x.png 39-legend "TC 100 150 150 150" F 20.83- explore 39-goni-x.png 39-legend "TC 100 150 150 150" F 20.83- explore 39-nouna-x.png 39-legend "TC 100 150 150 150" F 20.83+ explore 39-cisse-x.png 39-legend "TC 100 150 150 150" F 20.83 Identity+ explore 39-goni-x.png 39-legend "TC 100 150 150 150" F 20.83 Identity+ explore 39-nouna-x.png 39-legend "TC 100 150 150 150" F 20.83 Identity+++CONTACT++ Cetin Sert, <cetin.sert@gmail.com>
explore.cabal view
@@ -1,13 +1,13 @@ name: explore-version: 0.0.5.1-cabal-version: >= 1.2+version: 0.0.6.0+cabal-version: >= 1.4 license: BSD3 license-file: LICENSE copyright: (c) 2009, Cetin Sert-author: An Le Thi Thanh, Cetin Sert-maintainer: Cetin Sert <cetin@sertcom.de>-bug-reports: Cetin Sert <cetin@sertcom.de>-homepage: http://sert.homedns.org/hs/explore/+author: Cetin Sert+maintainer: Cetin Sert <cetin.sert@gmail.com>+bug-reports: Cetin Sert <cetin.sert@gmail.com>+homepage: http://corsis.sf.net category: Graphics synopsis: Experimental Plot data Reconstructor description: Very first prototype of a command line tool to@@ -34,7 +34,8 @@ Executable explore buildable: True main-is: Main.hs- ghc-options: -O2 -fglasgow-exts- build-depends: base <= 4.2,+ ghc-options: -O2 -fglasgow-exts -funbox-strict-fields+ build-depends: base <= 5, array -any, pngload -any+ extensions: ViewPatterns