explore 0.0.6.2 → 0.0.7.0
raw patch · 3 files changed
+160/−95 lines, 3 filesdep +directory
Dependencies added: directory
Files
- Help.hs +21/−10
- Main.hs +136/−83
- explore.cabal +3/−2
Help.hs view
@@ -9,8 +9,8 @@ \DESCRIPTION\n\ \\n\ \\n\-\ image the image file to scan, it should be a 32-bit PNG with an alpha\n\-\ channel\n\+\ image the image file to scan, it should be a 32-bit PNG with an\n\+\ alpha channel\n\ \\n\ \\n\ \\n\@@ -23,9 +23,9 @@ \\n\ \ tolerance how much color components can deviate from base colors\n\ \ \n\-\ S strict: allow no deviation (= TC 0 0 0 0)\n\+\ S strict: allow no deviation (= TC 0 0 0 0)\n\ \\n\-\ TA m maximum delta for all components (= TC m m m m)\n\+\ TA m maximum delta for all components (= TC m m m m)\n\ \\n\ \ TC r g b a individiual maximum delta values\n\ \ for corresponding components\n\@@ -36,11 +36,11 @@ \\n\ \ (w = image width, h = image height)\n\ \\n\-\ F all image area (= B 0 0 w h)\n\+\ F all image area (= B 0 0 w h)\n\ \\n\-\ O l t offset from left and top (= B l t w h)\n\+\ O l t offset from left and top (= B l t w h)\n\ \\n\-\ M l t r b margins from left, top, (= B l t w-r h-b)\n\+\ M l t r b margins from left, top, (= B l t w-r h-b)\n\ \ right and bottom\n\ \\n\ \ B l t r b a plot box; with left, top, right and bottom\n\@@ -48,12 +48,19 @@ \\n\ \\n\ \\n\-\ interval horizontal scan interval in pixels, this value is read as\n\-\ a floating point number so you can give 4,5 for a scan\n\+\ step-size horizontal step-size, this value is read as a floating point\n\+\ number\n\ \\n\+\ (w = image width)\n\+\\n\+\ <s::DOUBLE> double-precision constant step size s\n\+\\n\+\ /<n::DOUBLE> double-precision step-size gained by dividing\n\+\ the width of the image by n\n\+\\n\ \ \n\ \ \n\-\ translation 2d translation to be applied to the output pixels\n\+\ [translation] 2d translation to be applied to the output pixels\n\ \\n\ \ Identity output pixels exactly as they are located\n\ \ in the input image; old default with full\n\@@ -67,6 +74,10 @@ \\n\ \\n\ \HISTORY\n\+\\n\+\ 0.0.7\n\+\ - Support for invocation files\n\+\ - Support for calculating step sizes by dividing the scan area\n\ \\n\ \ 0.0.6.2\n\ \ - Fixed help output\n\
Main.hs view
@@ -1,9 +1,11 @@--- (c) 2009, Cetin Sert+-- Copyright 2009, Cetin Sert+ -- | ExPloRe: Experimental Plot Reconstructor module Main where -import System.Environment +import System.Environment+import System.Directory import System.IO.Unsafe import System.Exit import Data.Word @@ -13,11 +15,21 @@ import Control.Monad import Codec.Image.PNG -import Help +import Help -- | line names in legends -type Name = String +type Name = String +-- | file paths+type ImagePath = String++-- | legends+type Legend = [(Name, RGBA)]++-- | internal representation of an unnormalized explore invocation+data ExploreInvocation = Explore ImagePath Legend Matching ScanArea StepSize Translation+ deriving (Show, Read, Eq)+ -- | 32-bit color representation data RGBA = RGBA !Word8 !Word8 !Word8 !Word8 -- ^ RED BLUE GREEN ALPHA deriving (Show, Read, Eq)@@ -50,12 +62,17 @@ 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+ | Default -- ^ gets normalized to the default translation deriving (Show, Read, Eq) +-- | step size+data StepSize = ConstantJump Double -- ^ only step size supported upto version 0.0.6.2+ | WidthDivision Double -- ^+ deriving (Show, Read, Eq) + -- | normalizes scan area representations normalizeScanArea :: Int -> Int -> ScanArea -> ScanArea normalizeScanArea w h F = B 0 0 w h@@ -63,6 +80,46 @@ normalizeScanArea w h (M l t r b) = B l t (w-r) (h-b) normalizeScanArea _ _ box = box +-- | horizontal translation function+type HTrans = Int -> Int++-- | vertical translation function+type VTrans = Int -> Int++-- | creates translation functions+makeTranslationFunctions :: Translation -> ScanArea -> (HTrans, VTrans)+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+colorEq (TA v) = compEq v v v v+colorEq (TC r g b a) = compEq r g b a++-- | fuzzy color matching+compEq :: Int -> Int -> Int -> Int -> RGBA -> RGBA -> Bool +compEq tr tg tb ta (RGBA a b c d) (RGBA x y z w) = let fe = fuzzyEq in+ fe tr a x && fe tg b y && fe tb c z && fe ta d w++-- | simple fuzzy equality+fuzzyEq :: forall b a. (Num b, Ord b, Integral a) => b -> a -> a -> Bool+fuzzyEq 0 = (==)+fuzzyEq t = \x y -> t > (abs $ fromIntegral x - fromIntegral y)++-- | 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 + +(@!) :: Storable a => Ptr a -> Int -> IO a +(@!) = peekElemOff + +make2DIndexer :: Storable a => Int -> Ptr a -> Int -> Int -> a +make2DIndexer w = \p j i -> unsafePerformIO $ p @! (i + j * w)+ -- | ExPloRe requires PNGs with transparency channel and no interlacing checkAlpha :: PNGImage -> IO () checkAlpha (hasAlphaChannel -> True) = return ()@@ -73,70 +130,107 @@ checkArgs [] = putStrLn help >> exitSuccess checkArgs _ = return () -hrule :: String-hrule = replicate 80 '-'+hrule :: Char -> String+hrule = replicate 80 --- | main program -main :: IO () +-- | main+main :: IO () main = do- putStrLn $ "ExPloRe 0.0.6.2 : Experimental Plot Reconstructor"- putStrLn $ hrule- putStrLn $ ""+ putStrLn $ "ExPloRe 0.0.7 : Experimental Plot Reconstructor"+ putStrLn $ hrule '=' args <- getArgs checkArgs args- let (imgPath:legendPath:matching_:area_:step_:oargs) = args+ putStrLn $ "invocation file"+ putStrLn $ hrule '-' ++ tail (filter (/= '"') $ concatMap (('\n':) . show) args) ++ "\n" ++ hrule '-'+ explore <- makeInvocation args+ run explore - -- optional arguments- let translation = case null oargs of- True -> Box Bottom- _ -> read . head $ oargs- - -- initialize image +-- | supports invocation files and provides backwards-compatibility with+-- 0.0.6.2 style command line arguments+makeInvocation :: [String] -> IO ExploreInvocation++makeInvocation [invocationPath] = do+ makeInvocation =<< (liftM lines . readFile $ invocationPath)++makeInvocation args = do+ putStrLn $ "args : " ++ show args+ let (imgPath:legend_:matching_:area_:step_:oargs) = args+ matching <- return . read $ matching_+ area <- return . read $ area_+ lfexists <- doesFileExist legend_+ legend <- case lfexists of+ True -> liftM read . readFile $ legend_+ _ -> return . read $ legend_+ stepSize <- return $ case step_ of+ ('/':parts) -> WidthDivision $ read parts+ size -> ConstantJump $ read size+ translation <- return $ case null oargs of+ True -> Box Bottom+ _ -> read . head $ oargs + return $ Explore imgPath legend matching area stepSize translation+++-- | new run function+run :: ExploreInvocation -> IO ()+run invocation@(Explore imgPath legend matching area stepSize translation) = do+ -- display internal normalized invocation+ -- putStrLn $ "invoc.: " ++ show invocation+ -- putStrLn $ ""++ -- initialize image Right img <- loadPNGFile imgPath let bitmap = imageData img let (wu,hu) = dimensions img - let (w,h) = (fromIntegral wu, fromIntegral hu) - putStrLn $ "call : " ++ tail (filter (/= '"') $ concatMap ((' ':) . show) args)- putStrLn $ "" + let (w,h) = (fromIntegral wu, fromIntegral hu)+ args <- getArgs putStrLn $ "image : " ++ imgPath putStrLn $ "width : " ++ show w putStrLn $ "height: " ++ show h- putStrLn $ "" - checkAlpha img + checkAlpha img+ -- initialize scan- let box@(B l t r b) = normalizeScanArea w h . read $ area_ :: ScanArea+ let box@(B l t r b) = normalizeScanArea w h area :: ScanArea let start = fromIntegral l :: Double- let step = read step_ :: Double + let end = fromIntegral r :: Double+ let step = case stepSize of+ ConstantJump size -> size+ WidthDivision parts -> (end - start) / parts+ let trans = case translation of+ Default -> Box Bottom+ any -> any let (@#) = make2DIndexer w let rows = [t..b]- let cols = takeWhile (< r) $ map (floor . (start +) . (step *)) [0..] + let cols = takeWhile (< r) $ map (floor . (start +) . (step *)) [0..] let icols = zip [1..] cols- let matching = read matching_ :: Matching let (~=) = colorEq matching putStrLn $ "box : " ++ show box putStrLn $ "width : " ++ show (r - l) putStrLn $ "height: " ++ show (b - t)- putStrLn $ "match : " ++ show matching + putStrLn $ "trans.: " ++ show trans+ putStrLn $ "match : " ++ show matching+ putStrLn $ "step : " ++ show stepSize+ putStrLn $ "step : " ++ (show $ convertStepSize (end - start) stepSize) - -- initialize lines- lines_ <- readFile legendPath - let lines = read lines_ :: [(Name,RGBA)]- putStrLn $ "legend: " ++ legendPath - putStrLn $ "lines : " ++ (show $ length lines)- putStrLn $ "step : " ++ show step- putStrLn $ "" - mapM_ (putStrLn . show) lines- - -- scan bitmap - mapM_ (scan bitmap translation box icols rows (@#) (~=)) lines+ -- display legend+ putStrLn $ "#lines: " ++ (show . length $ legend)+ putStrLn $ ""+ mapM_ (putStrLn . show) legend + -- scan bitmap+ mapM_ (scan bitmap translation box icols rows (@#) (~=)) legend +convertStepSize :: Double -> StepSize -> StepSize+convertStepSize width (ConstantJump size ) = WidthDivision $ width / size+convertStepSize width (WidthDivision parts) = ConstantJump $ width / parts+++ -- | a very simple scanning algorithm that works only if no lines -- occlude each other. scan bitmap translation box@(B l t r b) icols rows (@#) (~=) (name,color) = do putStrLn $ "" - putStrLn $ hrule+ putStrLn $ hrule '-' putStrLn $ name putStrLn $ "" putStrLn $ show color @@ -159,45 +253,4 @@ 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-colorEq (TA v) = compEq v v v v-colorEq (TC r g b a) = compEq r g b a---- | fuzzy color matching-compEq :: Int -> Int -> Int -> Int -> RGBA -> RGBA -> Bool -compEq tr tg tb ta (RGBA a b c d) (RGBA x y z w) = let fe = fuzzyEq in- fe tr a x && fe tg b y && fe tb c z && fe ta d w---- | simple fuzzy equality-fuzzyEq :: forall b a. (Num b, Ord b, Integral a) => b -> a -> a -> Bool-fuzzyEq 0 = (==)-fuzzyEq t = \x y -> t > (abs $ fromIntegral x - fromIntegral y)---- | 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 - -(@!) :: Storable a => Ptr a -> Int -> IO a -(@!) = peekElemOff - -make2DIndexer :: Storable a => Int -> Ptr a -> Int -> Int -> a -make2DIndexer w = \p j i -> unsafePerformIO $ p @! (i + j * w)+-- Copyright 2010, Cetin Sert
explore.cabal view
@@ -1,9 +1,9 @@ name: explore-version: 0.0.6.2+version: 0.0.7.0 cabal-version: >= 1.4 license: BSD3 license-file: LICENSE-copyright: (c) 2009, Cetin Sert+copyright: Copyright 2009, 2010, Cetin Sert author: Cetin Sert maintainer: Cetin Sert <cetin.sert@gmail.com> bug-reports: Cetin Sert <cetin.sert@gmail.com>@@ -37,6 +37,7 @@ main-is: Main.hs ghc-options: -O2 -fglasgow-exts -funbox-strict-fields build-depends: base <= 5,+ directory -any, array -any, pngload -any extensions: ViewPatterns