{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} ----------------------------------------------------------------------------- -- | -- Module : Hoodle.GUI.Menu -- Copyright : (c) 2011-2016 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim -- Stability : experimental -- Portability : GHC -- -- Construct hoodle menus -- ----------------------------------------------------------------------------- module Hoodle.GUI.Menu where -- from other packages 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 -- from this package import Hoodle.Coroutine.Callback import Hoodle.Type -- 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") , ("eraser.png" , "myeraser") , ("highlighter.png", "myhighlighter") , ("text-tool.png" , "mytext") , ("latex-tool.png" , "mylatex") , ("shapes.png" , "myshapes") , ("ruler.png" , "myruler") , ("lasso.png" , "mylasso") , ("rect-select.png", "myrectselect") , ("stretch.png" , "mystretch") , ("hand.png" , "myhand") , ("recycled.png" , "mydefault") , ("default-pen.png", "mydefaultpen") , ("thin.png" , "mythin") , ("medium.png" , "mymedium") , ("thick.png" , "mythick") , ("black.png" , "myblack") , ("blue.png" , "myblue") , ("red.png" , "myred") , ("green.png" , "mygreen") , ("gray.png" , "mygray") , ("lightblue.png" , "mylightblue") , ("lightgreen.png" , "mylightgreen") , ("magenta.png" , "mymagenta") , ("orange.png" , "myorange") , ("yellow.png" , "myyellow") , ("white.png" , "mywhite") ] -- | viewmods :: [Gtk.RadioActionEntry] viewmods = [ Gtk.RadioActionEntry "CONTA" "Continuous" Nothing Nothing Nothing 0 , Gtk.RadioActionEntry "ONEPAGEA" "One Page" Nothing Nothing Nothing 1 ] -- | pointmods :: [Gtk.RadioActionEntry] pointmods = [ Gtk.RadioActionEntry "PENVERYFINEA" "Very fine" Nothing Nothing Nothing 0 , Gtk.RadioActionEntry "PENFINEA" "Fine" (Just "mythin") Nothing Nothing 1 , Gtk.RadioActionEntry "PENTHICKA" "Thick" (Just "mythick") Nothing Nothing 3 , Gtk.RadioActionEntry "PENVERYTHICKA" "Very Thick" Nothing Nothing Nothing 4 , Gtk.RadioActionEntry "PENULTRATHICKA" "Ultra Thick" Nothing Nothing Nothing 5 , Gtk.RadioActionEntry "PENMEDIUMA" "Medium" (Just "mymedium") Nothing Nothing 2 -- , Gtk.RadioActionEntry "NOWIDTH" "Unknown" Nothing Nothing Nothing 999 ] -- | penmods :: [Gtk.RadioActionEntry] penmods = [ Gtk.RadioActionEntry "PENA" "Pen" (Just "mypen") Nothing Nothing 0 , Gtk.RadioActionEntry "ERASERA" "Eraser" (Just "myeraser") Nothing Nothing 1 , Gtk.RadioActionEntry "HIGHLTA" "Highlighter" (Just "myhighlighter") Nothing Nothing 2 -- , Gtk.RadioActionEntry "TEXTA" "Text" (Just "mytext") Nothing Nothing 3 , Gtk.RadioActionEntry "SELREGNA" "Select Region" (Just "mylasso") Nothing Nothing 4 , Gtk.RadioActionEntry "SELRECTA" "Select Rectangle" (Just "myrectselect") Nothing Nothing 5 , Gtk.RadioActionEntry "VERTSPA" "Vertical Space" (Just "mystretch") Nothing Nothing 6 ] -- , Gtk.RadioActionEntry "HANDA" "Hand Tool" (Just "myhand") Nothing Nothing 7 -- | colormods :: [Gtk.RadioActionEntry] colormods = [ Gtk.RadioActionEntry "BLUEA" "Blue" (Just "myblue") Nothing Nothing 1 , Gtk.RadioActionEntry "REDA" "Red" (Just "myred") Nothing Nothing 2 , Gtk.RadioActionEntry "GREENA" "Green" (Just "mygreen") Nothing Nothing 3 , Gtk.RadioActionEntry "GRAYA" "Gray" (Just "mygray") Nothing Nothing 4 , Gtk.RadioActionEntry "LIGHTBLUEA" "Lightblue" (Just "mylightblue") Nothing Nothing 5 , Gtk.RadioActionEntry "LIGHTGREENA" "Lightgreen" (Just "mylightgreen") Nothing Nothing 6 , Gtk.RadioActionEntry "MAGENTAA" "Magenta" (Just "mymagenta") Nothing Nothing 7 , Gtk.RadioActionEntry "ORANGEA" "Orange" (Just "myorange") Nothing Nothing 8 , Gtk.RadioActionEntry "YELLOWA" "Yellow" (Just "myyellow") Nothing Nothing 9 , Gtk.RadioActionEntry "WHITEA" "White" (Just "mywhite") Nothing Nothing 10 , Gtk.RadioActionEntry "BLACKA" "Black" (Just "myblack") Nothing Nothing 0 --- , Gtk.RadioActionEntry "NOCOLOR" "Unknown" Nothing Nothing Nothing 999 ] -- | bkgstyles :: [Gtk.RadioActionEntry] bkgstyles = [ Gtk.RadioActionEntry "BKGGRAPHA" "Graph" Nothing Nothing Nothing 3 , Gtk.RadioActionEntry "BKGPLAINA" "Plain" Nothing Nothing Nothing 0 , Gtk.RadioActionEntry "BKGLINEDA" "Lined" Nothing Nothing Nothing 1 , Gtk.RadioActionEntry "BKGRULEDA" "Ruled" Nothing Nothing Nothing 2 ] newpagemods :: [Gtk.RadioActionEntry] newpagemods = [ Gtk.RadioActionEntry "NEWPAGEPLAINA" "Plain page" Nothing Nothing Nothing 0 , Gtk.RadioActionEntry "NEWPAGELASTA" "Last page" Nothing Nothing Nothing 1 , Gtk.RadioActionEntry "NEWPAGECYCLEA" "Cycle page" Nothing Nothing Nothing 2 ] -- | iconResourceAdd :: Gtk.IconFactory -> FilePath -> (FilePath, Gtk.StockId) -> IO () iconResourceAdd iconfac resdir (fp,stid) = do myIconSource <- Gtk.iconSourceNew Gtk.iconSourceSetFilename myIconSource (resdir fp) -- Gtk.iconSourceSetSize myIconSource Gtk.IconSizeLargeToolbar Gtk.iconSourceSetSize myIconSource Gtk.IconSizeSmallToolbar myIconSourceSmall <- Gtk.iconSourceNew Gtk.iconSourceSetFilename myIconSourceSmall (resdir fp) Gtk.iconSourceSetSize myIconSource Gtk.IconSizeMenu myIconSet <- Gtk.iconSetNew Gtk.iconSetAddSource myIconSet myIconSource Gtk.iconSetAddSource myIconSet myIconSourceSmall Gtk.iconFactoryAdd iconfac stid myIconSet -- | actionNewAndRegisterRef :: EventVar -> String -> String -> Maybe String -> Maybe Gtk.StockId -> Maybe UserEvent -> IO Gtk.Action actionNewAndRegisterRef evar name label tooltip stockId myevent = do a <- Gtk.actionNew name label tooltip stockId case myevent of Nothing -> return a Just ev -> do a `Gtk.on` Gtk.actionActivated $ do eventHandler evar (UsrEv ev) return a -- | getMenuUI :: EventVar -> IO (Gtk.UIManager,UIComponentSignalHandler) getMenuUI evar = do let actionNewAndRegister = actionNewAndRegisterRef evar -- icons 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 vma <- actionNewAndRegister "VMA" "View" Nothing Nothing Nothing lma <- actionNewAndRegister "LMA" "Layer" Nothing Nothing Nothing ima <- actionNewAndRegister "IMA" "Embed" Nothing Nothing Nothing pma <- actionNewAndRegister "PMA" "Page" Nothing Nothing Nothing tma <- actionNewAndRegister "TMA" "Tool" Nothing Nothing Nothing verma <- actionNewAndRegister "VERMA" "Version" Nothing Nothing Nothing oma <- actionNewAndRegister "OMA" "Option" Nothing Nothing Nothing wma <- actionNewAndRegister "WMA" "Window" Nothing Nothing Nothing hma <- actionNewAndRegister "HMA" "Help" Nothing Nothing Nothing --------------- -- file menu -- --------------- newa <- actionNewAndRegister "NEWA" "New" (Just "Just a Stub") (Just Gtk.stockNew) (justMenu MenuNew) opena <- actionNewAndRegister "OPENA" "Open" (Just "Just a Stub") (Just Gtk.stockOpen) (justMenu MenuOpen) savea <- actionNewAndRegister "SAVEA" "Save" (Just "Just a Stub") (Just Gtk.stockSave) (justMenu MenuSave) saveasa <- actionNewAndRegister "SAVEASA" "Save As" (Just "Just a Stub") (Just Gtk.stockSaveAs) (justMenu MenuSaveAs) printa <- actionNewAndRegister "PRINTA" "Print" (Just "Just a Stub") Nothing (justMenu MenuPrint) -- exporta <- actionNewAndRegister "EXPORTA" "Export to PDF" (Just "Just a Stub") Nothing (justMenu MenuExport) expsvga <- actionNewAndRegister "EXPSVGA" "Export Current Page to SVG" (Just "Just a Stub") Nothing (justMenu MenuExportPageSVG) -- annpdfa <- actionNewAndRegister "ANNPDFA" "Annotate PDF" (Just "Just a Stub") Nothing (justMenu MenuAnnotatePDF) -- reloada <- actionNewAndRegister "RELOADA" "Reload File" (Just "Just a Stub") Nothing (justMenu MenuReload) recenta <- actionNewAndRegister "RECENTA" "Recent Document" (Just "Just a Stub") Nothing (justMenu MenuRecentDocument) -- quita <- actionNewAndRegister "QUITA" "Quit" (Just "Just a Stub") (Just Gtk.stockQuit) (justMenu MenuQuit) --------------- -- edit menu -- --------------- undoa <- actionNewAndRegister "UNDOA" "Undo" (Just "Just a Stub") (Just Gtk.stockUndo) (justMenu MenuUndo) redoa <- actionNewAndRegister "REDOA" "Redo" (Just "Just a Stub") (Just Gtk.stockRedo) (justMenu MenuRedo) cuta <- actionNewAndRegister "CUTA" "Cut" (Just "Just a Stub") (Just Gtk.stockCut) (justMenu MenuCut) copya <- actionNewAndRegister "COPYA" "Copy" (Just "Just a Stub") (Just Gtk.stockCopy) (justMenu MenuCopy) pastea <- actionNewAndRegister "PASTEA" "Paste" (Just "Just a Stub") (Just Gtk.stockPaste) (justMenu MenuPaste) deletea <- actionNewAndRegister "DELETEA" "Delete" (Just "Just a Stub") (Just Gtk.stockDelete) (justMenu MenuDelete) --------------- -- view menu -- --------------- togpanzooma <- actionNewAndRegister "TOGPANZOOMA" "Show/Hide Zoom Widget" (Just "Just a stub") Nothing (justMenu MenuTogglePanZoomWidget) togscra <- actionNewAndRegister "TOGSCRA" "Show/Hide Scroll Widget" (Just "Just a stub") Nothing (justMenu MenuToggleScrollWidget) -- zooma <- actionNewAndRegister "ZOOMA" "Zoom" (Just "Just a Stub") Nothing Nothing -- (justMenu MenuZoom) zmina <- actionNewAndRegister "ZMINA" "Zoom In" (Just "Zoom In") (Just Gtk.stockZoomIn) (justMenu MenuZoomIn) zmouta <- actionNewAndRegister "ZMOUTA" "Zoom Out" (Just "Zoom Out") (Just Gtk.stockZoomOut) (justMenu MenuZoomOut) nrmsizea <- actionNewAndRegister "NRMSIZEA" "Normal Size" (Just "Normal Size") (Just Gtk.stockZoom100) (justMenu MenuNormalSize) pgwdtha <- actionNewAndRegister "PGWDTHA" "Page Width" (Just "Page Width") (Just Gtk.stockZoomFit) (justMenu MenuPageWidth) pgheighta <- actionNewAndRegister "PGHEIGHTA" "Page Height" (Just "Page Height") Nothing (justMenu MenuPageHeight) setzma <- actionNewAndRegister "SETZMA" "Set Zoom" (Just "Set Zoom") (Just Gtk.stockFind) (justMenu MenuSetZoom) -- fscra <- actionNewAndRegister "FSCRA" "Full Screen" (Just "Just a Stub") (Just "myfullscreen") (justMenu MenuFullScreen) -- fstpagea <- actionNewAndRegister "FSTPAGEA" "First Page" (Just "Just a Stub") (Just Gtk.stockGotoFirst) (justMenu MenuFirstPage) prvpagea <- actionNewAndRegister "PRVPAGEA" "Previous Page" (Just "Just a Stub") (Just Gtk.stockGoBack) (justMenu MenuPreviousPage) nxtpagea <- actionNewAndRegister "NXTPAGEA" "Next Page" (Just "Just a Stub") (Just Gtk.stockGoForward) (justMenu MenuNextPage) lstpagea <- actionNewAndRegister "LSTPAGEA" "Last Page" (Just "Just a Stub") (Just Gtk.stockGotoLast) (justMenu MenuLastPage) -- hsplita <- actionNewAndRegister "HSPLITA" "Clone View Horizontally" (Just "horizontal split") Nothing (justMenu MenuHSplit) vsplita <- actionNewAndRegister "VSPLITA" "Clone View Vertically" (Just "vertical split") Nothing (justMenu MenuVSplit) delcvsa <- actionNewAndRegister "DELCVSA" "Remove Clone View" (Just "delete current canvas") Nothing (justMenu MenuDelCanvas) ---------------- -- layer menu -- ---------------- toglayera <- actionNewAndRegister "TOGLAYERA" "Show/Hide Layer Widget" (Just "Just a stub") Nothing (justMenu MenuToggleLayerWidget) -- newlyra <- actionNewAndRegister "NEWLYRA" "New Layer" (Just "Just a Stub") Nothing (justMenu MenuNewLayer) nextlayera <- actionNewAndRegister "NEXTLAYERA" "Next Layer" (Just "Just a Stub") Nothing (justMenu MenuNextLayer) prevlayera <- actionNewAndRegister "PREVLAYERA" "Prev Layer" (Just "Just a Stub") Nothing (justMenu MenuPrevLayer) gotolayera <- actionNewAndRegister "GOTOLAYERA" "Goto Layer" (Just "Just a Stub") Nothing (justMenu MenuGotoLayer) dellyra <- actionNewAndRegister "DELLYRA" "Delete Layer" (Just "Just a Stub") Nothing (justMenu MenuDeleteLayer) ---------------- -- embed menu -- ---------------- ldpnga <- actionNewAndRegister "LDIMGA" "Load PNG or JPG Image" (Just "Just a Stub") Nothing (justMenu MenuLoadPNGorJPG) ldsvga <- actionNewAndRegister "LDSVGA" "Load SVG Image" (Just "Just a Stub") Nothing (justMenu MenuLoadSVG) ldimgbkga <- actionNewAndRegister "LDIMGBKGA" "Make Title Page from Image" (Just "Just a Stub") Nothing (justMenu MenuLoadImageBackground) ldpreimga <- actionNewAndRegister "LDPREIMGA" "Embed Predefined Image File" (Just "Just a Stub") Nothing (justMenu MenuEmbedPredefinedImage) ldpreimg2a <- actionNewAndRegister "LDPREIMG2A" "Embed Predefined Image File 2" (Just "Just a Stub") Nothing (justMenu MenuEmbedPredefinedImage2) ldpreimg3a <- actionNewAndRegister "LDPREIMG3A" "Embed Predefined Image File 3" (Just "Just a Stub") Nothing (justMenu MenuEmbedPredefinedImage3) texta <- actionNewAndRegister "TEXTA" "Text" (Just "Text") (Just "mytext") (justMenu MenuText) textsrca <- actionNewAndRegister "TEXTSRCA" "Embed Text Source" (Just "Just a Stub") Nothing (justMenu MenuEmbedTextSource) editsrca <- actionNewAndRegister "EDITSRCA" "Edit text source" (Just "Just a Stub") Nothing (justMenu MenuEditEmbedTextSource) #ifdef HUB editnetsrca <- actionNewAndRegister "EDITNETSRCA" "Network edit text source" (Just "Just a Stub") Nothing (justMenu MenuEditNetEmbedTextSource) #else editnetsrca <- actionNewAndRegister "EDITNETSRCA" "Network edit text source" (Just "Just a Stub") Nothing (justMenu MenuDefault) #endif textfromsrca <- actionNewAndRegister "TEXTFROMSRCA" "Text From Source" (Just "Just a Stub") Nothing (justMenu MenuTextFromSource) togglenetsrca <- Gtk.toggleActionNew ("TOGGLENETSRCA" :: String) "Toggle network edit text source" (Just "Just a Stub") Nothing #ifdef HUB togglenetsrca `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuToggleNetworkEditSource)) #else togglenetsrca `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuDefault)) #endif latexa <- actionNewAndRegister "LATEXA" "LaTeX" (Just "Just a Stub") (Just "mylatex") (justMenu MenuLaTeX) #ifdef HUB latexneta <- actionNewAndRegister "LATEXNETA" "LaTeX Network" (Just "Just a Stub") (Just "mylatex") (justMenu MenuLaTeXNetwork) #else latexneta <- actionNewAndRegister "LATEXNETA" "LaTeX Network" (Just "Just a Stub") (Just "mylatex") (justMenu MenuDefault) #endif combinelatexa <- actionNewAndRegister "COMBINELATEXA" "Combine LaTeX texts to ..." (Just "Just a Stub") Nothing (justMenu MenuCombineLaTeX) latexfromsrca <- actionNewAndRegister "LATEXFROMSRCA" "LaTeX From Source" (Just "Just a Stub") Nothing (justMenu MenuLaTeXFromSource) updatelatexa <- actionNewAndRegister "UPDATELATEXA" "Update LaTeX" (Just "Just a Stub") Nothing (justMenu MenuUpdateLaTeX) --------------- -- page menu -- --------------- newpgba <- actionNewAndRegister "NEWPGBA" "New Page Before" (Just "Just a Stub") Nothing (justMenu MenuNewPageBefore) newpgaa <- actionNewAndRegister "NEWPGAA" "New Page After" (Just "Just a Stub") Nothing (justMenu MenuNewPageAfter) newpgea <- actionNewAndRegister "NEWPGEA" "New Page At End" (Just "Just a Stub") Nothing (justMenu MenuNewPageAtEnd) delpga <- actionNewAndRegister "DELPGA" "Delete Page" (Just "Just a Stub") Nothing (justMenu MenuDeletePage) ppsizea <- actionNewAndRegister "PPSIZEA" "Paper Size" (Just "Just a Stub") Nothing (justMenu MenuPaperSize) ppclra <- actionNewAndRegister "PPCLRA" "Paper Color" (Just "Just a Stub") Nothing (justMenu MenuPaperColor) ppstya <- actionNewAndRegister "PPSTYA" "Paper Style" Nothing Nothing Nothing apallpga<- actionNewAndRegister "APALLPGA" "Apply To All Pages" (Just "Just a Stub") Nothing (justMenu MenuApplyToAllPages) embedbkgpdfa <- actionNewAndRegister "EMBEDBKGPDFA" "Embed All PDF backgroound" (Just "Just a Stub") Nothing (justMenu MenuEmbedAllPDFBkg) defppa <- actionNewAndRegister "DEFPPA" "Default Paper" (Just "Just a Stub") Nothing (justMenu MenuDefaultPaper) setdefppa <- actionNewAndRegister "SETDEFPPA" "Set As Default" (Just "Just a Stub") Nothing (justMenu MenuSetAsDefaultPaper) -- tools menu linka <- actionNewAndRegister "LINKA" "Add Link" (Just "Add Link") (Just Gtk.stockIndex) (justMenu MenuAddLink) anchora <- actionNewAndRegister "ANCHORA" "Add Anchor" (Just "Add Anchor") Nothing (justMenu MenuAddAnchor) listanchora <- actionNewAndRegister "LISTANCHORA" "List Anchors" (Just "List Anchors") Nothing (justMenu MenuListAnchors) handreca <- actionNewAndRegister "HANDRECA" "Hoodlet load via Handwriting Recognition" (Just "Just a Stub") (Just "myshapes") (justMenu MenuHandwritingRecognitionDialog) clra <- actionNewAndRegister "CLRA" "Color" (Just "Just a Stub") Nothing Nothing clrpcka <- actionNewAndRegister "CLRPCKA" "Color Picker.." (Just "Just a Stub") (Just Gtk.stockSelectColor) (justMenu MenuColorPicker ) penopta <- actionNewAndRegister "PENOPTA" "Pen Options" (Just "Just a Stub") Nothing (justMenu MenuPenOptions) erasropta <- actionNewAndRegister "ERASROPTA" "Eraser Options" (Just "Just a Stub") Nothing (justMenu MenuEraserOptions) hiltropta <- actionNewAndRegister "HILTROPTA" "Highlighter Options" (Just "Just a Stub") Nothing (justMenu MenuHighlighterOptions) txtfnta <- actionNewAndRegister "TXTFNTA" "Text Font" (Just "Just a Stub") Nothing (justMenu MenuTextFont) defpena <- actionNewAndRegister "DEFPENA" "Default Pen" (Just "Just a Stub") (Just "mydefaultpen") (justMenu MenuDefaultPen) defersra <- actionNewAndRegister "DEFERSRA" "Default Eraser" (Just "Just a Stub") Nothing (justMenu MenuDefaultEraser) defhiltra <- actionNewAndRegister "DEFHILTRA" "Default Highlighter" (Just "Just a Stub") Nothing (justMenu MenuDefaultHighlighter) deftxta <- actionNewAndRegister "DEFTXTA" "Default Text" (Just "Just a Stub") Nothing (justMenu MenuDefaultText) setdefopta <- actionNewAndRegister "SETDEFOPTA" "Set As Default" (Just "Just a Stub") Nothing (justMenu MenuSetAsDefaultOption) ------------------ -- version menu -- ------------------ synca <- actionNewAndRegister "SYNCA" "Start Sync" (Just "Just a Stub") Nothing (justMenu MenuStartSync) versiona <- actionNewAndRegister "VERSIONA" "Save Version" (Just "Just a Stub") Nothing (justMenu MenuVersionSave) showreva <- actionNewAndRegister "SHOWREVA" "Show Revisions" (Just "Just a Stub") Nothing (justMenu MenuShowRevisions) showida <- actionNewAndRegister "SHOWIDA" "Show UUID" (Just "Just a Stub") Nothing (justMenu MenuShowUUID) ----------------- -- option menu -- ----------------- uxinputa <- Gtk.toggleActionNew ("UXINPUTA" :: String) "Use XInput" (Just "Just a Stub") Nothing uxinputa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUseXInput)) handa <- Gtk.toggleActionNew ("HANDA" :: String) "Use Touch" (Just "Toggle touch") (Just "myhand") handa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUseTouch)) popmenua <- Gtk.toggleActionNew ("POPMENUA" :: String) "Use Popup Menu" (Just "Just a stub") Nothing popmenua `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUsePopUpMenu)) ebdimga <- Gtk.toggleActionNew ("EBDIMGA" :: String) "Embed PNG/JPG Image" (Just "Just a stub") Nothing ebdimga `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuEmbedImage)) ebdpdfa <- Gtk.toggleActionNew ("EBDPDFA" :: String) "Embed PDF" (Just "Just a stub") Nothing ebdpdfa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuEmbedPDF)) flwlnka <- Gtk.toggleActionNew ("FLWLNKA" :: String) "Follow Links" (Just "Just a stub") Nothing flwlnka `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuFollowLinks)) keepratioa <- Gtk.toggleActionNew ("KEEPRATIOA" :: String) "Keep Aspect Ratio" (Just "Just a stub") Nothing keepratioa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuKeepAspectRatio)) vcursora <- Gtk.toggleActionNew ("VCURSORA" :: String) "Use Variable Cursor" (Just "Just a stub") Nothing vcursora `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuUseVariableCursor)) -- temporary implementation (later will be as submenus with toggle action. appropriate reflection) togclocka <- actionNewAndRegister "TOGCLOCKA" "Toggle Clock Widget" (Just "Just a stub") Nothing (justMenu MenuToggleClockWidget) pressrsensa <- Gtk.toggleActionNew ("PRESSRSENSA" :: String) "Pressure Sensitivity" (Just "Just a Stub") Nothing pressrsensa `Gtk.on` Gtk.actionToggled $ do eventHandler evar (UsrEv (Menu MenuPressureSensitivity)) newpagemoda <- actionNewAndRegister "NEWPAGEMODEA" "New page mode" Nothing Nothing Nothing #ifdef DYRE relauncha <- actionNewAndRegister "RELAUNCHA" "Relaunch Application" (Just "Just a Stub") Nothing (justMenu MenuRelaunch) #else relauncha <- actionNewAndRegister "RELAUNCHA" "Relaunch Application" (Just "Just a Stub") Nothing (justMenu MenuDefault) #endif #ifdef HUB huba <- actionNewAndRegister "HUBA" "Hub" (Just "Just a Stub") Nothing (justMenu MenuHub) #else huba <- actionNewAndRegister "HUBA" "Hub" (Just "Just a Stub") Nothing (justMenu MenuDefault) #endif -- window menu addtaba <- actionNewAndRegister "ADDTABA" "Add new tab" (Just "Just a Stub") Nothing (justMenu MenuAddTab) -- nexttaba <- actionNewAndRegister "NEXTTABA" "Go to next tab" (Just "Just a Stub") Nothing (justMenu MenuNextTab) closetaba <- actionNewAndRegister "CLOSETABA" "Close current tab" (Just "Just a Stub") Nothing (justMenu MenuCloseTab) -- help menu abouta <- actionNewAndRegister "ABOUTA" "About" (Just "Just a Stub") Nothing (justMenu MenuAbout) -- others defaulta <- actionNewAndRegister "DEFAULTA" "Default" (Just "Default") (Just "mydefault") (justMenu MenuDefault) agr <- Gtk.actionGroupNew ("AGR" :: String) mapM_ (Gtk.actionGroupAddAction agr) [fma,ema,vma,lma,ima,pma,tma,verma,oma,wma,hma] mapM_ (Gtk.actionGroupAddAction agr) [ undoa, redoa, cuta, copya, pastea, deletea ] mapM_ (\act -> Gtk.actionGroupAddActionWithAccel agr act (Nothing :: Maybe String)) [ newa, annpdfa, opena, savea, saveasa , reloada, recenta, printa, exporta, synca, versiona, showreva, showida, quita , fscra, zooma, zmina, zmouta, nrmsizea, pgwdtha, pgheighta, setzma , fstpagea, prvpagea, nxtpagea, lstpagea , hsplita, vsplita, delcvsa , newpgba, newpgaa, newpgea, delpga, expsvga, newlyra, nextlayera, prevlayera, gotolayera, dellyra, ppsizea, ppclra , ppstya , apallpga, embedbkgpdfa, defppa, setdefppa , ldpnga, ldsvga, ldimgbkga, texta, textsrca, editsrca, editnetsrca, textfromsrca , latexa, latexneta, combinelatexa, latexfromsrca, updatelatexa , ldpreimga, ldpreimg2a, ldpreimg3a , linka, anchora, listanchora, handreca, clra, clrpcka, penopta , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta , togpanzooma, togscra, toglayera, togclocka, newpagemoda, relauncha , huba -- , hubsocketa , addtaba, {- nexttaba, -} closetaba , abouta , defaulta ] mapM_ (Gtk.actionGroupAddAction agr) [ togglenetsrca, uxinputa, handa, popmenua, ebdimga, ebdpdfa, flwlnka , keepratioa, pressrsensa, vcursora ] mpgmodconnid <- actionGroupAddRadioActionsAndGetConnID agr viewmods 0 (assignViewMode evar) _mpointconnid <- actionGroupAddRadioActionsAndGetConnID agr pointmods 0 (assignPoint evar) mpenmodconnid <- actionGroupAddRadioActionsAndGetConnID agr penmods 0 (assignPenMode evar) mcolorconnid <- actionGroupAddRadioActionsAndGetConnID agr colormods 0 (assignColor evar) _mbkgstyconnid <- actionGroupAddRadioActionsAndGetConnID agr bkgstyles 2 (assignBkgStyle evar) mnpgmodconnid <- actionGroupAddRadioActionsAndGetConnID agr newpagemods 0 (assignNewPageMode evar) let disabledActions = [ recenta, printa , cuta, copya, deletea , setzma , newpgea, ppsizea, ppclra , defppa, setdefppa , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta , setdefopta , abouta , defaulta #ifndef DYRE , relauncha #endif #ifndef HUB , editnetsrca , huba #endif ] enabledActions = [ opena, savea, saveasa, reloada, versiona, showreva, showida, quita , pastea, fstpagea, prvpagea, nxtpagea, lstpagea , clra, penopta, zooma, nrmsizea, pgwdtha, texta , newpagemoda ] -- mapM_ (\x->Gtk.actionSetSensitive x True) enabledActions mapM_ (\x->Gtk.actionSetSensitive x False) disabledActions -- -- -- radio actions -- ui <- Gtk.uiManagerNew uiDecl <- readFile (resDir "menu.xml") Gtk.uiManagerAddUiFromString ui uiDecl Gtk.uiManagerInsertActionGroup ui agr 0 Just ra2 <- Gtk.actionGroupGetAction agr ("PENFINEA" :: String) Gtk.set (Gtk.castToRadioAction ra2) [Gtk.radioActionCurrentValue Gtk.:= 2] Just ra3 <- Gtk.actionGroupGetAction agr ("SELREGNA" :: String) Gtk.actionSetSensitive ra3 True Just ra4 <- Gtk.actionGroupGetAction agr ("VERTSPA" :: String) Gtk.actionSetSensitive ra4 True Just ra6 <- Gtk.actionGroupGetAction agr ("CONTA" :: String) Gtk.actionSetSensitive ra6 True Just _ra7 <- Gtk.actionGroupGetAction agr ("PENA" :: String) Gtk.actionSetSensitive ra6 True Just toolbar1 <- Gtk.uiManagerGetWidget ui ("/ui/toolbar1" :: String) Gtk.toolbarSetStyle (Gtk.castToToolbar toolbar1) Gtk.ToolbarIcons toolbarSetIconSize (Gtk.castToToolbar toolbar1) Gtk.IconSizeSmallToolbar Just toolbar2 <- Gtk.uiManagerGetWidget ui ("/ui/toolbar2" :: String) Gtk.toolbarSetStyle (Gtk.castToToolbar toolbar2) Gtk.ToolbarIcons toolbarSetIconSize (Gtk.castToToolbar toolbar2) Gtk.IconSizeSmallToolbar let uicomponentsignalhandler = set penModeSignal mpenmodconnid . set pageModeSignal mpgmodconnid . set penColorSignal mcolorconnid . set newPageModeSignal mnpgmodconnid $ defaultUIComponentSignalHandler return (ui,uicomponentsignalhandler) -- | actionGroupAddRadioActionsAndGetConnID :: Gtk.ActionGroup -> [Gtk.RadioActionEntry] -> Int -> (Gtk.RadioAction -> IO ()) -> IO (Maybe (Gtk.ConnectId Gtk.RadioAction)) actionGroupAddRadioActionsAndGetConnID self entries _value onChange = do mgroup <- foldM (\mgroup (n,Gtk.RadioActionEntry name label stockId accelerator tooltip value) -> do action <- Gtk.radioActionNew name label tooltip stockId value F.forM_ mgroup $ \gr -> Gtk.radioActionSetGroup action gr when (n==value) (Gtk.toggleActionSetActive action True) Gtk.actionGroupAddActionWithAccel self action accelerator return (Just action)) Nothing (zip [0..] entries) case mgroup of Nothing -> return Nothing Just gr -> do connid <- (gr `Gtk.on` Gtk.radioActionChanged) onChange return (Just connid) -- | assignViewMode :: EventVar -> Gtk.RadioAction -> IO () assignViewMode evar a = viewModeToUserEvent a >>= eventHandler evar . UsrEv -- | assignPenMode :: EventVar -> Gtk.RadioAction -> IO () assignPenMode evar a = do v <- Gtk.radioActionGetCurrentValue a eventHandler evar (UsrEv (AssignPenMode (int2PenType v))) -- | assignColor :: EventVar -> Gtk.RadioAction -> IO () assignColor evar a = do v <- Gtk.radioActionGetCurrentValue a let c = int2Color v eventHandler evar (UsrEv (PenColorChanged c)) -- | assignPoint :: EventVar -> Gtk.RadioAction -> IO () assignPoint evar a = do v <- Gtk.radioActionGetCurrentValue a eventHandler evar (UsrEv (PenWidthChanged v)) -- | assignBkgStyle :: EventVar -> Gtk.RadioAction -> IO () assignBkgStyle evar a = do v <- Gtk.radioActionGetCurrentValue a let sty = int2BkgStyle v eventHandler evar (UsrEv (BackgroundStyleChanged sty)) -- | assignNewPageMode :: EventVar -> Gtk.RadioAction -> IO () assignNewPageMode evar a = do v <- Gtk.radioActionGetCurrentValue a eventHandler evar (UsrEv (AssignNewPageMode (int2NewPageMode v))) -- | int2PenType :: Int -> Either PenType SelectType int2PenType 0 = Left PenWork int2PenType 1 = Left EraserWork int2PenType 2 = Left HighlighterWork -- int2PenType 3 = Left TextWork int2PenType 4 = Right SelectLassoWork int2PenType 5 = Right SelectRectangleWork int2PenType 6 = Left VerticalSpaceWork -- int2PenType 7 = Right SelectHandToolWork int2PenType _ = error "No such pentype" -- | penType2Int :: Either PenType SelectType -> Int penType2Int (Left PenWork) = 0 penType2Int (Left EraserWork) = 1 penType2Int (Left HighlighterWork) = 2 penType2Int (Left VerticalSpaceWork) = 6 penType2Int (Right SelectLassoWork) = 4 penType2Int (Right SelectRectangleWork) = 5 penType2Int _ = 100 -- penType2Int (Right SelectHandToolWork) = 7 -- | int2Point :: PenType -> Int -> Double int2Point PenWork 0 = predefined_veryfine int2Point PenWork 1 = predefined_fine int2Point PenWork 2 = predefined_medium int2Point PenWork 3 = predefined_thick int2Point PenWork 4 = predefined_verythick int2Point PenWork 5 = predefined_ultrathick int2Point HighlighterWork 0 = predefined_highlighter_veryfine int2Point HighlighterWork 1 = predefined_highlighter_fine int2Point HighlighterWork 2 = predefined_highlighter_medium int2Point HighlighterWork 3 = predefined_highlighter_thick int2Point HighlighterWork 4 = predefined_highlighter_verythick int2Point HighlighterWork 5 = predefined_highlighter_ultrathick int2Point EraserWork 0 = predefined_eraser_veryfine int2Point EraserWork 1 = predefined_eraser_fine int2Point EraserWork 2 = predefined_eraser_medium int2Point EraserWork 3 = predefined_eraser_thick int2Point EraserWork 4 = predefined_eraser_verythick int2Point EraserWork 5 = predefined_eraser_ultrathick int2Point _ _ = error "No such point" similarTo :: Double -> Double -> Bool similarTo v w = (v < w + eps) && (v > w - eps) where eps = 1e-2 -- | point2Int :: PenType -> Double -> Int point2Int PenWork v | v `similarTo` predefined_veryfine = 0 | v `similarTo` predefined_fine = 1 | v `similarTo` predefined_medium = 2 | v `similarTo` predefined_thick = 3 | v `similarTo` predefined_verythick = 4 | v `similarTo` predefined_ultrathick = 5 point2Int HighlighterWork v | v `similarTo` predefined_highlighter_fine = 1 | v `similarTo` predefined_highlighter_veryfine = 0 | v `similarTo` predefined_highlighter_medium = 2 | v `similarTo` predefined_highlighter_thick = 3 | v `similarTo` predefined_highlighter_verythick = 4 | v `similarTo` predefined_highlighter_ultrathick = 5 point2Int EraserWork v | v `similarTo` predefined_eraser_veryfine = 0 | v `similarTo` predefined_eraser_fine = 1 | v `similarTo` predefined_eraser_medium = 2 | v `similarTo` predefined_eraser_thick = 3 | v `similarTo` predefined_eraser_verythick = 4 | v `similarTo` predefined_eraser_ultrathick = 5 point2Int _ _ = 0 -- for the time being -- | int2Color :: Int -> PenColor int2Color 0 = ColorBlack int2Color 1 = ColorBlue int2Color 2 = ColorRed int2Color 3 = ColorGreen int2Color 4 = ColorGray int2Color 5 = ColorLightBlue int2Color 6 = ColorLightGreen int2Color 7 = ColorMagenta int2Color 8 = ColorOrange int2Color 9 = ColorYellow int2Color 10 = ColorWhite int2Color _ = error "No such color" color2Int :: PenColor -> Int color2Int ColorBlack = 0 color2Int ColorBlue = 1 color2Int ColorRed = 2 color2Int ColorGreen = 3 color2Int ColorGray = 4 color2Int ColorLightBlue = 5 color2Int ColorLightGreen = 6 color2Int ColorMagenta = 7 color2Int ColorOrange = 8 color2Int ColorYellow = 9 color2Int ColorWhite = 10 color2Int _ = 0 -- just for the time being int2BkgStyle :: Int -> BackgroundStyle int2BkgStyle 0 = BkgStylePlain int2BkgStyle 1 = BkgStyleLined int2BkgStyle 2 = BkgStyleRuled int2BkgStyle 3 = BkgStyleGraph int2BkgStyle _ = BkgStyleRuled -- | int2NewPageMode :: Int -> NewPageModeType int2NewPageMode 0 = NPPlain int2NewPageMode 1 = NPLast int2NewPageMode 2 = NPCycle int2NewPageMode _ = error "No such new page mode" -- | newPageMode2Int :: NewPageModeType -> Int newPageMode2Int NPPlain = 0 newPageMode2Int NPLast = 1 newPageMode2Int NPCycle = 2