hxournal 0.5.0.0 → 0.5.1
raw patch · 12 files changed
+295/−52 lines, 12 filesdep +configuratordep ~xournal-parserdep ~xournal-renderbuild-type:Customsetup-changed
Dependencies added: configurator
Dependency ranges changed: xournal-parser, xournal-render
Files
- CHANGES +6/−0
- Config.hs +91/−0
- Setup.lhs +6/−7
- csrc/c_initdevice.c +13/−5
- csrc/c_initdevice.h +2/−2
- hxournal.cabal +16/−6
- lib/Application/HXournal/Config.hs +44/−0
- lib/Application/HXournal/Coroutine/Default.hs +36/−8
- lib/Application/HXournal/Device.hsc +24/−6
- lib/Application/HXournal/GUI.hs +33/−14
- lib/Application/HXournal/GUI/Menu.hs +11/−3
- lib/Application/HXournal/ModelAction/Window.hs +13/−1
CHANGES view
@@ -1,2 +1,8 @@ 0.5: 12 Dec 2011 * First public release. basic pen operation, eraser operation, rectangular selection and file operations are implemented++0.5.1: 16 Dec 2011 + * Use of configuration file '.hxournal'. Enable Use X Input menu. Dependency on xournal-parser and xournal-render is restricted to 0.2.0.* only+ * checking gtk+-2.0 using pkg-config++
+ Config.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Config where++import Data.List +import Data.Maybe++import Control.Applicative+import Control.Monad+++import Distribution.Simple+import Distribution.Simple.BuildPaths++import Distribution.Simple.Setup+import Distribution.PackageDescription+import Distribution.Simple.LocalBuildInfo++import Distribution.System++import System.Exit+import System.Process++import System.FilePath+import System.Directory++import System.Info++myConfigHook :: UserHooks+myConfigHook = simpleUserHooks { + confHook = hookfunction+} ++hookfunction :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags + -> IO LocalBuildInfo+hookfunction x cflags = do + binfo <- confHook simpleUserHooks x cflags+ let pkg_descr = localPkgDescr binfo+ r_pbi <- config binfo+ let newbinfo = + case r_pbi of + Just pbi -> binfo { localPkgDescr = + updatePackageDescription pbi pkg_descr }+ Nothing -> do + let r_lib = library pkg_descr + case r_lib of+ Just lib -> + let binfo2 = libBuildInfo lib+ newlib = lib { libBuildInfo = binfo2 { cSources = [] }} + in binfo {localPkgDescr = pkg_descr {library = Just newlib}}+ Nothing -> error "some library setting is wrong." + return newbinfo +++config :: LocalBuildInfo -> IO (Maybe HookedBuildInfo)+config bInfo = do + (excode,out,err) <- readProcessWithExitCode "pkg-config" ["--cflags", "gtk+-2.0"] "" + incdirs <- case excode of + ExitSuccess -> return . extractIncDir $ out+ _ -> error $ ("failure when running pkg-config --cflags gtk+-2.0 :\n" ++ err) + + + let Just lib = library . localPkgDescr $ bInfo+ buildinfo = libBuildInfo lib+ let hbi = emptyBuildInfo { extraLibs = extraLibs buildinfo + , extraLibDirs = extraLibDirs buildinfo+ , includeDirs = incdirs ++ includeDirs buildinfo + }+ let (r :: Maybe HookedBuildInfo) = Just (Just hbi, []) + -- putStrLn $ show hbi+ return r ++-- data CFlagsOptionSet = CFlagsOptionSet { +-- includedirs :: [String] +-- others :: [String]+-- }++extractIncDir :: String -> [String]+extractIncDir = (mapMaybe parseCFlags) . words ++parseCFlags :: String -> Maybe String +parseCFlags [] = Nothing +parseCFlags str@(x:xs) = + case x of + '-' -> if null xs + then Nothing + else let (y:ys) = xs + in case y of+ 'I' -> Just ys + _ -> Nothing + _ -> Nothing
Setup.lhs view
@@ -1,10 +1,9 @@ #! /usr/bin/env runhaskell-+> > import Distribution.Simple > import Distribution.PackageDescription-> --import System.Process-> main = defaultMain-> --main = defaultMainWithHooks testUserHooks-> --testUserHooks = simpleUserHooks { -> -- preConf = \_ _ -> runCommand "cd rootcode; make; cd .." >>return emptyHookedBuildInfo-> -- } +> import Config +> +> main :: IO ()+> main = defaultMainWithHooks myConfigHook+>
csrc/c_initdevice.c view
@@ -2,7 +2,9 @@ #include <stdio.h> #include <string.h> -void initdevice( int* core, int* stylus, int* eraser )+void initdevice( int* core, int* stylus, int* eraser, + char* corepointername, char* stylusname, char* erasername+ ) { GList* dev_list; GdkDevice* device;@@ -19,15 +21,21 @@ // #endif gdk_device_set_mode(device, GDK_MODE_SCREEN); - printf(" yeah this is xinput device %s \n", device -> name);- if( !strcmp (device->name, "stylus") )+ printf("This is xinput device %s \n", device -> name);+ if( !strcmp (device->name, stylusname) ) {+ printf("got stylus\n"); (*stylus) = (int) device; - if( !strcmp (device->name, "eraser") )+ } + if( !strcmp (device->name, erasername) ) { + printf("got eraser\n"); (*eraser) = (int) device;+ } } else { - if( !strcmp (device->name, "Core Pointer") )+ if( !strcmp (device->name, corepointername) ) { + printf("got Core Pointer\n"); (*core) = (int) device; + } } dev_list = dev_list->next; }
csrc/c_initdevice.h view
@@ -1,6 +1,6 @@ #include <gtk/gtk.h> #include <stdio.h> -void initdevice( int*, int*, int* ); +void initdevice( int* core, int* stylus, int* eraser, + char* corepointername, char* stylusname, char* erasername ); -//void extEventCanvas( void* );
hxournal.cabal view
@@ -1,19 +1,25 @@ Name: hxournal-Version: 0.5.0.0+Version: 0.5.1 Synopsis: A pen notetaking program written in haskell Description: notetaking program written in haskell and gtk2hs+Homepage: http://ianwookim.org/hxournal License: BSD3 License-file: LICENSE Author: Ian-Woo Kim Maintainer: Ian-Woo Kim <ianwookim@gmail.com> Category: Application Tested-with: GHC == 7.0.3-Build-Type: Simple+Build-Type: Custom Cabal-Version: >= 1.8 data-files: template/*.html.st resource/*.png CHANGES+ Config.hs+Source-repository head+ type: git+ location: https://www.github.com/wavewave/hxournal + Executable hxournal Main-is: hxournal.hs hs-source-dirs: exe@@ -35,18 +41,21 @@ filepath == 1.*, strict == 0.3.*, gtk == 0.12.*, - cairo == 0.12.*, + cairo == 0.12.*, monad-coroutine == 0.7.*, transformers == 0.2.*,- xournal-parser == 0.2.*,- xournal-render == 0.2.*,+ xournal-parser == 0.2.0.*, + xournal-render == 0.2.0.*, containers == 0.4.*, template-haskell == 2.*, blaze-builder == 0.3.*, bytestring == 0.9.*, double-conversion == 0.2.*, fclabels == 1.0.*,- cmdargs >= 0.7 && <= 0.10+ cmdargs >= 0.7 && <= 0.10,+ configurator == 0.1.*++ -- >= 0.1 && < 0.3 Exposed-Modules: Application.HXournal.ProgType Application.HXournal.Job@@ -88,6 +97,7 @@ Application.HXournal.Device Application.HXournal.Builder Application.HXournal.Accessor+ Application.HXournal.Config Other-Modules: Paths_hxournal c-sources:
+ lib/Application/HXournal/Config.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++module Application.HXournal.Config where++import Control.Monad+import Data.Configurator as C+import Data.Configurator.Types +import System.Environment +import System.Directory+import System.FilePath+import Control.Concurrent ++emptyConfigString :: String +emptyConfigString = "\n#config file for hxournal \n " ++loadConfigFile :: IO Config+loadConfigFile = do + homepath <- getEnv "HOME" + let dothxournal = homepath </> ".hxournal"+ b <- doesFileExist dothxournal+ when (not b) $ do + writeFile dothxournal emptyConfigString + threadDelay 1000000+ config <- load [Required "$(HOME)/.hxournal"]+ return config+ +getPenDevConfig :: Config -> IO (Maybe String, Maybe String,Maybe String) +getPenDevConfig c = do + mcore <- C.lookup c "core"+ mstylus <- C.lookup c "stylus" + meraser <- C.lookup c "eraser"+ return (mcore,mstylus,meraser)+ +getXInputConfig :: Config -> IO Bool +getXInputConfig c = do + (mxinput :: Maybe String) <- C.lookup c "xinput"+ case mxinput of+ Nothing -> return False+ Just str -> case str of + "true" -> return True+ "false" -> return False + _ -> error "cannot understand xinput in configfile"++
lib/Application/HXournal/Coroutine/Default.hs view
@@ -10,6 +10,7 @@ import Application.HXournal.Draw import Application.HXournal.Accessor +import Application.HXournal.GUI.Menu import Application.HXournal.Coroutine.Callback import Application.HXournal.Coroutine.Draw import Application.HXournal.Coroutine.Pen@@ -60,21 +61,29 @@ let st0 = (emptyHXournalState :: HXournalState) sref <- newIORef st0 tref <- newIORef (undefined :: SusAwait)- let st1 = set deviceList devlst + (r,st') <- St.runStateT (resume guiProcess) st0 + writeIORef sref st' + case r of + Left aw -> do + writeIORef tref aw + Right _ -> error "what?"++ let st0new = set deviceList devlst . set rootOfRootWindow window - . set callBack (bouncecallback tref sref) $ st0 + . set callBack (bouncecallback tref sref) + $ st' + writeIORef sref st0new + ui <- getMenuUI tref sref + putStrLn "hi" + let st1 = set gtkUIManager ui st0new+ initcvs <- initCanvasInfo st1 1 let initcmap = M.insert (get canvasId initcvs) initcvs M.empty let startingXstate = set currentCanvas (get canvasId initcvs) . set canvasInfoMap initcmap . set frameState (Node 1) $ st1- (r,st') <- St.runStateT (resume guiProcess) startingXstate - writeIORef sref st' - case r of - Left aw -> do - writeIORef tref aw - Right _ -> error "what?"+ writeIORef sref startingXstate return (tref,sref) initialize :: Iteratee MyEvent XournalStateIO ()@@ -199,4 +208,23 @@ menuEventProcess MenuHSplit = eitherSplit SplitHorizontal menuEventProcess MenuVSplit = eitherSplit SplitVertical menuEventProcess MenuDelCanvas = deleteCanvas+menuEventProcess MenuUseXInput = do + -- putStrLn "Use X Input clicked" + xstate <- getSt + let ui = get gtkUIManager xstate + agr <- liftIO ( uiManagerGetActionGroups ui >>= \x ->+ case x of + [] -> error "No action group? "+ y:_ -> return y )+ uxinputa <- liftIO (actionGroupGetAction agr "UXINPUTA" >>= \(Just x) -> + return (castToToggleAction x) )+ b <- liftIO $ toggleActionGetActive uxinputa+ -- liftIO $ putStrLn $ "bool = " ++ show b + let cmap = get canvasInfoMap xstate+ canvases = map (get drawArea) . M.elems $ cmap + + if b+ then mapM_ (\x->liftIO $ widgetSetExtensionEvents x [ExtensionEventsAll]) canvases+ else mapM_ (\x->liftIO $ widgetSetExtensionEvents x [ExtensionEventsNone] ) canvases+ menuEventProcess m = liftIO $ putStrLn $ "not implemented " ++ show m
lib/Application/HXournal/Device.hsc view
@@ -5,12 +5,17 @@ module Application.HXournal.Device where +import Application.HXournal.Config+import Data.Configurator.Types++ import Control.Applicative import Control.Monad.Reader import Foreign.Marshal.Utils import Foreign.Ptr import Foreign.C+import Foreign.C.String import Foreign.Storable import Graphics.UI.Gtk@@ -34,14 +39,27 @@ foreign import ccall "c_initdevice.h initdevice" c_initdevice- :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()+ :: Ptr CInt -> Ptr CInt -> Ptr CInt -> CString -> CString -> CString -> IO () -initDevice :: IO DeviceList -initDevice = +initDevice :: Config -> IO DeviceList +initDevice cfg = do + (mcore,mstylus,meraser) <- getPenDevConfig cfg + putStrLn $ show mstylus with 0 $ \pcore -> - with 0 $ \pstylus -> - with 0 $ \peraser -> do - c_initdevice pcore pstylus peraser+ with 0 $ \pstylus -> + with 0 $ \peraser -> do + pcorename <- case mcore of + Nothing -> newCString "Core Pointer"+ Just core -> newCString core+ pstylusname <- case mstylus of + Nothing -> newCString "stylus"+ Just spen -> newCString spen+ perasername <- case meraser of + Nothing -> newCString "eraser"+ Just seraser -> newCString seraser + + c_initdevice pcore pstylus peraser pcorename pstylusname perasername+ core_val <- peek pcore stylus_val <- peek pstylus eraser_val <- peek peraser
lib/Application/HXournal/GUI.hs view
@@ -4,11 +4,16 @@ import Application.HXournal.Type.XournalState import Application.HXournal.Type.Event+import Application.HXournal.Type.Canvas +import qualified Data.IntMap as M+ import Application.HXournal.Coroutine.Callback++import Application.HXournal.Config import Application.HXournal.Device import Application.HXournal.Coroutine-import Application.HXournal.GUI.Menu+-- import Application.HXournal.GUI.Menu import Application.HXournal.ModelAction.File import Application.HXournal.ModelAction.Window @@ -27,28 +32,42 @@ startGUI mfname = do initGUI window <- windowNew - - devlst <- initDevice ++ cfg <- loadConfigFile + devlst <- initDevice cfg (tref,sref) <- initCoroutine devlst window- st0 <- readIORef sref - st1 <- getFileContent mfname st0- writeIORef sref st1+ st1 <- readIORef sref ++ -- let st1 = set gtkUIManager ui st0+ st2 <- getFileContent mfname st1+ let ui = get gtkUIManager st2 + writeIORef sref st2 (winCvsArea, wconf) <- constructFrame <$> get frameState - <*> get canvasInfoMap $ st1+ <*> get canvasInfoMap $ st2 - setTitleFromFileName st1+ setTitleFromFileName st2 vbox <- vBoxNew False 0 - let st2 = set frameState wconf + let st3 = set frameState wconf . set rootWindow winCvsArea - . set rootContainer (castToBox vbox) $ st1 - writeIORef sref st2- ui <- getMenuUI tref sref + . set rootContainer (castToBox vbox) $ st2+ writeIORef sref st3 - let st3 = set gtkUIManager ui st2 - writeIORef sref st3 + xinputbool <- getXInputConfig cfg + agr <- uiManagerGetActionGroups ui >>= \x ->+ case x of + [] -> error "No action group? "+ y:_ -> return y + uxinputa <- actionGroupGetAction agr "UXINPUTA" >>= \(Just x) -> + return (castToToggleAction x) + toggleActionSetActive uxinputa xinputbool+ let canvases = map (get drawArea) . M.elems . get canvasInfoMap $ st3+ if xinputbool+ then mapM_ (flip widgetSetExtensionEvents [ExtensionEventsAll]) canvases+ else mapM_ (flip widgetSetExtensionEvents [ExtensionEventsNone]) canvases + maybeMenubar <- uiManagerGetWidget ui "/ui/menubar" let menubar = case maybeMenubar of Just x -> x
lib/Application/HXournal/GUI/Menu.hs view
@@ -425,7 +425,10 @@ setdefopta <- actionNewAndRegister "SETDEFOPTA" "Set As Default" (Just "Just a Stub") Nothing (justMenu MenuSetAsDefaultOption) -- options menu - uxinputa <- actionNewAndRegister "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing (justMenu MenuUseXInput)+ uxinputa <- toggleActionNew "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing + uxinputa `on` actionToggled $ do + bouncecallback tref sref (Menu MenuUseXInput)+-- AndRegister "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing (justMenu MenuUseXInput) dcrdcorea <- actionNewAndRegister "DCRDCOREA" "Discard Core Events" (Just "Just a Stub") Nothing (justMenu MenuDiscardCoreEvents) ersrtipa <- actionNewAndRegister "ERSRTIPA" "Eraser Tip" (Just "Just a Stub") Nothing (justMenu MenuEraserTip) pressrsensa <- actionNewAndRegister "PRESSRSENSA" "Pressure Sensitivity" (Just "Just a Stub") Nothing (justMenu MenuPressureSensitivity)@@ -462,12 +465,15 @@ , shpreca, rulera, clra, penopta {- selregna, selrecta, vertspa, handa, -} , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta- , uxinputa, dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa+ {- , uxinputa, -} + , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa , abouta , defaulta ] + + actionGroupAddAction agr uxinputa actionGroupAddRadioActions agr viewmods 0 (\_ -> return ()) actionGroupAddRadioActions agr pointmods 0 (assignPoint sref) actionGroupAddRadioActions agr penmods 0 (assignPenMode tref sref)@@ -485,7 +491,8 @@ , shpreca, rulera , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta- , uxinputa, dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa+ {- , uxinputa -} + , dcrdcorea, ersrtipa, pressrsensa, pghilta, mltpgvwa , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa , abouta @@ -494,6 +501,7 @@ enabledActions = [ opena, savea, saveasa, quita, fstpagea, prvpagea, nxtpagea, lstpagea , clra, penopta, zooma, nrmsizea, pgwdtha -- , selrecta+ -- , uxinputa ] mapM_ (\x->actionSetSensitive x True) enabledActions
lib/Application/HXournal/ModelAction/Window.hs view
@@ -62,7 +62,19 @@ return () -} widgetAddEvents canvas [PointerMotionMask,Button1MotionMask] - widgetSetExtensionEvents canvas [ExtensionEventsAll]+ -- widgetSetExtensionEvents canvas [ExtensionEventsAll]+ -- widgetSetExtensionEvents canvas + let ui = get gtkUIManager xstate + agr <- liftIO ( uiManagerGetActionGroups ui >>= \x ->+ case x of + [] -> error "No action group? "+ y:_ -> return y )+ uxinputa <- liftIO (actionGroupGetAction agr "UXINPUTA" >>= \(Just x) -> + return (castToToggleAction x) )+ b <- liftIO $ toggleActionGetActive uxinputa+ if b+ then widgetSetExtensionEvents canvas [ExtensionEventsAll]+ else widgetSetExtensionEvents canvas [ExtensionEventsNone] afterValueChanged hadj $ do v <- adjustmentGetValue hadj