diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 diff --git a/README b/README --- a/README +++ b/README @@ -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, diff --git a/explore.cabal b/explore.cabal --- a/explore.cabal +++ b/explore.cabal @@ -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 -bug-reports: Cetin Sert -homepage: http://sert.homedns.org/hs/explore/ +author: Cetin Sert +maintainer: Cetin Sert +bug-reports: Cetin Sert +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