hoodle-core 0.15.0 → 0.16
raw patch · 33 files changed
+451/−600 lines, 33 filesdep −gtkdep −old-localedep ~gtk3dep ~hoodle-builderdep ~hoodle-parser
Dependencies removed: gtk, old-locale
Dependency ranges changed: gtk3, hoodle-builder, hoodle-parser, hoodle-render, hoodle-types
Files
- Config.hs +14/−12
- csrc/c_initdevice.c +154/−128
- hoodle-core.cabal +19/−28
- resource/hoodle.css +3/−0
- src/Hoodle/Coroutine/ContextMenu.hs +1/−0
- src/Hoodle/Coroutine/Default.hs +39/−38
- src/Hoodle/Coroutine/Default/Menu.hs +14/−19
- src/Hoodle/Coroutine/Dialog.hs +0/−15
- src/Hoodle/Coroutine/Draw.hs +18/−34
- src/Hoodle/Coroutine/File.hs +2/−17
- src/Hoodle/Coroutine/HandwritingRecognition.hs +2/−6
- src/Hoodle/Coroutine/HubInternal.hs +5/−4
- src/Hoodle/Coroutine/Link.hs +0/−4
- src/Hoodle/Coroutine/Minibuffer.hs +5/−25
- src/Hoodle/Coroutine/Scroll.hs +5/−8
- src/Hoodle/Coroutine/TextInput.hs +1/−10
- src/Hoodle/Coroutine/VerticalSpace.hs +0/−8
- src/Hoodle/Coroutine/Window.hs +0/−6
- src/Hoodle/Device.hsc +9/−27
- src/Hoodle/GUI.hs +11/−9
- src/Hoodle/GUI/Menu.hs +29/−15
- src/Hoodle/GUI/Reflect.hs +1/−9
- src/Hoodle/ModelAction/Layer.hs +0/−5
- src/Hoodle/ModelAction/Page.hs +5/−5
- src/Hoodle/ModelAction/Text.hs +1/−1
- src/Hoodle/ModelAction/Window.hs +22/−36
- src/Hoodle/Type/Canvas.hs +10/−4
- src/Hoodle/Type/PageArrangement.hs +7/−10
- src/Hoodle/Type/Undo.hs +5/−2
- src/Hoodle/Util.hs +1/−2
- src/Hoodle/View/Coordinate.hs +0/−4
- src/Hoodle/View/Draw.hs +68/−101
- template/index.html.st +0/−8
Config.hs view
@@ -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
csrc/c_initdevice.c view
@@ -1,145 +1,146 @@+#include <gdk/gdk.h> #include <gtk/gtk.h> #include <stdio.h> #include <string.h> -#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
hoodle-core.cabal view
@@ -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
+ resource/hoodle.css view
@@ -0,0 +1,3 @@+GtkToolbar GtkButton { + padding: 5px;+}
src/Hoodle/Coroutine/ContextMenu.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}
src/Hoodle/Coroutine/Default.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Coroutine/Default/Menu.hs view
@@ -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 <ianwookim@gmail.com>@@ -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+
src/Hoodle/Coroutine/Dialog.hs view
@@ -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
src/Hoodle/Coroutine/Draw.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Coroutine/File.hs view
@@ -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 ()
src/Hoodle/Coroutine/HandwritingRecognition.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Coroutine/HubInternal.hs view
@@ -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)
src/Hoodle/Coroutine/Link.hs view
@@ -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
src/Hoodle/Coroutine/Minibuffer.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Coroutine/Scroll.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Coroutine/TextInput.hs view
@@ -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
src/Hoodle/Coroutine/VerticalSpace.hs view
@@ -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
src/Hoodle/Coroutine/Window.hs view
@@ -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
src/Hoodle/Device.hsc view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/GUI.hs view
@@ -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 <ianwookim@gmail.com>@@ -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))
src/Hoodle/GUI/Menu.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/GUI/Reflect.hs view
@@ -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 <-
src/Hoodle/ModelAction/Layer.hs view
@@ -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
src/Hoodle/ModelAction/Page.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/ModelAction/Text.hs view
@@ -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
src/Hoodle/ModelAction/Window.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Type/Canvas.hs view
@@ -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 }) -- |
src/Hoodle/Type/PageArrangement.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
src/Hoodle/Type/Undo.hs view
@@ -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
src/Hoodle/Util.hs view
@@ -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 <ianwookim@gmail.com>@@ -28,7 +28,6 @@ import System.Environment import System.FilePath import System.IO-import System.Locale -- import Data.Hoodle.Simple --
src/Hoodle/View/Coordinate.hs view
@@ -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)
src/Hoodle/View/Draw.hs view
@@ -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 <ianwookim@gmail.com>@@ -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
− template/index.html.st
@@ -1,8 +0,0 @@-<html>- <head>- <title> XOJ file </title>- </head>- <body>- $body$- </body>-</html>