aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2017-03-01 06:37:57 -0700
committerSean Whitton <spwhitton@spwhitton.name>2017-03-01 06:37:57 -0700
commit589827273e55e9abe7194a0d6271ca97719e8911 (patch)
treed355b3a33a5a948e259ddf7843391b47b48e3e03
parent67a213e550f82936dadf83918f40ff68f2cb51f9 (diff)
downloadsscan-589827273e55e9abe7194a0d6271ca97719e8911.tar.gz
implement scanPage
-rw-r--r--Main.hs42
-rw-r--r--Types/State.hs5
-rw-r--r--sscan.cabal1
3 files changed, 43 insertions, 5 deletions
diff --git a/Main.hs b/Main.hs
index d7ac33a..ecc2fed 100644
--- a/Main.hs
+++ b/Main.hs
@@ -27,8 +27,10 @@ import Control.Concurrent (forkIO)
import Control.Monad (void)
import Lens.Micro ((&), (.~), (^.))
import System.Directory (getHomeDirectory, removeDirectoryRecursive)
-import System.FilePath ((</>))
+import System.FilePath ((</>), (<.>))
+import System.IO (openFile, hClose, IOMode(WriteMode))
import System.IO.Temp (withSystemTempDirectory)
+import System.Process
import Types.State
import UI
@@ -59,8 +61,38 @@ makeInitialState = do
, _stOutdir = home </> "tmp"
}
-scanPage :: FilePath -> IO ()
-scanPage dir = undefined
+scanPage :: St -> FilePath -> IO ()
+scanPage st dir = do
+ outH <- openFile outF WriteMode
+ createProcess (proc "scanimage" (scanimageArgs st))
+ { std_in = NoStream
+ , std_out = UseHandle outH
+ , std_err = Inherit -- let the user see progress bar
+ }
+ hClose outH
+ where
+ outF = dir </> "page" ++ (show $ getLatestPage st + 1) <.> "tiff"
+
+scanimageArgs :: St -> [String]
+scanimageArgs st =
+ [ "-vp"
+ , "--format=tiff"
+ , "--resolution=" ++ show (st^.stDPI)
+ , "--mode=" ++ case st^.stColour of
+ Colour -> "Color"
+ Greyscale -> "Gray"
+ Lineart -> "Lineart"
+ , "-x"
+ , show $ case st^.stPaper of
+ A4 -> 210
+ Letter -> 215.9
+ Photo -> 150
+ , "-y"
+ , show $ case st^.stPaper of
+ A4 -> 297
+ Letter -> 279.4
+ Photo -> 100
+ ]
processCommand :: St -> IO ()
processCommand st = case st^.stScanSess of
@@ -70,8 +102,8 @@ processCommand st = case st^.stScanSess of
processCommand (setScanSessDir dir st)
Just dir -> case command of
Abort -> newSession
- NextPage -> scanPage dir >> presentUI (incrementPages st)
- FinalPage -> scanPage dir
+ NextPage -> scanPage st dir >> presentUI (incrementPages st)
+ FinalPage -> scanPage st dir
>> finaliseSession (incrementPages st) >> newSession
Finalise -> finaliseSession st >> newSession
where
diff --git a/Types/State.hs b/Types/State.hs
index 5100c9a..02ff6a2 100644
--- a/Types/State.hs
+++ b/Types/State.hs
@@ -123,3 +123,8 @@ incrementPages st = case st^.stScanSess of
Nothing -> st
Just (ScanSess c p d) ->
st & stScanSess .~ (Just $ ScanSess c (p+1) d)
+
+getLatestPage :: St -> Int
+getLatestPage st = case st^.stScanSess of
+ Nothing -> 0
+ Just (ScanSess _ p _ ) -> p
diff --git a/sscan.cabal b/sscan.cabal
index f6dda74..e95fa29 100644
--- a/sscan.cabal
+++ b/sscan.cabal
@@ -26,5 +26,6 @@ executable sscan
, text >= 1.2.2.1
, vty >= 5.15
, temporary >= 1.2
+ , process >= 1.6
-- hs-source-dirs:
default-language: Haskell2010