tsuntsun (empty) → 0.2.0.0
raw patch · 9 files changed
+481/−0 lines, 9 filesdep +basedep +conduitdep +conduit-combinatorssetup-changed
Dependencies added: base, conduit, conduit-combinators, conduit-extra, directory, filepath, gtk3, optparse-applicative, resourcet, stm, template-haskell, text, typed-process
Files
- LICENSE +27/−0
- README.md +13/−0
- Setup.hs +2/−0
- res/mainwindow.glade +223/−0
- shell.nix +17/−0
- src/Main.hs +129/−0
- src/NaturalLanguageProcessing/TsunTsun/TH.hs +17/−0
- stack.yaml +16/−0
- tsuntsun.cabal +37/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2014-2017, Mateusz Kowalczyk+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice, this+ list of conditions and the following disclaimer in the documentation and/or+ other materials provided with the distribution.++* Neither the name of Mateusz Kowalczyk nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,13 @@+Interacts with tesseract to ease reading of RAW Japanese manga.++The usage is fairly simple. Start the program, passing some temporary+filename to use. Use the provided `scrot` button to take snippets of+parts of your screen containing Japanese text. Once scrot has take the+image, `tesseract` will run on it and the output will be visible in+the UI. Mind that `tesseract` is not the fastest so there may be a+small delay depending on size of the image.++The radio buttons change the modes tesseract operates in. Please read+the tesseract manpage to find out more. Vertical text is the default.++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ res/mainwindow.glade view
@@ -0,0 +1,223 @@+<?xml version="1.0" encoding="UTF-8"?>+<!-- Generated with glade 3.20.0 -->+<interface>+ <requires lib="gtk+" version="3.12"/>+ <object class="GtkWindow" id="mainWindow">+ <property name="can_focus">False</property>+ <child>+ <object class="GtkBox" id="mainBox">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="orientation">vertical</property>+ <child>+ <object class="GtkPaned" id="imageTextPane">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child>+ <object class="GtkBox" id="box2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="orientation">vertical</property>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="width_request">300</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="shadow_type">in</property>+ <child>+ <object class="GtkViewport" id="imageViewport">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkImage" id="imageArea">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="stock">gtk-missing-image</property>+ <property name="icon_size">0</property>+ </object>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkBox" id="box5">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="orientation">vertical</property>+ <child>+ <object class="GtkLabel" id="ocrModeLabel">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Tesseract OCR mode</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkRadioButton" id="verticalRadio">+ <property name="label" translatable="yes">Uniform column</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="active">True</property>+ <property name="draw_indicator">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <object class="GtkRadioButton" id="columnRadio">+ <property name="label" translatable="yes">Varied size column</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="active">True</property>+ <property name="draw_indicator">True</property>+ <property name="group">verticalRadio</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">2</property>+ </packing>+ </child>+ <child>+ <object class="GtkRadioButton" id="blockRadio">+ <property name="label" translatable="yes">Uniform block</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="active">True</property>+ <property name="draw_indicator">True</property>+ <property name="group">verticalRadio</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkRadioButton" id="circledCharacterRadio">+ <property name="label" translatable="yes">Circled character</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="active">True</property>+ <property name="draw_indicator">True</property>+ <property name="group">verticalRadio</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">4</property>+ </packing>+ </child>+ <child>+ <object class="GtkRadioButton" id="characterRadio">+ <property name="label" translatable="yes">Single character</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="active">True</property>+ <property name="draw_indicator">True</property>+ <property name="group">verticalRadio</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">5</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="resize">False</property>+ <property name="shrink">True</property>+ </packing>+ </child>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow2">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="shadow_type">in</property>+ <child>+ <object class="GtkTextView" id="textArea">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </object>+ </child>+ </object>+ <packing>+ <property name="resize">True</property>+ <property name="shrink">True</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkBox" id="buttonBox">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="homogeneous">True</property>+ <child>+ <object class="GtkButton" id="quitButton">+ <property name="label" translatable="yes">Quit</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="scrotButton">+ <property name="label" translatable="yes">Run scrot</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="focus_on_click">False</property>+ <property name="receives_default">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">2</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ shell.nix view
@@ -0,0 +1,17 @@+{ ghc, pkgs ? import <nixpkgs> {} }:++pkgs.haskell.lib.buildStackProject {+ inherit ghc;+ name = "tesseract-env";+ buildInputs = with pkgs;+ [ cairo+ gtk3+ pango+ pkgconfig+ scrot+ tesseract+ xlibs.libX11+ xlibs.xproto+ zlib+ ];+}
+ src/Main.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Main (main) where++import Control.Applicative ((<*>))+import Control.Concurrent+import qualified Control.Concurrent.STM as STM+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import qualified Control.Monad.Trans.Resource as R+import qualified Data.Conduit as C+import qualified Data.Conduit.Binary as C+import qualified Data.Conduit.Combinators as CO+import Data.Function ((&))+import Data.Monoid ((<>), mempty)+import Data.Text (Text)+import Graphics.UI.Gtk+import NaturalLanguageProcessing.TsunTsun.TH (litFile)+import qualified Options.Applicative as Opt+import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.Exit (ExitCode(..))+import System.FilePath (takeDirectory)+import qualified System.Process.Typed as P++runWindow :: TsunConfig -> IO ()+runWindow TsunConfig { _imagePath = iFile, _tesseractPath = tPath } = do+ _ <- initGUI+ -- Load the UI from glade file.+ let gladeContent = [litFile|res/mainwindow.glade|] :: String+ builder <- builderNew+ builderAddFromString builder gladeContent+ let getObj :: GObjectClass cls => (GObject -> cls) -> Text -> IO cls+ getObj = builderGetObject builder++ -- Register quit callbacks.+ window <- getObj castToWindow "mainWindow"+ _ <- window `on` keyPressEvent $ do+ tryEvent $ eventKeyName >>= \"q" -> liftIO mainQuit+ _ <- window `on` destroyEvent $ tryEvent (liftIO mainQuit)+ _ <- window `on` deleteEvent $ tryEvent (liftIO mainQuit)+++ -- Maps radio buttons to integers accepted by tesseract's -psm flag.+ let imageModes :: [(Text, Int)]+ imageModes = [ ("verticalRadio", 5)+ , ("columnRadio", 4)+ , ("blockRadio", 6)+ , ("circledCharacterRadio", 9)+ , ("characterRadio", 10)+ ]++ -- Technically we always expect one default choice but just let the+ -- code set it depending on what's active in the UI.+ ocrMode <- STM.newTVarIO Nothing+ forM_ imageModes $ \(r, m) -> getObj castToRadioButton r >>= \obj -> do+ let updateMode = toggleButtonGetActive obj >>= \case+ True -> STM.atomically $ STM.writeTVar ocrMode (Just m)+ False -> pure ()+ updateMode+ obj `on` toggled $ updateMode++ _ <- getObj castToButton "quitButton" >>= \b -> b `on` buttonActivated $ do+ mainQuit++ -- TVar that's fired when scrot has finished its work which should+ -- indicate new contents at iFile. As a bonus, if the file already+ -- exists at program start, we'll pass the STM guard straight away+ -- and load it.+ imageUpdated <- doesFileExist iFile >>= STM.newTVarIO+ _ <- getObj castToButton "scrotButton" >>= \b -> do+ buttonSetLabel b $ "scrot -s " <> iFile+ b `on` buttonActivated $ void . forkIO $ do+ createDirectoryIfMissing True $ takeDirectory iFile+ P.runProcess (P.proc "scrot" ["-s", iFile]) >>= \case+ ExitSuccess -> STM.atomically $ STM.writeTVar imageUpdated True+ _ -> return ()++ -- When a signal comes on imageUpdated after scrot terminates,+ -- display the new image and feed it into tesseract, updating text+ -- area when it's done.+ textBuffer <- getObj castToTextView "textArea" >>= textViewGetBuffer+ runImageUpdate <- postGUIAsync . flip imageSetFromFile iFile+ <$> getObj castToImage "imageArea"+ void . forkIO . forever $ do+ -- Block until we're notified the image file has been updated.+ STM.atomically $ do+ STM.readTVar imageUpdated >>= STM.check+ STM.writeTVar imageUpdated False++ runImageUpdate+ psmFlags <- STM.readTVarIO ocrMode >>= \case+ Nothing -> pure mempty+ Just m' -> pure ["-psm", show m']+ let procConf = P.proc tPath (psmFlags <> ["-l", "jpn", "stdin", "stdout"])+ & P.setStdout P.createSource+ & P.setStdin P.createSink+ P.withProcess procConf $ \p -> do+ R.runResourceT . C.runConduit $ do+ C.sourceFile iFile C.$$ P.getStdin p+ P.getStdout p+ C..| CO.decodeUtf8+ C..| CO.mapM_ (liftIO . postGUIAsync . textBufferSetText textBuffer)++ widgetShowAll window+ mainGUI++data TsunConfig = TsunConfig+ { _imagePath :: !FilePath+ , _tesseractPath :: !FilePath+ } deriving (Show, Eq, Ord)++main :: IO ()+main = Opt.execParser opts >>= runWindow+ where+ tc = TsunConfig+ <$> Opt.argument Opt.str+ ( Opt.metavar "SCROT_FILE"+ <> Opt.help "File to save to with scrot before it's processed with tesseract." )+ <*> Opt.argument Opt.str+ ( Opt.metavar "TESSERACT_BIN"+ <> Opt.help "Path to the tesseract binary."+ <> Opt.showDefaultWith id+ <> Opt.value "tesseract" )+ opts = Opt.info (tc Opt.<**> Opt.helper)+ ( Opt.fullDesc+ <> Opt.progDesc "Run a frontend to tesseract's Japanese OCR."+ <> Opt.header "Frontend to tesseract's Japanese OCR." )
+ src/NaturalLanguageProcessing/TsunTsun/TH.hs view
@@ -0,0 +1,17 @@+module NaturalLanguageProcessing.TsunTsun.TH (litFile) where++import Language.Haskell.TH+import Language.Haskell.TH.Quote++literally :: String -> Q Exp+literally = return . LitE . StringL++lit :: QuasiQuoter+lit = QuasiQuoter { quoteExp = literally+ , quotePat = \s -> error s $ "quotePat: " ++ s+ , quoteType = \s -> error $ "quoteType: " ++ s+ , quoteDec = \s -> error $ "quoteDec: " ++ s}++-- | Read file as-is.+litFile :: QuasiQuoter+litFile = quoteFile lit
+ stack.yaml view
@@ -0,0 +1,16 @@+resolver: lts-9.2+packages:+- .+extra-deps: []+skip-ghc-check: true+flags: {}++extra-package-dbs: []++nix:+ enable: true+ # If we use custom shell with buildStackProject, locale gets set+ # properly.+ shell-file: shell.nix++system-ghc: true
+ tsuntsun.cabal view
@@ -0,0 +1,37 @@+name: tsuntsun+version: 0.2.0.0+synopsis: Interacts with tesseract to ease reading of RAW Japanese manga.+description: Interacts with tesseract to ease reading of RAW Japanese manga.+homepage: https://github.com/Fuuzetsu/tsuntsun+license: BSD3+license-file: LICENSE+author: Mateusz Kowalczyk+maintainer: fuuzetsu@fuuzetsu.co.uk+copyright: 2014-2017 Mateusz Kowalczyk+category: Natural Language Processing+build-type: Simple+extra-source-files: README.md+ , res/mainwindow.glade+ , shell.nix+ , stack.yaml+cabal-version: >=1.10++executable tsuntsun+ main-is: Main.hs+ other-modules: NaturalLanguageProcessing.TsunTsun.TH+ build-depends: base < 5+ , conduit+ , conduit-combinators+ , conduit-extra+ , directory+ , filepath+ , gtk3+ , optparse-applicative+ , resourcet+ , stm+ , template-haskell+ , text+ , typed-process+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -threaded -O2 -Wall