diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -55,18 +55,20 @@ config :: LocalBuildInfo -> IO (Maybe HookedBuildInfo) config bInfo = do let cflags = (configConfigurationsFlags . configFlags) bInfo - b = maybe False id (lookup (FlagName "gtk3") cflags) - incdirs <- if b - then do - (excode,out,err) <- readProcessWithExitCode "pkg-config" ["--cflags", "gtk+-3.0"] "" - case excode of - ExitSuccess -> return . extractIncDir $ out - _ -> error $ ("failure when running pkg-config --cflags gtk+-3.0 :\n" ++ err) - else do - (excode,out,err) <- readProcessWithExitCode "pkg-config" ["--cflags", "gtk+-2.0"] "" - case excode of - ExitSuccess -> return . extractIncDir $ out - _ -> error $ ("failure when running pkg-config --cflags gtk+-2.0 :\n" ++ err) + -- b = maybe False id (lookup (FlagName "gtk3") cflags) + incdirs <- -- if b + -- then + do + (excode,out,err) <- readProcessWithExitCode "pkg-config" ["--cflags", "gtk+-3.0"] "" + case excode of + ExitSuccess -> return . extractIncDir $ out + _ -> error $ ("failure when running pkg-config --cflags gtk+-3.0 :\n" ++ err) + + -- else do + -- (excode,out,err) <- readProcessWithExitCode "pkg-config" ["--cflags", "gtk+-2.0"] "" + -- 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 diff --git a/csrc/c_initdevice.c b/csrc/c_initdevice.c --- a/csrc/c_initdevice.c +++ b/csrc/c_initdevice.c @@ -1,145 +1,146 @@ +#include #include #include #include -#ifndef GTK3 -#include "XInput.h" -#endif // GTK3 - -#ifndef GTK3 -// -// Globals. -// +// #ifndef GTK3 +// #include "XInput.h" +// #endif // GTK3 -// Holds the values for the Wacom API. -xinput_values_t g_xinput_values = { - .isWacom = true, -}; +// #ifndef GTK3 +// // +// // Globals. +// // -// Holds XInput wrapper state. -xinput_state_t g_xinput_state = { - .refcount = 0, +// // Holds the values for the Wacom API. +// xinput_values_t g_xinput_values = { +// .isWacom = true, +// }; - .thread = 0, +// // Holds XInput wrapper state. +// xinput_state_t g_xinput_state = { +// .refcount = 0, +// +// .thread = 0, - .screen_width = 0, - .screen_height = 0, +/* .screen_width = 0, */ +/* .screen_height = 0, */ - // Valuator ranges. - .absx_min = 0, - .absx_min = 0, - .absy_max = 1, - .absy_max = 1, - .pressure_min = 0, - .pressure_max = 1, - .tilt_min = 0, - .tilt_max = 1, +/* // Valuator ranges. */ +/* .absx_min = 0, */ +/* .absx_min = 0, */ +/* .absy_max = 1, */ +/* .absy_max = 1, */ +/* .pressure_min = 0, */ +/* .pressure_max = 1, */ +/* .tilt_min = 0, */ +/* .tilt_max = 1, */ - // XInput event types. - .motionType = -1, - .buttonPressType = -1, - .buttonReleaseType = -1, - .proximityInType = -1, - .proximityOutType = -1, -}; +/* // XInput event types. */ +/* .motionType = -1, */ +/* .buttonPressType = -1, */ +/* .buttonReleaseType = -1, */ +/* .proximityInType = -1, */ +/* .proximityOutType = -1, */ +/* }; */ // // Functions. // -static bool xinput_findDevices(Display *display, XDeviceInfo *stylus_info, XDeviceInfo *eraser_info) -{ - int found = 0; +/* static bool xinput_findDevices(Display *display, XDeviceInfo *stylus_info, XDeviceInfo *eraser_info) */ +/* { */ +/* int found = 0; */ - int num; - XDeviceInfo *devices = XListInputDevices(display, &num); +/* int num; */ +/* XDeviceInfo *devices = XListInputDevices(display, &num); */ - Atom stylus = XInternAtom(display, "STYLUS", false); - Atom eraser = XInternAtom(display, "ERASER", false); +/* Atom stylus = XInternAtom(display, "STYLUS", false); */ +/* Atom eraser = XInternAtom(display, "ERASER", false); */ - for (int i = 0; i < num; i++) { - debug("Got device \"%s\"\n", devices[i].name); +/* for (int i = 0; i < num; i++) { */ +/* debug("Got device \"%s\"\n", devices[i].name); */ - if (devices[i].type == stylus) { - found++; +/* if (devices[i].type == stylus) { */ +/* found++; */ - // Fill tablet model here. - snprintf(g_xinput_values.tabletModel, sizeof(g_xinput_values.tabletModel), "%s", devices[i].name); - snprintf(g_xinput_values.tabletModelID, sizeof(g_xinput_values.tabletModelID), "%s", devices[i].name); +/* // Fill tablet model here. */ +/* snprintf(g_xinput_values.tabletModel, sizeof(g_xinput_values.tabletModel), "%s", devices[i].name); */ +/* snprintf(g_xinput_values.tabletModelID, sizeof(g_xinput_values.tabletModelID), "%s", devices[i].name); */ - debug("Found stylus.\n"); +/* debug("Found stylus.\n"); */ - memcpy(stylus_info, &devices[i], sizeof(XDeviceInfo)); +/* memcpy(stylus_info, &devices[i], sizeof(XDeviceInfo)); */ - XAnyClassPtr any = (XAnyClassPtr)devices[i].inputclassinfo; +/* XAnyClassPtr any = (XAnyClassPtr)devices[i].inputclassinfo; */ - for (int j = 0; j < devices[i].num_classes; j++) { - if (any->class == ValuatorClass) { - XValuatorInfoPtr v = (XValuatorInfoPtr)any; +/* for (int j = 0; j < devices[i].num_classes; j++) { */ +/* if (any->class == ValuatorClass) { */ +/* XValuatorInfoPtr v = (XValuatorInfoPtr)any; */ - // X. - g_xinput_state.absx_min = v->axes[VALUATOR_ABSX].min_value; - g_xinput_state.absx_min = v->axes[VALUATOR_ABSX].max_value; - debug("X valuator range: min=%d, max=%d\n", v->axes[VALUATOR_ABSX].min_value, v->axes[VALUATOR_ABSX].max_value); +/* // X. */ +/* g_xinput_state.absx_min = v->axes[VALUATOR_ABSX].min_value; */ +/* g_xinput_state.absx_min = v->axes[VALUATOR_ABSX].max_value; */ +/* debug("X valuator range: min=%d, max=%d\n", v->axes[VALUATOR_ABSX].min_value, v->axes[VALUATOR_ABSX].max_value); */ - // Y. - g_xinput_state.absy_min = v->axes[VALUATOR_ABSY].min_value; - g_xinput_state.absy_min = v->axes[VALUATOR_ABSY].max_value; - debug("Y valuator range: min=%d, max=%d\n", v->axes[VALUATOR_ABSY].min_value, v->axes[VALUATOR_ABSY].max_value); +/* // Y. */ +/* g_xinput_state.absy_min = v->axes[VALUATOR_ABSY].min_value; */ +/* g_xinput_state.absy_min = v->axes[VALUATOR_ABSY].max_value; */ +/* debug("Y valuator range: min=%d, max=%d\n", v->axes[VALUATOR_ABSY].min_value, v->axes[VALUATOR_ABSY].max_value); */ - // Pressure. - g_xinput_state.pressure_min = v->axes[VALUATOR_PRESSURE].min_value; - g_xinput_state.pressure_max = v->axes[VALUATOR_PRESSURE].max_value; - debug("Pressure valuator range: min=%d, max=%d\n", v->axes[VALUATOR_PRESSURE].min_value, v->axes[VALUATOR_PRESSURE].max_value); +/* // Pressure. */ +/* g_xinput_state.pressure_min = v->axes[VALUATOR_PRESSURE].min_value; */ +/* g_xinput_state.pressure_max = v->axes[VALUATOR_PRESSURE].max_value; */ +/* debug("Pressure valuator range: min=%d, max=%d\n", v->axes[VALUATOR_PRESSURE].min_value, v->axes[VALUATOR_PRESSURE].max_value); */ - // Tilt. Assuming that the range is the same for X and Y... - g_xinput_state.tilt_min = v->axes[VALUATOR_TILTX].min_value; - g_xinput_state.tilt_max = v->axes[VALUATOR_TILTX].max_value; - debug("Tilt valuator range: min=%d, max=%d\n", v->axes[VALUATOR_TILTX].min_value, v->axes[VALUATOR_TILTX].max_value); +/* // Tilt. Assuming that the range is the same for X and Y... */ +/* g_xinput_state.tilt_min = v->axes[VALUATOR_TILTX].min_value; */ +/* g_xinput_state.tilt_max = v->axes[VALUATOR_TILTX].max_value; */ +/* debug("Tilt valuator range: min=%d, max=%d\n", v->axes[VALUATOR_TILTX].min_value, v->axes[VALUATOR_TILTX].max_value); */ - break; - } +/* break; */ +/* } */ - any = (XAnyClassPtr)((char *)any + any->length); - } - } else if (devices[i].type == eraser) { - found++; +/* any = (XAnyClassPtr)((char *)any + any->length); */ +/* } */ +/* } else if (devices[i].type == eraser) { */ +/* found++; */ - debug("Found eraser.\n"); +/* debug("Found eraser.\n"); */ - memcpy(eraser_info, &devices[i], sizeof(XDeviceInfo)); - } - } +/* memcpy(eraser_info, &devices[i], sizeof(XDeviceInfo)); */ +/* } */ +/* } */ - XFreeDeviceList(devices); +/* XFreeDeviceList(devices); */ - return (found == 2); -} +/* return (found == 2); */ +/* } */ -void find_wacom( char* stylus_name, char* eraser_name) -{ - Display *display = XOpenDisplay(NULL); - assert(display != NULL); +/* void find_wacom( char* stylus_name, char* eraser_name) */ +/* { */ +/* Display *display = XOpenDisplay(NULL); */ +/* assert(display != NULL); */ - g_xinput_state.screen_width = XWidthOfScreen(DefaultScreenOfDisplay(display)); - g_xinput_state.screen_height = XHeightOfScreen(DefaultScreenOfDisplay(display)); +/* g_xinput_state.screen_width = XWidthOfScreen(DefaultScreenOfDisplay(display)); */ +/* g_xinput_state.screen_height = XHeightOfScreen(DefaultScreenOfDisplay(display)); */ - XDeviceInfo stylus_info, eraser_info; +/* XDeviceInfo stylus_info, eraser_info; */ - if (!xinput_findDevices(display, &stylus_info, &eraser_info)) { - fprintf(stderr, "Couldn't find device.\n"); - } - else { - printf("found stylus=%s \n", stylus_info.name ); - printf("found eraser=%s \n", eraser_info.name ); - strcpy(stylus_name, stylus_info.name); - strcpy(eraser_name, eraser_info.name); - } - return ; -} -#endif // not GTK3 +/* if (!xinput_findDevices(display, &stylus_info, &eraser_info)) { */ +/* fprintf(stderr, "Couldn't find device.\n"); */ +/* } */ +/* else { */ +/* printf("found stylus=%s \n", stylus_info.name ); */ +/* printf("found eraser=%s \n", eraser_info.name ); */ +/* strcpy(stylus_name, stylus_info.name); */ +/* strcpy(eraser_name, eraser_info.name); */ +/* } */ +/* return ; */ +/* } */ +/* #endif // not GTK3 */ void initdevice ( int* core , int* stylus @@ -151,25 +152,48 @@ , char* touchname ) { + printf("initdevice : corepointername = %s\n", corepointername ); printf("initdevice : stylusname = %s\n", stylusname ); printf("initdevice : erasername = %s\n", erasername ); printf("initdevice : touchname = %s\n", touchname ); GList* dev_list; + GList* dev_list_m; GdkDevice* device; -#ifdef GTK3 + // #ifdef GTK3 GdkDisplay* disp = gdk_display_get_default(); + // GdkSeat* seat = gdk_display_get_default_seat(disp); + + GdkDeviceManager *devman = gdk_display_get_device_manager(disp); + dev_list_m = gdk_device_manager_list_devices(devman, GDK_DEVICE_TYPE_MASTER ); + while( dev_list_m != NULL ) { + device = (GdkDevice *)dev_list_m->data; + printf("device = %d\n", device); + char* name = gdk_device_get_name(device); + printf("%s\n", name ); + if( !strcmp (gdk_device_get_name(device), corepointername) ) { + (*core) = (int) device; + } + + dev_list_m = g_list_next(dev_list_m); + } + + //GdkDevice* master = gdk_seat_get_pointer(seat); + //(*core) = (int)master; + + + /* dev_list = gdk_device_manager_list_devices(devman, GDK_DEVICE_TYPE_SLAVE ); -#else // GTK3 - dev_list = gdk_devices_list(); -#endif // GTK3 + // #else // GTK3 + // dev_list = gdk_devices_list(); + // #endif // GTK3 (*stylus) = 0; while (dev_list != NULL) { device = (GdkDevice *)dev_list->data; - // device = GPOINTER_TO_INT(dev_list->data); - if ( gdk_device_get_source(device) != GDK_SOURCE_MOUSE ) { + printf("device = %d\n", device); + //if ( gdk_device_get_source(device) != GDK_SOURCE_MOUSE ) { gdk_device_set_axis_use(device, 0, GDK_AXIS_IGNORE); gdk_device_set_axis_use(device, 1, GDK_AXIS_IGNORE); gdk_device_set_mode(device, GDK_MODE_SCREEN); @@ -180,33 +204,35 @@ if( !strcmp (gdk_device_get_name(device), erasername) ) { (*eraser) = (int) device; } - if( !strcmp (gdk_device_get_name(device), touchname) ) { + if( !strcmp (gdk_device_get_name(device), touchname) ) { (*touch) = (int) device; } - } - else { + //} + // else { if( !strcmp (gdk_device_get_name(device), corepointername) ) { (*core) = (int) device; } - } -#ifdef GTK3 + //} + + // #ifdef GTK3 dev_list = g_list_next(dev_list); -#else // GTK3 - dev_list = dev_list->next; -#endif // GTK3 - } + //#else // GTK3 + // dev_list = dev_list->next; + // #endif // GTK3 + } */ -} -#ifndef GTK3 -void enable_touch( char* touch_name ) -{ - printf("enable touch: %s\n", touch_name ) ; } -void disable_touch( GdkDrawable *gdkwin, char* touch_name ) -{ - printf("disable touch: %s\n", touch_name ); - -} -#endif // GTK3 +// #ifndef GTK3 +// void enable_touch( char* touch_name ) +// { +// printf("enable touch: %s\n", touch_name ) ; +// } + +// void disable_touch( GdkDrawable *gdkwin, char* touch_name ) +// { +// printf("disable touch: %s\n", touch_name ); +// +// } +// #endif // GTK3 diff --git a/hoodle-core.cabal b/hoodle-core.cabal --- a/hoodle-core.cabal +++ b/hoodle-core.cabal @@ -1,5 +1,5 @@ Name: hoodle-core -Version: 0.15.0 +Version: 0.16 Synopsis: Core library for hoodle Description: Hoodle is a pen notetaking program written in haskell. hoodle-core is the core library written in haskell and @@ -13,7 +13,7 @@ Tested-with: GHC == 7.6, GHC == 7.8 Build-Type: Custom Cabal-Version: >= 1.8 -data-files: template/*.html.st +data-files: resource/*.css resource/*.png resource/*.xml Config.hs @@ -26,10 +26,6 @@ Description: dynamic reconfiguration support Default: False -Flag Gtk3 - Description: compile with gtk3 - Default: False - Flag Hub Description: communication with Hub Default: False @@ -39,16 +35,15 @@ ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans ghc-prof-options: -caf-all -auto-all - Build-Depends: aeson>=0.7, + Build-Depends: base == 4.*, + aeson>=0.7, aeson-pretty > 0.7, array, attoparsec >= 0.10, - base == 4.*, base64-bytestring >= 0.1, binary, bytestring >= 0.9, cairo >= 0.13.0.3, - case-insensitive, cereal >= 0.3.5, containers >= 0.4, configurator >= 0.2, @@ -60,18 +55,11 @@ filepath > 1, fsnotify >= 0.0.7, gd >= 3000.7, - handa-gdata >= 0.6.9.3, - hoodle-builder >= 0.3.0, - hoodle-parser >= 0.3.0, - hoodle-publish >= 0.2, - hoodle-render >= 0.5.0 && < 0.6, - hoodle-types >= 0.3.0, http-types, lens >= 2.5, monad-loops >= 0.3, mtl > 2, network-uri > 2.6, - old-locale >= 1.0, pango > 0.12, poppler >= 0.12.2.2, process >= 1.1, @@ -88,17 +76,17 @@ unordered-containers >= 0.2, uuid >= 1.2.7, vector >= 0.10, - websockets, - xournal-parser >= 0.5.0.2 - -- + gtk3 >= 0.14, + -- + xournal-parser >= 0.5.0.2, + hoodle-builder >= 0.4, + hoodle-parser >= 0.4, + hoodle-publish >= 0.2, + hoodle-render >= 0.6, + hoodle-types >= 0.4 + if flag(dyre) Build-depends: dyre >= 0.8.11 - -- - if flag(gtk3) - Build-depends: gtk3 >= 0.13.0.3 - else - Build-depends: gtk >= 0.13.0.3 - -- if flag(hub) Build-depends: dbus >= 0.10, @@ -110,8 +98,13 @@ persistent, persistent-sqlite, persistent-template, - resourcet + resourcet, + -- + case-insensitive, + websockets, + handa-gdata >= 0.6.9.3 + Exposed-Modules: Hoodle.Accessor Hoodle.Config @@ -201,7 +194,5 @@ extra-libraries: X11 Xi dl pthread if flag(dyre) cpp-options: -DDYRE - if flag(gtk3) - cpp-options: -DGTK3 if flag(hub) cpp-options: -DHUB diff --git a/resource/hoodle.css b/resource/hoodle.css new file mode 100644 --- /dev/null +++ b/resource/hoodle.css @@ -0,0 +1,3 @@ +GtkToolbar GtkButton { + padding: 5px; +} diff --git a/src/Hoodle/Coroutine/ContextMenu.hs b/src/Hoodle/Coroutine/ContextMenu.hs --- a/src/Hoodle/Coroutine/ContextMenu.hs +++ b/src/Hoodle/Coroutine/ContextMenu.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/src/Hoodle/Coroutine/Default.hs b/src/Hoodle/Coroutine/Default.hs --- a/src/Hoodle/Coroutine/Default.hs +++ b/src/Hoodle/Coroutine/Default.hs @@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.Default --- Copyright : (c) 2011-2015 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -116,7 +116,7 @@ . updateFromCanvasInfoAsCurrentCanvas initcvsbox . set cvsInfoMap M.empty ) uhdl2 = view (unitHoodles.currentUnit) st2 - (uhdl3,cvs,_wconf) <- constructFrame st2 uhdl2 (view frameState uhdl2) + (uhdl3,rtwdw,_wconf) <- constructFrame st2 uhdl2 (view frameState uhdl2) (uhdl4,wconf') <- eventConnect st2 uhdl3 (view frameState uhdl3) notebook <- Gtk.notebookNew statusbar <- Gtk.statusbarNew @@ -127,7 +127,7 @@ st5 = st4 # over (unitHoodles.currentUnit) ( set undoTable (emptyUndo maxundo) . set frameState wconf' - . set rootWindow cvs + . set rootWindow rtwdw . set (hoodleFileControl.hoodleFileName) (LocalDir Nothing)) . set (settings.doesUseXInput) xinputbool . set (settings.doesUseVariableCursor) varcsr @@ -138,21 +138,19 @@ . set rootNotebook notebook . set uiComponentSignalHandler uicompsighdlr . set statusBar (Just statusbar) - + -- vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd window vbox vboxcvs <- Gtk.vBoxNew False 0 - -- Gtk.notebookAppendPage notebook vboxcvs ("untitled" :: T.Text) (_,uuid,btn) <- createTab callback notebook vboxcvs Gtk.containerAdd vboxcvs (view (unitHoodles.currentUnit.rootWindow) st5) - + -- sigid <- notebook `Gtk.on` Gtk.switchPage $ \i -> callback (UsrEv (SwitchTab i)) let st6 = ( (unitHoodles.currentUnit.unitUUID .~ uuid) . (unitHoodles.currentUnit.unitButton .~ btn) . (uiComponentSignalHandler.switchTabSignal .~ Just sigid)) st5 - -- st6 = st5 startingXstate = (unitHoodles.currentUnit.rootContainer .~ Gtk.castToBox vboxcvs) st6 - startworld = world startingXstate . ReaderT $ (\(Arg DoEvent ev) -> guiProcess ev) + startworld = world startingXstate . ReaderT $ (\(Arg DoEvent ev) -> guiProcess ev) putMVar evar . Just $ (driver simplelogger startworld) return (evar,startingXstate,ui,vbox) @@ -162,33 +160,35 @@ case ev of UsrEv (Initialized mfname) -> do if isInitialized - then case cvs of - Nothing -> nextevent >>= initialize Nothing True . UsrEv - Just cvsi -> return cvsi + then do + case cvs of + Nothing -> nextevent >>= initialize Nothing True . UsrEv + Just cvsi -> return cvsi else do - -- additional initialization goes here - xst1 <- get - let ui = xst1 ^. gtkUIManager - cachevar = xst1 ^. renderCacheVar - tvarpdf = xst1 ^. pdfRenderQueue - tvargen = xst1 ^. genRenderQueue - doIOaction $ \evhandler -> do - -- let handler = Gtk.postGUIAsync . evhandler . SysEv . RenderCacheUpdate - forkOn 2 $ pdfRendererMain (defaultHandler evhandler) tvarpdf - forkIO $ E.catch (genRendererMain cachevar (defaultHandler evhandler) tvargen) (\e -> print (e :: E.SomeException)) - return (UsrEv ActionOrdered) - waitSomeEvent (\case ActionOrdered -> True ; _ -> False ) - getFileContent (LocalDir mfname) - -- - xst2 <- get - let uhdl = view (unitHoodles.currentUnit) xst2 - hdlst = uhdl ^. hoodleModeState - cid = getCurrentCanvasId uhdl - callRenderer_ $ resetHoodleModeStateBuffers cid hdlst - pureUpdateUhdl (hoodleModeState .~ hdlst) - -- liftIO $ toggleSave ui False - liftIO $ reflectUIToggle ui "SAVEA" False - pureUpdateUhdl (isSaved .~ True) + -- additional initialization goes here + xst1 <- get + + let ui = xst1 ^. gtkUIManager + cachevar = xst1 ^. renderCacheVar + tvarpdf = xst1 ^. pdfRenderQueue + tvargen = xst1 ^. genRenderQueue + doIOaction $ \evhandler -> do + forkOn 2 $ pdfRendererMain (defaultHandler evhandler) tvarpdf + forkIO $ E.catch (genRendererMain cachevar (defaultHandler evhandler) tvargen) (\e -> print (e :: E.SomeException)) + return (UsrEv ActionOrdered) + waitSomeEvent (\case ActionOrdered -> True ; _ -> False ) + + getFileContent (LocalDir mfname) + -- + xst2 <- get + let uhdl = view (unitHoodles.currentUnit) xst2 + hdlst = uhdl ^. hoodleModeState + cid = getCurrentCanvasId uhdl + callRenderer_ $ resetHoodleModeStateBuffers cid hdlst + pureUpdateUhdl (hoodleModeState .~ hdlst) + liftIO $ reflectUIToggle ui "SAVEA" False + pureUpdateUhdl (isSaved .~ True) + case cvs of Just cvsi -> return cvsi Nothing -> nextevent >>= initialize Nothing True . UsrEv @@ -197,11 +197,11 @@ _ -> case (cvs,isInitialized) of (Just cvsi,True) -> return cvsi _ -> nextevent >>= initialize cvs isInitialized . UsrEv + -- | guiProcess :: AllEvent -> MainCoroutine () guiProcess ev = do (cid,cdim) <- initialize Nothing False ev - liftIO $ print (cid,cdim) changePage (const 0) reflectViewModeUI reflectPenModeUI @@ -217,19 +217,20 @@ syncFile #endif doCanvasConfigure cid cdim - -- main loop + -- main loop sequence_ (repeat dispatchMode) -- | dispatchMode :: MainCoroutine () -dispatchMode = (view (unitHoodles.currentUnit) <$> get) +dispatchMode = do + (view (unitHoodles.currentUnit) <$> get) >>= return . hoodleModeStateEither . view hoodleModeState >>= either (const viewAppendMode) (const selectMode) -- | viewAppendMode :: MainCoroutine () viewAppendMode = do - r1 <- nextevent + r1 <- nextevent case r1 of PenDown cid pbtn pcoord -> widgetCheckPen cid pcoord $ do diff --git a/src/Hoodle/Coroutine/Default/Menu.hs b/src/Hoodle/Coroutine/Default/Menu.hs --- a/src/Hoodle/Coroutine/Default/Menu.hs +++ b/src/Hoodle/Coroutine/Default/Menu.hs @@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.Default.Menu --- Copyright : (c) 2014, 2015 Ian-Woo Kim +-- Copyright : (c) 2014-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -133,13 +133,8 @@ let cmap = view cvsInfoMap uhdl canvases = map (getDrawAreaFromBox) . M.elems $ cmap updateFlagFromToggleUI "UXINPUTA" (settings.doesUseXInput) >>= \b -> -#ifdef GTK3 return () -#else - if b - then mapM_ (\x->liftIO $ Gtk.widgetSetExtensionEvents x [Gtk.ExtensionEventsAll]) canvases - else mapM_ (\x->liftIO $ Gtk.widgetSetExtensionEvents x [Gtk.ExtensionEventsNone] ) canvases -#endif + menuEventProcess MenuUseTouch = toggleTouch menuEventProcess MenuUsePopUpMenu = updateFlagFromToggleUI "POPMENUA" (settings.doesUsePopUpMenu) >> return () menuEventProcess MenuEmbedImage = updateFlagFromToggleUI "EBDIMGA" (settings.doesEmbedImage) >> return () @@ -206,34 +201,34 @@ -- | colorPickerBox :: String -> MainCoroutine (Maybe PenColor) colorPickerBox msg = do -#ifdef GTK3 - -- color selection dialog is incomplete in gtk3 - return Nothing -#else xst <- get let pcolor = view (penInfo.currentTool.penColor) xst doIOaction (action pcolor) >> go where - action pcolor _evhandler = do - dialog <- Gtk.colorSelectionDialogNew msg - csel <- Gtk.colorSelectionDialogGetColor dialog + action pcolor _evhandler = do + dialog <- Gtk.dialogNew -- Gtk.colorSelectionDialogNew msg + upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) + vbox <- Gtk.vBoxNew False 0 + Gtk.containerAdd upper vbox + csel <- Gtk.colorSelectionNew let (r,g,b,_a) = convertPenColorToRGBA pcolor color = Gtk.Color (floor (r*65535.0)) (floor (g*65535.0)) (floor (b*65535.0)) - Gtk.colorSelectionSetCurrentColor csel color + Gtk.boxPackStart vbox csel Gtk.PackGrow 0 + _btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk + Gtk.widgetShowAll dialog res <- Gtk.dialogRun dialog mc <- case res of Gtk.ResponseOk -> do - clrsel <- Gtk.colorSelectionDialogGetColor dialog - clr <- Gtk.colorSelectionGetCurrentColor clrsel + clr <- Gtk.colorSelectionGetCurrentColor csel return (Just (colorConvert clr)) _ -> return Nothing Gtk.widgetDestroy dialog - return (UsrEv (ColorChosen mc)) + return (UsrEv (ColorChosen mc)) go = do r <- nextevent case r of ColorChosen mc -> return mc UpdateCanvas cid -> -- this is temporary invalidateInBBox Nothing Efficient cid >> go _ -> go -#endif + diff --git a/src/Hoodle/Coroutine/Dialog.hs b/src/Hoodle/Coroutine/Dialog.hs --- a/src/Hoodle/Coroutine/Dialog.hs +++ b/src/Hoodle/Coroutine/Dialog.hs @@ -71,15 +71,9 @@ doIOaction $ \_evhandler -> do dialog <- Gtk.messageDialogNew Nothing [Gtk.DialogModal] Gtk.MessageQuestion Gtk.ButtonsOkCancel msg -#ifdef GTK3 vbox <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) txtvw <- Gtk.textViewNew Gtk.containerAdd vbox txtvw -#else - vbox <- Gtk.dialogGetUpper dialog - txtvw <- Gtk.textViewNew - Gtk.boxPackStart vbox txtvw Gtk.PackGrow 0 -#endif Gtk.widgetShowAll dialog res <- Gtk.dialogRun dialog case res of @@ -108,13 +102,9 @@ keywordDialog' :: [T.Text] -> (AllEvent -> IO ()) -> IO AllEvent keywordDialog' keys = \_evhandler -> do dialog <- Gtk.dialogNew -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif hbox <- Gtk.hBoxNew False 0 Gtk.boxPackStart vbox hbox Gtk.PackNatural 0 _btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk @@ -148,14 +138,9 @@ action = doIOaction $ \_evhandler -> do dialog <- Gtk.dialogNew - -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif hbox <- Gtk.hBoxNew False 0 txtbuf <- Gtk.textBufferNew Nothing Gtk.textBufferSetText txtbuf msg diff --git a/src/Hoodle/Coroutine/Draw.hs b/src/Hoodle/Coroutine/Draw.hs --- a/src/Hoodle/Coroutine/Draw.hs +++ b/src/Hoodle/Coroutine/Draw.hs @@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.Draw --- Copyright : (c) 2011-2015 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -133,30 +133,30 @@ fsingle :: RenderCache -> UnitHoodle -> CanvasInfo SinglePage -> MainCoroutine () fsingle cache uhdl cvsInfo = do let cpn = PageNum . view currentPageNum $ cvsInfo - isCurrentCvs = cid == getCurrentCanvasId uhdl - epage = getCurrentPageEitherFromHoodleModeState cvsInfo (view hoodleModeState uhdl) + isCurrentCvs = cid == getCurrentCanvasId uhdl + epage = getCurrentPageEitherFromHoodleModeState cvsInfo (view hoodleModeState uhdl) cvsid = view canvasId cvsInfo - cvs = view drawArea cvsInfo - msfc = view mDrawSurface cvsInfo + cvs = view drawArea cvsInfo + msfc = view mDrawSurface cvsInfo case epage of - Left page -> do - liftIO (unSinglePageDraw drawf cache cvsid isCurrentCvs (cvs,msfc) (cpn,page) - <$> view viewInfo <*> pure mbbox <*> pure flag $ cvsInfo ) - return () - Right tpage -> do - liftIO (unSinglePageDraw drawfsel cache cvsid isCurrentCvs (cvs,msfc) (cpn,tpage) - <$> view viewInfo <*> pure mbbox <*> pure flag $ cvsInfo ) - return () + Left page -> do + liftIO (unSinglePageDraw drawf cache cvsid isCurrentCvs (cvs,msfc) (cpn,page) + <$> view viewInfo <*> pure mbbox <*> pure flag $ cvsInfo ) + return () + Right tpage -> do + liftIO (unSinglePageDraw drawfsel cache cvsid isCurrentCvs (cvs,msfc) (cpn,tpage) + <$> view viewInfo <*> pure mbbox <*> pure flag $ cvsInfo ) + return () fcont :: RenderCache -> UnitHoodle -> CanvasInfo ContinuousPage -> MainCoroutine () fcont cache uhdl cvsInfo = do let hdlmodst = view hoodleModeState uhdl - isCurrentCvs = cid == getCurrentCanvasId uhdl + isCurrentCvs = cid == getCurrentCanvasId uhdl case hdlmodst of - ViewAppendState hdl -> do - hdl' <- liftIO (unContPageDraw drawcont cache isCurrentCvs cvsInfo mbbox hdl flag) + ViewAppendState hdl -> do + hdl' <- liftIO (unContPageDraw drawcont cache isCurrentCvs cvsInfo mbbox hdl flag) pureUpdateUhdl (const ((hoodleModeState .~ ViewAppendState hdl') uhdl)) - SelectState thdl -> do - thdl' <- liftIO (unContPageDraw drawcontsel cache isCurrentCvs cvsInfo mbbox thdl flag) + SelectState thdl -> do + thdl' <- liftIO (unContPageDraw drawcontsel cache isCurrentCvs cvsInfo mbbox thdl flag) pureUpdateUhdl (const ((hoodleModeState .~ SelectState thdl') uhdl)) -- | @@ -211,17 +211,9 @@ let canvas = view drawArea cvsInfo pnum = PageNum . view currentPageNum $ cvsInfo geometry <- liftIO $ getCanvasGeometryCvsId cid uhdl -#ifdef GTK3 Just win <- liftIO $ Gtk.widgetGetWindow canvas -#else - win <- liftIO $ Gtk.widgetGetDrawWindow canvas -#endif let xformfunc = cairoXform4PageCoordinate (mkXform4Page geometry pnum) -#ifdef GTK3 liftIO $ Gtk.renderWithDrawWindow win $ do -#else - liftIO $ Gtk.renderWithDrawable win $ do -#endif Cairo.setSourceSurface tempsurface 0 0 Cairo.setOperator Cairo.OperatorSource Cairo.paint @@ -243,17 +235,9 @@ fsingle uhdl cvsInfo = do let canvas = view drawArea cvsInfo geometry <- liftIO $ getCanvasGeometryCvsId cid uhdl -#ifdef GTK3 Just win <- liftIO $ Gtk.widgetGetWindow canvas -#else - win <- liftIO $ Gtk.widgetGetDrawWindow canvas -#endif let xformfunc = cairoXform4PageCoordinate (mkXform4Page geometry pnum) -#ifdef GTK3 liftIO $ Gtk.renderWithDrawWindow win $ do -#else - liftIO $ Gtk.renderWithDrawable win $ do -#endif Cairo.setSourceSurface tempsurface 0 0 Cairo.setOperator Cairo.OperatorSource Cairo.paint diff --git a/src/Hoodle/Coroutine/File.hs b/src/Hoodle/Coroutine/File.hs --- a/src/Hoodle/Coroutine/File.hs +++ b/src/Hoodle/Coroutine/File.hs @@ -131,11 +131,9 @@ constructNewHoodleStateFromHoodle h ctime <- liftIO $ getCurrentTime #ifdef HUB - -- let uhdluuid = view (unitHoodles.currentUnit.unitUUID) xstate msqlfile <- view (settings.sqliteFileName) <$> get let fileuuidbstr = view hoodleID h fileuuidtxt = TE.decodeUtf8 fileuuidbstr - liftIO $ print fileuuidtxt mfstat <- case msqlfile of Nothing -> return Nothing Just sqlfile -> liftIO (getLastSyncStatus sqlfile fileuuidtxt) @@ -645,13 +643,9 @@ where action (cache,cvsid) _evhandler = do dialog <- Gtk.dialogNew -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif mapM_ (addOneRevisionBox cache cvsid vbox hdl) revs _btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk Gtk.widgetShowAll dialog @@ -682,18 +676,10 @@ addOneRevisionBox :: RenderCache -> CanvasId -> Gtk.VBox -> Hoodle -> Revision -> IO () addOneRevisionBox cache cvsid vbox hdl rev = do cvs <- Gtk.drawingAreaNew - cvs `Gtk.on` Gtk.sizeRequest $ return (Gtk.Requisition 250 25) - cvs `Gtk.on` Gtk.exposeEvent $ Gtk.tryEvent $ do -#ifdef GTK3 + Gtk.widgetSetSizeRequest cvs 250 25 + cvs `Gtk.on` Gtk.draw $ do Just drawwdw <- liftIO $ Gtk.widgetGetWindow cvs -#else - drawwdw <- liftIO $ Gtk.widgetGetDrawWindow cvs -#endif -#ifdef GTK3 liftIO . Gtk.renderWithDrawWindow drawwdw $ do -#else - liftIO . Gtk.renderWithDrawable drawwdw $ do -#endif case rev of RevisionInk _ strks -> Cairo.scale 0.5 0.5 >> mapM_ (cairoRender cache cvsid) strks Revision _ txt -> mkPangoText (B.unpack txt) @@ -789,7 +775,6 @@ return (UsrEv ActionOrdered) SyncFileFinished nfstat <- lift (waitSomeEvent (\case SyncFileFinished _-> True ; _ -> False )) - liftIO $ print nfstat lift (updateSyncInfoAll nfstat) when (Just nfstat /= mfstat) (lift fileReload) return () diff --git a/src/Hoodle/Coroutine/HandwritingRecognition.hs b/src/Hoodle/Coroutine/HandwritingRecognition.hs --- a/src/Hoodle/Coroutine/HandwritingRecognition.hs +++ b/src/Hoodle/Coroutine/HandwritingRecognition.hs @@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.HandwritingRecognition --- Copyright : (c) 2014 Ian-Woo Kim +-- Copyright : (c) 2014,2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -60,7 +60,7 @@ handwritingRecognitionDialog :: MainCoroutine (Maybe (Bool,T.Text)) handwritingRecognitionDialog = do - r <- minibufDialog "test handwriting recognition" + r <- minibufDialog "Write hoodlet here" case r of Left err -> liftIO $ putStrLn (show err) >> return Nothing Right strks -> do @@ -101,13 +101,9 @@ where action = \evhandler -> do dialog <- Gtk.dialogNew -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif let txtlst' = zip [1..] txts txtlst <- forM txtlst' $ \(n,txt) -> do let str = T.unpack txt diff --git a/src/Hoodle/Coroutine/HubInternal.hs b/src/Hoodle/Coroutine/HubInternal.hs --- a/src/Hoodle/Coroutine/HubInternal.hs +++ b/src/Hoodle/Coroutine/HubInternal.hs @@ -90,8 +90,6 @@ let uuidtxt = TE.decodeUtf8 (view hoodleID hdl) flip runReaderT (manager,coojar) $ do mfstat <- sessionGetJSON (hubURL "sync" T.unpack uuidtxt) - liftIO $ print (mfstat :: Maybe FileSyncStatus) - liftIO $ print synchist let uploading = uploadAndUpdateSync evhandler uhdluuid hinfo uuidtxt hdlbstr (canfp,mhdlfp) msqlfile flip (maybe uploading) ((,) <$> msqlfile <*> mfstat) $ \(sqlfile,fstat) -> do @@ -125,7 +123,7 @@ readProcessWithExitCode "rdiff" ["delta", tsigfile, canfp, tdeltafile] "" deltabstr <- B.readFile tdeltafile - mapM_ removeFile [tsigfile,tdeltafile] + -- mapM_ removeFile [tsigfile,tdeltafile] (return . TE.decodeUtf8 . B64.encode) deltabstr let filecontent = toJSON FileContent { file_uuid = uuidtxt , file_path = T.pack <$> mhdlfp @@ -161,8 +159,11 @@ uhdlsMap <- snd . view unitHoodles <$> get let uhdls = IM.elems uhdlsMap case find (\x -> view unitUUID x == uuid) uhdls of - Nothing -> return () + Nothing -> do + liftIO $ putStrLn ("uuid=" ++ show uuid) + return () Just uhdl -> do + liftIO $ putStrLn "HERE" let nuhdlsMap = IM.adjust (over (hoodleFileControl.syncMD5History) (fileSyncStatusMd5 fstat :) ) (view unitKey uhdl) uhdlsMap modify (set (unitHoodles._2) nuhdlsMap) diff --git a/src/Hoodle/Coroutine/Link.hs b/src/Hoodle/Coroutine/Link.hs --- a/src/Hoodle/Coroutine/Link.hs +++ b/src/Hoodle/Coroutine/Link.hs @@ -266,13 +266,9 @@ where action mfn = do dialog <- Gtk.messageDialogNew Nothing [Gtk.DialogModal] Gtk.MessageQuestion Gtk.ButtonsOkCancel ("add link" :: String) -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif txtvw <- Gtk.textViewNew Gtk.boxPackStart vbox txtvw Gtk.PackGrow 0 Gtk.widgetShowAll dialog diff --git a/src/Hoodle/Coroutine/Minibuffer.hs b/src/Hoodle/Coroutine/Minibuffer.hs --- a/src/Hoodle/Coroutine/Minibuffer.hs +++ b/src/Hoodle/Coroutine/Minibuffer.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.Minibuffer --- Copyright : (c) 2013, 2014 Ian-Woo Kim +-- Copyright : (c) 2013, 2014, 2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -74,18 +74,10 @@ dialog <- Gtk.dialogNew msgLabel <- Gtk.labelNew (Just msg) cvs <- Gtk.drawingAreaNew - cvs `Gtk.on` Gtk.sizeRequest $ return (Gtk.Requisition 500 50) - cvs `Gtk.on` Gtk.exposeEvent $ Gtk.tryEvent $ do -#ifdef GTK3 + Gtk.widgetSetSizeRequest cvs 500 50 + cvs `Gtk.on` Gtk.draw $ do Just drawwdw <- liftIO $ Gtk.widgetGetWindow cvs -#else - drawwdw <- liftIO $ Gtk.widgetGetDrawWindow cvs -#endif -#ifdef GTK3 liftIO (Gtk.renderWithDrawWindow drawwdw drawMiniBufBkg) -#else - liftIO (Gtk.renderWithDrawable drawwdw drawMiniBufBkg) -#endif (liftIO . evhandler . UsrEv . MiniBuffer . MiniBufferInitialized) drawwdw cvs `Gtk.on` Gtk.buttonPressEvent $ Gtk.tryEvent $ do (mbtn,mp) <- getPointer dev @@ -108,21 +100,13 @@ case pbtn of TouchButton -> return () _ -> (liftIO . evhandler . UsrEv . MiniBuffer) (MiniBufferPenMove p) - {- if doesUseX11Ext - then widgetSetExtensionEvents cvs [ExtensionEventsAll] - else widgetSetExtensionEvents cvs [ExtensionEventsNone] -} Gtk.widgetAddEvents cvs [Gtk.PointerMotionMask,Gtk.Button1MotionMask] - -- -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif hbox <- Gtk.hBoxNew False 0 - Gtk.boxPackStart hbox msgLabel Gtk.PackNatural 0 - Gtk.boxPackStart vbox hbox Gtk.PackNatural 0 + Gtk.boxPackStart hbox msgLabel Gtk.PackGrow 0 + Gtk.boxPackStart vbox hbox Gtk.PackGrow 0 Gtk.boxPackStart vbox cvs Gtk.PackNatural 0 _btnOk <- Gtk.dialogAddButton dialog "Ok" Gtk.ResponseOk _btnCancel <- Gtk.dialogAddButton dialog "Cancel" Gtk.ResponseCancel @@ -151,11 +135,7 @@ invalidateMinibuf :: Gtk.DrawWindow -> Cairo.Surface -> IO () invalidateMinibuf drawwdw tgtsfc = -#ifdef GTK3 Gtk.renderWithDrawWindow drawwdw $ do -#else - Gtk.renderWithDrawable drawwdw $ do -#endif Cairo.setSourceSurface tgtsfc 0 0 Cairo.setOperator Cairo.OperatorSource Cairo.paint diff --git a/src/Hoodle/Coroutine/Scroll.hs b/src/Hoodle/Coroutine/Scroll.hs --- a/src/Hoodle/Coroutine/Scroll.hs +++ b/src/Hoodle/Coroutine/Scroll.hs @@ -2,11 +2,10 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} - ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.Scroll --- Copyright : (c) 2011-2014 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -40,6 +39,7 @@ import Hoodle.View.Coordinate -- + -- | updateCanvasInfo :: (forall a. CanvasInfo a -> CanvasInfo a) -> CanvasId -> MainCoroutine () updateCanvasInfo f cid = pureUpdateUhdl $ \uhdl -> @@ -48,8 +48,8 @@ in setCanvasInfo (cid,ncinfobox) uhdl -- | -updateCanvasInfo2 :: (CanvasInfo SinglePage -> CanvasInfo SinglePage) - -> (CanvasInfo ContinuousPage -> CanvasInfo ContinuousPage) +updateCanvasInfo2 :: (CanvasInfo 'SinglePage -> CanvasInfo 'SinglePage) + -> (CanvasInfo 'ContinuousPage -> CanvasInfo 'ContinuousPage) -> CanvasId -> MainCoroutine () updateCanvasInfo2 fs fc cid = @@ -66,7 +66,7 @@ where moveact :: CanvasInfo a -> CanvasInfo a moveact cinfo = - let BBox (x0,y0) _ = + let b@(BBox (x0,y0) _) = (unViewPortBBox . view (viewInfo.pageArrangement.viewPortBBox)) cinfo DesktopDimension ddim = view (viewInfo.pageArrangement.desktopDimension) cinfo @@ -74,7 +74,6 @@ (xformViewPortFitInSize ddim (moveBBoxULCornerTo (f (x0,y0)))) cinfo - -- | adjustScrollbarWithGeometryCvsId :: CanvasId -> MainCoroutine () adjustScrollbarWithGeometryCvsId cid = do @@ -135,10 +134,8 @@ -- | smoothScroll :: CanvasId -> CanvasGeometry -> Double -> Double -> MainCoroutine () smoothScroll cid geometry _v0 v = do - -- xst <- get let lst = [v] forM_ lst $ \v' -> do - -- updateXState $ return . updater updateCanvasInfo2 (scrollmovecanvas v) (scrollmovecanvasCont geometry v') cid invalidateInBBox Nothing Efficient cid where diff --git a/src/Hoodle/Coroutine/TextInput.hs b/src/Hoodle/Coroutine/TextInput.hs --- a/src/Hoodle/Coroutine/TextInput.hs +++ b/src/Hoodle/Coroutine/TextInput.hs @@ -89,13 +89,9 @@ multiLineDialog :: T.Text -> (AllEvent -> IO ()) -> IO AllEvent multiLineDialog str evhandler = do dialog <- Gtk.dialogNew -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif textbuf <- Gtk.textBufferNew Nothing Gtk.textBufferSetByteString textbuf (TE.encodeUtf8 str) textbuf `Gtk.on` Gtk.bufferChanged $ do @@ -105,7 +101,7 @@ textarea <- Gtk.textViewNewWithBuffer textbuf vscrbar <- Gtk.vScrollbarNew =<< Gtk.textViewGetVadjustment textarea hscrbar <- Gtk.hScrollbarNew =<< Gtk.textViewGetHadjustment textarea - textarea `Gtk.on` Gtk.sizeRequest $ return (Gtk.Requisition 500 600) + Gtk.widgetSetSizeRequest textarea 500 600 fdesc <- Gtk.fontDescriptionNew Gtk.fontDescriptionSetFamily fdesc ("Mono" :: String) Gtk.widgetModifyFont textarea (Just fdesc) @@ -496,14 +492,9 @@ linePosDialog :: Either (ActionOrder AllEvent) AllEvent linePosDialog = mkIOaction $ \_evhandler -> do dialog <- Gtk.dialogNew -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) vbox <- Gtk.vBoxNew False 0 Gtk.containerAdd upper vbox -#else - vbox <- Gtk.dialogGetUpper dialog -#endif - hbox <- Gtk.hBoxNew False 0 Gtk.boxPackStart vbox hbox Gtk.PackNatural 0 diff --git a/src/Hoodle/Coroutine/VerticalSpace.hs b/src/Hoodle/Coroutine/VerticalSpace.hs --- a/src/Hoodle/Coroutine/VerticalSpace.hs +++ b/src/Hoodle/Coroutine/VerticalSpace.hs @@ -243,16 +243,8 @@ Cairo.paint drawguide let canvas = view drawArea cvsInfo -#ifdef GTK3 Just win <- liftIO $ Gtk.widgetGetWindow canvas -#else - win <- liftIO $ Gtk.widgetGetDrawWindow canvas -#endif -#ifdef GTK3 liftIO $ Gtk.renderWithDrawWindow win $ do -#else - liftIO $ Gtk.renderWithDrawable win $ do -#endif Cairo.setSourceSurface sfctot 0 0 Cairo.setOperator Cairo.OperatorSource Cairo.paint diff --git a/src/Hoodle/Coroutine/Window.hs b/src/Hoodle/Coroutine/Window.hs --- a/src/Hoodle/Coroutine/Window.hs +++ b/src/Hoodle/Coroutine/Window.hs @@ -220,12 +220,6 @@ liftIO $ Gtk.widgetSetSensitive (uhdl^.unitButton) True modify $ (unitHoodles.currentUnit .~ uhdl) updateUhdl $ \uhdl' -> liftIO (updatePageAll (view hoodleModeState uhdl') uhdl') -#ifndef GTK3 - view currentCanvasInfo uhdl # - forBoth' unboxBiAct $ \cinfo -> do - (w,h) <- liftIO $ Gtk.widgetGetSize (cinfo^.drawArea) - doCanvasConfigure (cinfo^.canvasId) (CanvasDimension (Dim (fromIntegral w) (fromIntegral h))) -#endif invalidateAll liftIO $ reflectUIToggle (xst ^. gtkUIManager) "SAVEA" (not (uhdl ^. isSaved)) reflectPenModeUI diff --git a/src/Hoodle/Device.hsc b/src/Hoodle/Device.hsc --- a/src/Hoodle/Device.hsc +++ b/src/Hoodle/Device.hsc @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Device --- Copyright : (c) 2011-2014 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -74,36 +74,19 @@ -> CString -- ^ touch -> IO () -{- -- | -foreign import ccall "c_initdevice.h find_wacom" c_find_wacom - :: CString -> CString -> IO () - --- | -foreign import ccall "c_initdevice.h enable_touch" c_enable_touch - :: CString -> IO () - --- | -foreign import ccall "c_initdevice.h disable_touch" c_disable_touch - :: DrawWindow -> CString -> IO () --} - - - --- | initDevice :: Config -> IO DeviceList initDevice cfg = do pstylusname_detect <- newCString "stylus" perasername_detect <- newCString "eraser" ptouchname_detect <- newCString "touch" - -- c_find_wacom pstylusname_detect perasername_detect (mcore,mstylus,meraser,mtouch) <- getPenDevConfig cfg with 0 $ \pcore -> with 0 $ \pstylus -> with 0 $ \peraser -> do with 0 $ \ptouch -> do (pcorename,corename) <- case mcore of - Nothing -> (,) <$> newCString "Core Pointer" <*> pure "Core Pointer" + Nothing -> (,) <$> newCString "Virtual core pointer" <*> pure "Virtual core pointer" Just core -> (,) <$> newCString core <*> pure core (pstylusname,stylusname) <- case mstylus of Nothing -> return (pstylusname_detect,"stylus") @@ -122,6 +105,7 @@ stylus_val <- peek pstylus eraser_val <- peek peraser touch_val <- peek ptouch + return $ DeviceList core_val corename stylus_val stylusname eraser_val erasername touch_val touchname -- | @@ -135,13 +119,11 @@ | btn == 3 = Just PenButton3 | otherwise = Nothing case mdev of - Nothing -> -- return (rbtn,PointerCoord Core x y 1.0) - return (rbtn,Nothing) + Nothing -> return (rbtn,Nothing) Just dev -> case maxf of Nothing -> return (rbtn,Just (PointerCoord Core x y 1.0)) - -- return (rbtn,Nothing) Just axf -> do - mpcoord <- liftIO $ coord ptr x y dev axf + mpcoord <- liftIO $ coord ptr x y dev axf let rbtnfinal = case mpcoord of Nothing -> rbtn Just pcoord -> case pointerType pcoord of @@ -215,11 +197,11 @@ -> (Double,Double) -> IO (Double,Double) wacomCoordConvert canvas (x,y)= do -#ifdef GTK3 + -- #ifdef GTK3 Just win <- widgetGetWindow canvas -- partial function for the time being -#else // GTK3 - win <- widgetGetDrawWindow canvas -#endif // GTK3 + -- #else // GTK3 + -- win <- widgetGetDrawWindow canvas + -- #endif // GTK3 (x0,y0) <- drawWindowGetOrigin win screen <- widgetGetScreen canvas (ws,hs) <- (,) <$> screenGetWidth screen <*> screenGetHeight screen diff --git a/src/Hoodle/GUI.hs b/src/Hoodle/GUI.hs --- a/src/Hoodle/GUI.hs +++ b/src/Hoodle/GUI.hs @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.GUI --- Copyright : (c) 2011-2014 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -59,22 +59,24 @@ (tref,st0,ui,vbox) <- initCoroutine devlst window mhook maxundo (xinputbool,usepz,uselyr,varcsr) setTitleFromFileName st0 -- need for refactoring - mapM_ (\(x,y :: Simple Lens Settings Bool) -> lensSetToggleUIForFlag x (settings.y) st0 ) + {- + mapM_ (\(x,y :: Simple Lens Settings Bool ) -> lensSetToggleUIForFlag x (settings.y) st0 ) [ ("UXINPUTA", doesUseXInput) , ("HANDA" , doesUseTouch) , ("POPMENUA", doesUsePopUpMenu) , ("EBDIMGA" , doesEmbedImage) , ("EBDPDFA" , doesEmbedPDF) - ] + ] -} + lensSetToggleUIForFlag "UXINPUTA" (settings.doesUseXInput) st0 + lensSetToggleUIForFlag "HANDA" (settings.doesUseTouch) st0 + lensSetToggleUIForFlag "POPMENUA" (settings.doesUsePopUpMenu) st0 + lensSetToggleUIForFlag "EBDIMGA" (settings.doesEmbedImage) st0 + lensSetToggleUIForFlag "EBDPDFA" (settings.doesEmbedPDF) st0 + + setToggleUIForFlag "TOGGLENETSRCA" False st0 -- let canvases = map (getDrawAreaFromBox) . M.elems . view (unitHoodles.currentUnit.cvsInfoMap) $ st0 -#ifndef GTK3 - if xinputbool - then mapM_ (flip Gtk.widgetSetExtensionEvents [Gtk.ExtensionEventsAll]) canvases - else mapM_ (flip Gtk.widgetSetExtensionEvents [Gtk.ExtensionEventsNone]) canvases -#endif - -- outerLayout ui vbox st0 window `Gtk.on` Gtk.deleteEvent $ do liftIO $ eventHandler tref (UsrEv (Menu MenuQuit)) diff --git a/src/Hoodle/GUI/Menu.hs b/src/Hoodle/GUI/Menu.hs --- a/src/Hoodle/GUI/Menu.hs +++ b/src/Hoodle/GUI/Menu.hs @@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} ----------------------------------------------------------------------------- -- | -- Module : Hoodle.GUI.Menu --- Copyright : (c) 2011-2015 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -22,7 +23,13 @@ import Control.Lens (set) import Control.Monad import qualified Data.Foldable as F (forM_) +import Foreign.C.Types (CInt(..)) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (Ptr(..)) import qualified Graphics.UI.Gtk as Gtk +import qualified Graphics.UI.Gtk.General.CssProvider as Gtk +import qualified Graphics.UI.Gtk.General.StyleContext as Gtk +import qualified Graphics.UI.GtkInternals as Gtk (unToolbar) import System.FilePath -- from hoodle-platform import Data.Hoodle.Predefined @@ -32,10 +39,20 @@ -- import Paths_hoodle_core + +-- | This is because haskell gtk3 package miss gtk_toolbar_set_icon_size. +-- Refer to leksah IDE.Find module. +foreign import ccall safe "gtk_toolbar_set_icon_size" + gtk_toolbar_set_icon_size :: Ptr Gtk.Toolbar -> CInt -> IO () + +toolbarSetIconSize :: Gtk.ToolbarClass self => self -> Gtk.IconSize -> IO () +toolbarSetIconSize self iconSize = + withForeignPtr (Gtk.unToolbar $ Gtk.toToolbar self) $ + \selfPtr -> gtk_toolbar_set_icon_size selfPtr (fromIntegral $ fromEnum iconSize) + justMenu :: MenuEvent -> Maybe UserEvent justMenu = Just . Menu - iconList :: [ (String,Gtk.StockId) ] iconList = [ ("fullscreen.png" , "myfullscreen") , ("pencil.png" , "mypen") @@ -137,7 +154,8 @@ iconResourceAdd iconfac resdir (fp,stid) = do myIconSource <- Gtk.iconSourceNew Gtk.iconSourceSetFilename myIconSource (resdir fp) - Gtk.iconSourceSetSize myIconSource Gtk.IconSizeLargeToolbar + -- Gtk.iconSourceSetSize myIconSource Gtk.IconSizeLargeToolbar + Gtk.iconSourceSetSize myIconSource Gtk.IconSizeSmallToolbar myIconSourceSmall <- Gtk.iconSourceNew Gtk.iconSourceSetFilename myIconSourceSmall (resdir fp) Gtk.iconSourceSetSize myIconSource Gtk.IconSizeMenu @@ -171,6 +189,12 @@ myiconfac <- Gtk.iconFactoryNew Gtk.iconFactoryAddDefault myiconfac resDir <- getDataDir >>= return . ( "resource") + + css <- Gtk.cssProviderNew + Gtk.cssProviderLoadFromPath css (resDir "hoodle.css") + Just screen <- Gtk.screenGetDefault + Gtk.styleContextAddProviderForScreen screen css 800 + mapM_ (iconResourceAdd myiconfac resDir) iconList fma <- actionNewAndRegister "FMA" "File" Nothing Nothing Nothing ema <- actionNewAndRegister "EMA" "Edit" Nothing Nothing Nothing @@ -344,13 +368,9 @@ uxinputa <- Gtk.toggleActionNew ("UXINPUTA" :: String) "Use XInput" (Just "Just a Stub") Nothing uxinputa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUseXInput)) - -- handa <- actionNewAndRegister "HANDA" "Use Touch" (Just "Use touch") (Just "myhand") (justMenu MenuUseTouch) handa <- Gtk.toggleActionNew ("HANDA" :: String) "Use Touch" (Just "Toggle touch") (Just "myhand") handa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUseTouch)) - -- smthscra <- Gtk.toggleActionNew ("SMTHSCRA" :: String) "Smooth Scrolling" (Just "Just a stub") Nothing - -- smthscra `Gtk.on` Gtk.actionToggled $ do - -- eventHandler evar (UsrEv (Menu MenuSmoothScroll)) popmenua <- Gtk.toggleActionNew ("POPMENUA" :: String) "Use Popup Menu" (Just "Just a stub") Nothing popmenua `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUsePopUpMenu)) @@ -385,10 +405,8 @@ #ifdef HUB huba <- actionNewAndRegister "HUBA" "Hub" (Just "Just a Stub") Nothing (justMenu MenuHub) - -- hubsocketa <- actionNewAndRegister "HUBSOCKETA" "Hub Socket" (Just "Just a Stub") Nothing (justMenu MenuHubSocket) #else huba <- actionNewAndRegister "HUBA" "Hub" (Just "Just a Stub") Nothing (justMenu MenuDefault) - -- hubsocketa <- actionNewAndRegister "HUBSOCKETA" "Hub Socket" (Just "Just a Stub") Nothing (justMenu MenuDefault) #endif @@ -498,14 +516,10 @@ Gtk.actionSetSensitive ra6 True Just toolbar1 <- Gtk.uiManagerGetWidget ui ("/ui/toolbar1" :: String) Gtk.toolbarSetStyle (Gtk.castToToolbar toolbar1) Gtk.ToolbarIcons -#ifndef GTK3 - Gtk.toolbarSetIconSize (Gtk.castToToolbar toolbar1) Gtk.IconSizeSmallToolbar -#endif + toolbarSetIconSize (Gtk.castToToolbar toolbar1) Gtk.IconSizeSmallToolbar Just toolbar2 <- Gtk.uiManagerGetWidget ui ("/ui/toolbar2" :: String) Gtk.toolbarSetStyle (Gtk.castToToolbar toolbar2) Gtk.ToolbarIcons -#ifndef GTK3 - Gtk.toolbarSetIconSize (Gtk.castToToolbar toolbar2) Gtk.IconSizeSmallToolbar -#endif + toolbarSetIconSize (Gtk.castToToolbar toolbar2) Gtk.IconSizeSmallToolbar let uicomponentsignalhandler = set penModeSignal mpenmodconnid . set pageModeSignal mpgmodconnid diff --git a/src/Hoodle/GUI/Reflect.hs b/src/Hoodle/GUI/Reflect.hs --- a/src/Hoodle/GUI/Reflect.hs +++ b/src/Hoodle/GUI/Reflect.hs @@ -63,7 +63,7 @@ -- | block signal for act blockWhile :: (Gtk.GObjectClass w) => Maybe (Gtk.ConnectId w) -> IO () -> IO () blockWhile msig act = do - F.mapM_ (\_ -> print "signal will be blocked") msig + -- F.mapM_ (\_ -> print "signal will be blocked") msig F.mapM_ Gtk.signalBlock msig >> act >> F.mapM_ Gtk.signalUnblock msig @@ -187,11 +187,7 @@ else do let uhdl = view (unitHoodles.currentUnit) xst cinfobox = view currentCanvasInfo uhdl canvas = forBoth' unboxBiAct (view drawArea) cinfobox -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif Gtk.postGUIAsync (Gtk.drawWindowSetCursor win Nothing) return (UsrEv ActionOrdered) where @@ -208,11 +204,7 @@ pinfo = view penInfo xst pcolor = view (penSet . currPen . penColor) pinfo pwidth = view (penSet . currPen . penWidth) pinfo -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif dpy <- Gtk.widgetGetDisplay canvas geometry <- diff --git a/src/Hoodle/ModelAction/Layer.hs b/src/Hoodle/ModelAction/Layer.hs --- a/src/Hoodle/ModelAction/Layer.hs +++ b/src/Hoodle/ModelAction/Layer.hs @@ -49,13 +49,8 @@ Gtk.entrySetText layerentry (show (succ cidx)) label <- Gtk.labelNew (Just (" / " ++ show len)) hbox <- Gtk.hBoxNew False 0 -#ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) Gtk.containerAdd upper hbox -#else - upper <- Gtk.dialogGetUpper dialog - Gtk.boxPackStart upper hbox Gtk.PackNatural 0 -#endif Gtk.boxPackStart hbox layerentry Gtk.PackNatural 0 Gtk.boxPackStart hbox label Gtk.PackGrow 0 Gtk.widgetShowAll upper diff --git a/src/Hoodle/ModelAction/Page.hs b/src/Hoodle/ModelAction/Page.hs --- a/src/Hoodle/ModelAction/Page.hs +++ b/src/Hoodle/ModelAction/Page.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.ModelAction.Page --- Copyright : (c) 2011-2015 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -138,8 +138,8 @@ -- | setPageSingle : in Single Page mode setPageSingle :: UnitHoodle -> PageNum - -> CanvasInfo SinglePage - -> IO (CanvasInfo SinglePage) + -> CanvasInfo 'SinglePage + -> IO (CanvasInfo 'SinglePage) setPageSingle uhdl pnum cinfo = do let hdl = getHoodle uhdl geometry <- getCvsGeomFrmCvsInfo cinfo @@ -153,8 +153,8 @@ -- | setPageCont : in Continuous Page mode setPageCont :: UnitHoodle -> PageNum - -> CanvasInfo ContinuousPage - -> IO (CanvasInfo ContinuousPage) + -> CanvasInfo 'ContinuousPage + -> IO (CanvasInfo 'ContinuousPage) setPageCont uhdl pnum cinfo = do let hdl = getHoodle uhdl geometry <- getCvsGeomFrmCvsInfo cinfo diff --git a/src/Hoodle/ModelAction/Text.hs b/src/Hoodle/ModelAction/Text.hs --- a/src/Hoodle/ModelAction/Text.hs +++ b/src/Hoodle/ModelAction/Text.hs @@ -38,7 +38,7 @@ -- | getKeywordMap :: T.Text -> M.HashMap T.Text T.Text getKeywordMap txt = case parseOnly (many keywordContents) txt of - Left err -> trace (show err) $ M.empty + Left err -> M.empty Right lst -> M.fromList lst diff --git a/src/Hoodle/ModelAction/Window.hs b/src/Hoodle/ModelAction/Window.hs --- a/src/Hoodle/ModelAction/Window.hs +++ b/src/Hoodle/ModelAction/Window.hs @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.ModelAction.Window --- Copyright : (c) 2011-2015 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -101,12 +101,19 @@ minimalCanvasInfo :: CanvasId -> IO (CanvasInfo a) minimalCanvasInfo cid = do canvas <- Gtk.drawingAreaNew - scrwin <- Gtk.scrolledWindowNew Nothing Nothing - Gtk.containerAdd scrwin canvas hadj <- Gtk.adjustmentNew 0 0 500 100 200 200 vadj <- Gtk.adjustmentNew 0 0 500 100 200 200 - Gtk.scrolledWindowSetHAdjustment scrwin hadj - Gtk.scrolledWindowSetVAdjustment scrwin vadj + + vbox <- Gtk.vBoxNew False 0 + hscr <- Gtk.hScrollbarNew hadj + hbox <- Gtk.hBoxNew False 0 + vscr <- Gtk.vScrollbarNew vadj + Gtk.boxPackStart hbox canvas Gtk.PackGrow 0 + Gtk.boxPackEnd hbox vscr Gtk.PackNatural 0 + Gtk.boxPackStart vbox hbox Gtk.PackGrow 0 + Gtk.boxPackEnd vbox hscr Gtk.PackNatural 0 + + let scrwin = MyScrollWindow vbox hscr vscr return $ CanvasInfo cid canvas Nothing scrwin (error "no viewInfo" :: ViewInfo a) 0 hadj vadj Nothing Nothing defaultCanvasWidgets Nothing @@ -123,17 +130,16 @@ hadj = _horizAdjustment cinfo vadj = _vertAdjustment cinfo Gtk.widgetSetCanFocus canvas True - Gtk.widgetGrabFocus canvas -#ifdef GTK3 - {- -#endif - _sizereq <- canvas `Gtk.on` Gtk.sizeRequest $ return (Gtk.Requisition 800 400) + Gtk.widgetGrabFocus canvas + _confevent <- canvas `Gtk.on` Gtk.configureEvent $ Gtk.tryEvent $ do + (w,h) <- Gtk.eventSize + liftIO $ callback (UsrEv (CanvasConfigure cid (fromIntegral w) (fromIntegral h))) _keyevent <- canvas `Gtk.on` Gtk.keyPressEvent $ Gtk.tryEvent $ do m <- Gtk.eventModifier n <- Gtk.eventKeyName let keystr = show m ++ ":" ++ show n liftIO $ (callback (UsrEv (CustomKeyEvent keystr))) - _bpevent <- canvas `Gtk.on` Gtk.buttonPressEvent $ Gtk.tryEvent $ do + _bpevent <- canvas `Gtk.on` Gtk.buttonPressEvent $ Gtk.tryEvent $ do liftIO $ Gtk.widgetGrabFocus canvas (mbtn,mp) <- getPointer dev forM_ mp $ \p -> do @@ -141,9 +147,6 @@ case pbtn of TouchButton -> liftIO (callback (UsrEv (TouchDown cid p))) _ -> liftIO (callback (UsrEv (PenDown cid pbtn p))) - _confevent <- canvas `Gtk.on` Gtk.configureEvent $ Gtk.tryEvent $ do - (w,h) <- Gtk.eventSize - liftIO $ callback (UsrEv (CanvasConfigure cid (fromIntegral w) (fromIntegral h))) _brevent <- canvas `Gtk.on` Gtk.buttonReleaseEvent $ Gtk.tryEvent $ do (mbtn,mp) <- getPointer dev forM_ mp $ \p -> do @@ -159,15 +162,9 @@ Gtk.widgetGrabFocus canvas _focusout <- canvas `Gtk.on` Gtk.focusOutEvent $ Gtk.tryEvent $ liftIO $ atomically (writeTVar tvar False) #endif - - -#ifdef GTK3 - _exposeev <- canvas `Gtk.on` Gtk.draw $ do -#else - _exposeev <- canvas `Gtk.on` Gtk.exposeEvent $ Gtk.tryEvent $ do -#endif + _drawev <- canvas `Gtk.on` Gtk.draw $ do liftIO $ Gtk.widgetGrabFocus canvas - (liftIO . callback . UsrEv) (UpdateCanvas cid) + (liftIO . callback . UsrEv) (UpdateCanvas cid) canvas `Gtk.on` Gtk.motionNotifyEvent $ Gtk.tryEvent $ do (mbtn,mp) <- getPointer dev forM_ mp $ \p -> do @@ -187,21 +184,15 @@ case x of [] -> error "No action group? " y:_ -> return y ) - uxinputa <- liftIO (Gtk.actionGroupGetAction agr ("UXINPUTA" :: String) >>= \(Just x) -> + uxinputa <- liftIO (Gtk.actionGroupGetAction agr ("UXINPUTA" :: String) >>= \(Just x) -> return (Gtk.castToToggleAction x) ) - b <- liftIO $ Gtk.toggleActionGetActive uxinputa -#ifdef GTK3 -#else - if b then Gtk.widgetSetExtensionEvents canvas [Gtk.ExtensionEventsAll] - else Gtk.widgetSetExtensionEvents canvas [Gtk.ExtensionEventsNone] -#endif hadjconnid <- Gtk.afterValueChanged hadj $ do v <- Gtk.adjustmentGetValue hadj (callback . UsrEv) (HScrollBarMoved cid v) vadjconnid <- Gtk.afterValueChanged vadj $ do v <- Gtk.adjustmentGetValue vadj (callback . UsrEv) (VScrollBarMoved cid v) - Just vscrbar <- Gtk.scrolledWindowGetVScrollbar scrwin + let vscrbar = _scrollVScrollbar scrwin _bpevtvscrbar <- vscrbar `Gtk.on` Gtk.buttonPressEvent $ do v <- liftIO $ Gtk.adjustmentGetValue vadj liftIO ((callback . UsrEv) (VScrollBarStart cid v)) @@ -212,11 +203,6 @@ return False return $ cinfo { _horizAdjConnId = Just hadjconnid , _vertAdjConnId = Just vadjconnid } -#ifdef GTK3 - -} -#endif - -- temp - return $ cinfo -- | recreate windows from old canvas info but no event connect reinitCanvasInfoStage1 @@ -274,7 +260,7 @@ ncinfobox <- forBoth unboxBiXform (reinitCanvasInfoStage1 uhdl) cinfobox let uhdl' = updateFromCanvasInfoAsCurrentCanvas ncinfobox uhdl forBoth' unboxBiAct (putStrLn <=< Gtk.widgetGetName . view drawArea) ncinfobox - let scrwin = forBoth' unboxBiAct (Gtk.castToWidget.view scrolledWindow) ncinfobox + let scrwin = forBoth' unboxBiAct (Gtk.castToWidget . _scrollCanvas . view scrolledWindow) ncinfobox return (uhdl', scrwin, Node cid) constructFrame' callback template uhdl (HSplit wconf1 wconf2) = do (uhdl',win1,wconf1') <- constructFrame' callback template uhdl wconf1 diff --git a/src/Hoodle/Type/Canvas.hs b/src/Hoodle/Type/Canvas.hs --- a/src/Hoodle/Type/Canvas.hs +++ b/src/Hoodle/Type/Canvas.hs @@ -29,9 +29,10 @@ , CanvasInfo (..) , CanvasInfoBox (..) , CanvasInfoMap -, WidthColorStyle +, MyScrollWindow (..) , PenHighlighterEraserSet , PenInfo +, WidthColorStyle -- * default constructor , defaultViewInfoSinglePage , defaultCvsInfoSinglePage @@ -145,12 +146,17 @@ pageArrangement :: Simple Lens (ViewInfo a) (PageArrangement a) pageArrangement = lens _pageArrangement (\f a -> f { _pageArrangement = a }) +data MyScrollWindow = MyScrollWindow { _scrollCanvas :: Gtk.VBox + , _scrollHScrollbar :: Gtk.HScrollbar + , _scrollVScrollbar :: Gtk.VScrollbar + } + -- | data CanvasInfo (a :: ViewMode) = CanvasInfo { _canvasId :: CanvasId , _drawArea :: Gtk.DrawingArea , _mDrawSurface :: Maybe Cairo.Surface - , _scrolledWindow :: Gtk.ScrolledWindow + , _scrolledWindow :: MyScrollWindow -- Gtk.ScrolledWindow , _viewInfo :: ViewInfo a , _currentPageNum :: Int , _horizAdjustment :: Gtk.Adjustment @@ -180,7 +186,7 @@ } -- | -defaultCvsInfoSinglePage :: CanvasInfo SinglePage +defaultCvsInfoSinglePage :: CanvasInfo 'SinglePage defaultCvsInfoSinglePage = CanvasInfo { _canvasId = error "defaultCvsInfoSinglePage cvsid" , _drawArea = error "defaultCvsInfoSinglePage DrawingArea" @@ -210,7 +216,7 @@ -- | -scrolledWindow :: Simple Lens (CanvasInfo a) Gtk.ScrolledWindow +scrolledWindow :: Simple Lens (CanvasInfo a) MyScrollWindow scrolledWindow = lens _scrolledWindow (\f a -> f { _scrolledWindow = a }) -- | diff --git a/src/Hoodle/Type/PageArrangement.hs b/src/Hoodle/Type/PageArrangement.hs --- a/src/Hoodle/Type/PageArrangement.hs +++ b/src/Hoodle/Type/PageArrangement.hs @@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Type.PageArrangement --- Copyright : (c) 2012-2014 Ian-Woo Kim +-- Copyright : (c) 2012-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -25,13 +25,13 @@ import Control.Lens (Simple,Lens,view,lens) import Data.Foldable (toList) -- from hoodle-platform -import Data.Hoodle.Simple (Dimension(..)) -import Data.Hoodle.Generic -import Data.Hoodle.BBox +import Data.Hoodle.Simple (Dimension(..)) +import Data.Hoodle.Generic +import Data.Hoodle.BBox -- from this package -import Hoodle.Type.Predefined -import Hoodle.Type.Alias -import Hoodle.Util +import Hoodle.Type.Predefined +import Hoodle.Type.Alias +import Hoodle.Util -- -- | supported zoom modes @@ -112,9 +112,6 @@ | y1 < (-ymargin) = (-ymargin,-ymargin+y2-y1) | otherwise = (y1,y2) in ViewPortBBox (BBox (x1',y1') (x2',y2') ) - - - -- | data structure for coordinate arrangement of pages in desktop coordinate data PageArrangement (a :: ViewMode) where diff --git a/src/Hoodle/Type/Undo.hs b/src/Hoodle/Type/Undo.hs --- a/src/Hoodle/Type/Undo.hs +++ b/src/Hoodle/Type/Undo.hs @@ -35,8 +35,11 @@ Nothing -> UndoTable an 1 . Just . singletonSZ $ e Just zs -> if tn < an - then UndoTable an (tn+1) . Just . appendGoLast zs $ e - else UndoTable an an . chopFirst . appendGoLast zs $ e + -- FIXME: this causes undo_totalnum to be an overestimate and can + -- cause the oldest undo item to be dropped unnecessarily. + then UndoTable an (length zs') . Just $ zs' + else UndoTable an (length zs') . chopFirst $ zs' + where zs' = appendDropSecond zs e getCurrentUndoItem :: UndoTable a -> Maybe a getCurrentUndoItem = fmap current . undo_zipper diff --git a/src/Hoodle/Util.hs b/src/Hoodle/Util.hs --- a/src/Hoodle/Util.hs +++ b/src/Hoodle/Util.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Util --- Copyright : (c) 2013, 2014 Ian-Woo Kim +-- Copyright : (c) 2013-2015 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -28,7 +28,6 @@ import System.Environment import System.FilePath import System.IO -import System.Locale -- import Data.Hoodle.Simple -- diff --git a/src/Hoodle/View/Coordinate.hs b/src/Hoodle/View/Coordinate.hs --- a/src/Hoodle/View/Coordinate.hs +++ b/src/Hoodle/View/Coordinate.hs @@ -58,11 +58,7 @@ -> Gtk.DrawingArea -> IO CanvasGeometry makeCanvasGeometry cpn arr canvas = do -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif let cdim@(CanvasDimension (Dim w' h')) = view canvasDimension arr screen <- Gtk.widgetGetScreen canvas (ws,hs) <- (,) <$> (fromIntegral <$> Gtk.screenGetWidth screen) diff --git a/src/Hoodle/View/Draw.hs b/src/Hoodle/View/Draw.hs --- a/src/Hoodle/View/Draw.hs +++ b/src/Hoodle/View/Draw.hs @@ -4,10 +4,11 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} + ----------------------------------------------------------------------------- -- | -- Module : Hoodle.View.Draw --- Copyright : (c) 2011-2015 Ian-Woo Kim +-- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -18,12 +19,12 @@ module Hoodle.View.Draw where -import Control.Applicative -import Control.Monad.Trans -import Control.Monad.Trans.Maybe +import Control.Applicative +import Control.Monad.Trans +import Control.Monad.Trans.Maybe import Control.Lens (view,set,at) -import Control.Monad (when) -import Data.Foldable hiding (elem) +import Control.Monad (when) +import Data.Foldable hiding (elem) import qualified Data.IntMap as M import Data.Maybe hiding (fromMaybe) import Data.Monoid @@ -31,65 +32,67 @@ import qualified Graphics.Rendering.Cairo as Cairo import qualified Graphics.UI.Gtk as Gtk -- from hoodle-platform -import Data.Hoodle.BBox -import Data.Hoodle.Generic -import Data.Hoodle.Predefined -import Data.Hoodle.Select -import Data.Hoodle.Simple (Dimension(..),Stroke(..)) -import Data.Hoodle.Zipper (currIndex) -import Graphics.Hoodle.Render -import Graphics.Hoodle.Render.Generic -import Graphics.Hoodle.Render.Highlight -import Graphics.Hoodle.Render.Type -import Graphics.Hoodle.Render.Type.HitTest -import Graphics.Hoodle.Render.Util +import Data.Hoodle.BBox +import Data.Hoodle.Generic +import Data.Hoodle.Predefined +import Data.Hoodle.Select +import Data.Hoodle.Simple (Dimension(..),Stroke(..)) +import Data.Hoodle.Zipper (currIndex) +import Graphics.Hoodle.Render +import Graphics.Hoodle.Render.Generic +import Graphics.Hoodle.Render.Highlight +import Graphics.Hoodle.Render.Type +import Graphics.Hoodle.Render.Type.HitTest +import Graphics.Hoodle.Render.Util -- from this package -import Hoodle.Type.Alias -import Hoodle.Type.Canvas -import Hoodle.Type.PageArrangement -import Hoodle.Type.Enum -import Hoodle.Type.Predefined -import Hoodle.Type.Widget -import Hoodle.Util -import Hoodle.View.Coordinate +import Hoodle.Type.Alias +import Hoodle.Type.Canvas +import Hoodle.Type.PageArrangement +import Hoodle.Type.Enum +import Hoodle.Type.Predefined +import Hoodle.Type.Widget +import Hoodle.Util +import Hoodle.View.Coordinate -- -import Prelude hiding (mapM_,concatMap,foldr) - +import Prelude hiding (mapM_,concatMap,foldr) -- | type family DrawingFunction (v :: ViewMode) :: * -> * -- | - newtype SinglePageDraw a = SinglePageDraw { unSinglePageDraw :: RenderCache -> CanvasId - -> Bool -- ^ isCurrentCanvas + -> Bool -> (Gtk.DrawingArea, Maybe Cairo.Surface) -> (PageNum, Page a) - -> ViewInfo SinglePage + -> ViewInfo 'SinglePage -> Maybe BBox -> DrawFlag -> IO (Page a) } +-- Bool = isCurrentCanvas + -- | newtype ContPageDraw a = ContPageDraw { unContPageDraw :: RenderCache - -> Bool -- ^ isCurrentCanvas - -> CanvasInfo ContinuousPage + -> Bool + -> CanvasInfo 'ContinuousPage -> Maybe BBox -> Hoodle a -> DrawFlag -> IO (Hoodle a) } +-- Bool = isCurrentCanvas + -- | -type instance DrawingFunction SinglePage = SinglePageDraw +type instance DrawingFunction 'SinglePage = SinglePageDraw -- | -type instance DrawingFunction ContinuousPage = ContPageDraw +type instance DrawingFunction 'ContinuousPage = ContPageDraw -- | getCanvasViewPort :: CanvasGeometry -> ViewPortBBox @@ -133,22 +136,12 @@ doubleBufferFlush :: Cairo.Surface -> CanvasInfo a -> IO () doubleBufferFlush sfc cinfo = do let canvas = view drawArea cinfo -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif -#ifdef GTK3 Gtk.renderWithDrawWindow win $ do -#else - Gtk.renderWithDrawable win $ do -#endif Cairo.setSourceSurface sfc 0 0 Cairo.setOperator Cairo.OperatorSource Cairo.paint - - -- | common routine for double buffering doubleBufferDraw :: (Gtk.DrawWindow, Maybe Cairo.Surface) -> CanvasGeometry @@ -163,39 +156,33 @@ Bottom -> Nothing let action = do case msfc of - Nothing -> do -#ifdef GTK3 + Nothing -> do Gtk.renderWithDrawWindow win $ do -#else - Gtk.renderWithDrawable win $ do -#endif - clipBBox mbbox' + clipBBox mbbox' Cairo.setSourceRGBA 0.5 0.5 0.5 1 Cairo.rectangle 0 0 cw ch Cairo.fill - rndr - Just sfc -> do - r <- Cairo.renderWith sfc $ do + rndr + Just sfc -> do + r <- Cairo.renderWith sfc $ do clipBBox mbbox' Cairo.setSourceRGBA 0.5 0.5 0.5 1 Cairo.rectangle 0 0 cw ch Cairo.fill clipBBox mbbox' - rndr -#ifdef GTK3 + rndr Gtk.renderWithDrawWindow win $ do -#else - Gtk.renderWithDrawable win $ do -#endif - Cairo.setSourceSurface sfc 0 0 - Cairo.setOperator Cairo.OperatorSource - Cairo.paint + Cairo.setSourceSurface sfc 0 0 + Cairo.setOperator Cairo.OperatorSource + Cairo.paint return r case ibbox of Top -> Just <$> action Middle _ -> Just <$> action Bottom -> return Nothing + + -- | mkXform4Page :: CanvasGeometry -> PageNum -> Xform4Page mkXform4Page geometry pnum = @@ -226,16 +213,8 @@ -> ((Double,Double),Double) -> IO () drawCurvebitGen pmode canvas geometry wdth (r,g,b,a) pnum pdraw ((x0,y0),z0) ((x,y),z) = do -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif -#ifdef GTK3 Gtk.renderWithDrawWindow win $ do -#else - Gtk.renderWithDrawable win $ do -#endif cairoXform4PageCoordinate (mkXform4Page geometry pnum) Cairo.setSourceRGBA r g b a case pmode of @@ -263,16 +242,12 @@ drawFuncGen :: em -> (RenderCache -> CanvasId -> (PageNum,Page em) -> Maybe BBox -> DrawFlag -> Cairo.Render (Page em)) - -> DrawingFunction SinglePage em + -> DrawingFunction 'SinglePage em drawFuncGen _typ render = SinglePageDraw func where func cache cid isCurrentCvs (canvas,msfc) (pnum,page) vinfo mbbox flag = do let arr = view pageArrangement vinfo geometry <- makeCanvasGeometry pnum arr canvas -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif let ibboxnew = getViewableBBox geometry mbbox let mbboxnew = toMaybe ibboxnew xformfunc = cairoXform4PageCoordinate (mkXform4Page geometry pnum) @@ -293,19 +268,21 @@ -> DrawFlag -> Cairo.Render ()) -> (RenderCache -> CanvasId -> (PageNum,Page SelectMode) -> Maybe BBox -> DrawFlag -> Cairo.Render ()) - -> DrawingFunction SinglePage SelectMode + -> DrawingFunction 'SinglePage SelectMode drawFuncSelGen rencont rensel = drawFuncGen SelectMode (\c i x y f -> rencont c i x y f >> rensel c i x y f >> return (snd x)) -- | emphasisCanvasRender :: PenColor -> CanvasGeometry -> Cairo.Render () emphasisCanvasRender pcolor geometry = do - Cairo.identityMatrix - let CanvasDimension (Dim cw ch) = canvasDim geometry - let (r,g,b,a) = convertPenColorToRGBA pcolor - Cairo.setSourceRGBA r g b a - Cairo.setLineWidth 2 - Cairo.rectangle 0 0 cw ch - Cairo.stroke + Cairo.save + Cairo.identityMatrix + let CanvasDimension (Dim cw ch) = canvasDim geometry + let (r,g,b,a) = convertPenColorToRGBA pcolor + Cairo.setSourceRGBA r g b a + Cairo.setLineWidth 2 + Cairo.rectangle 0 0 cw ch + Cairo.stroke + Cairo.restore -- | highlight current page emphasisPageRender :: CanvasGeometry -> (PageNum,Page EditMode) -> Cairo.Render () @@ -331,14 +308,12 @@ Cairo.fill Cairo.restore - - -- | drawContPageGen :: (RenderCache -> CanvasId -> (PageNum,Page EditMode) -> Maybe BBox -> DrawFlag -> Cairo.Render (Int,Page EditMode)) - -> DrawingFunction ContinuousPage EditMode + -> DrawingFunction 'ContinuousPage EditMode drawContPageGen render = ContPageDraw func - where func :: RenderCache -> Bool -> CanvasInfo ContinuousPage + where func :: RenderCache -> Bool -> CanvasInfo 'ContinuousPage -> Maybe BBox -> Hoodle EditMode -> DrawFlag -> IO (Hoodle EditMode) func cache isCurrentCvs cinfo mbbox hdl flag = do let cid = view canvasId cinfo @@ -353,11 +328,7 @@ $ (getPagesInViewPortRange geometry hdl) where f k = maybe Nothing (\a->Just (k,a)) . M.lookup (unPageNum k) $ pgs -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif let ibboxnew = getViewableBBox geometry mbbox let mbboxnew = toMaybe ibboxnew xformfunc = cairoXform4PageCoordinate (mkXform4Page geometry pnum) @@ -388,9 +359,9 @@ -> DrawFlag -> Cairo.Render (Int,Page EditMode)) -> (RenderCache -> CanvasId -> (PageNum, Page SelectMode) -> Maybe BBox -> DrawFlag -> Cairo.Render (Int,Page SelectMode)) - -> DrawingFunction ContinuousPage SelectMode + -> DrawingFunction 'ContinuousPage SelectMode drawContPageSelGen rendergen rendersel = ContPageDraw func - where func :: RenderCache -> Bool -> CanvasInfo ContinuousPage + where func :: RenderCache -> Bool -> CanvasInfo 'ContinuousPage -> Maybe BBox -> Hoodle SelectMode ->DrawFlag -> IO (Hoodle SelectMode) func cache isCurrentCvs cinfo mbbox thdl flag = do let cid = view canvasId cinfo @@ -407,11 +378,7 @@ $ (getPagesInViewPortRange geometry hdl) where f k = maybe Nothing (\a->Just (k,a)) . M.lookup (unPageNum k) $ pgs -#ifdef GTK3 Just win <- Gtk.widgetGetWindow canvas -#else - win <- Gtk.widgetGetDrawWindow canvas -#endif let ibboxnew = getViewableBBox geometry mbbox mbboxnew = toMaybe ibboxnew onepagerender (pn,pg) = do @@ -450,7 +417,7 @@ -- | -drawSinglePage :: CanvasGeometry -> DrawingFunction SinglePage EditMode +drawSinglePage :: CanvasGeometry -> DrawingFunction 'SinglePage EditMode drawSinglePage geometry = drawFuncGen EditMode f where f cache cid (pnum,page) mbbox flag = do @@ -464,7 +431,7 @@ return pg' -- | -drawSinglePageSel :: CanvasGeometry -> DrawingFunction SinglePage SelectMode +drawSinglePageSel :: CanvasGeometry -> DrawingFunction 'SinglePage SelectMode drawSinglePageSel geometry = drawFuncSelGen rendercontent renderselect where rendercontent cache cid (pnum,tpg) mbbox flag = do let pg' = hPage2RPage tpg @@ -479,7 +446,7 @@ return () -- | -drawContHoodle :: CanvasGeometry -> DrawingFunction ContinuousPage EditMode +drawContHoodle :: CanvasGeometry -> DrawingFunction 'ContinuousPage EditMode drawContHoodle geometry = drawContPageGen f where f cache cid (pnum@(PageNum n),page) mbbox flag = do @@ -495,7 +462,7 @@ -- | drawContHoodleSel :: CanvasGeometry - -> DrawingFunction ContinuousPage SelectMode + -> DrawingFunction 'ContinuousPage SelectMode drawContHoodleSel geometry = drawContPageSelGen renderother renderselect where renderother cache cid (pnum@(PageNum n),page) mbbox flag = do let xform = mkXform4Page geometry pnum diff --git a/template/index.html.st b/template/index.html.st deleted file mode 100644 --- a/template/index.html.st +++ /dev/null @@ -1,8 +0,0 @@ - - - XOJ file - - - $body$ - -