{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} ----------------------------------------------------------------------------- -- | -- Module : Hoodle.GUI.Menu -- Copyright : (c) 2011-2015 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 qualified Graphics.UI.Gtk as Gtk import System.FilePath -- from hoodle-platform import Data.Hoodle.Predefined -- from this package import Hoodle.Coroutine.Callback import Hoodle.Type -- import Paths_hoodle_core 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 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") 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 <- 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)) 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) -- 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 -- 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 #ifndef GTK3 Gtk.toolbarSetIconSize (Gtk.castToToolbar toolbar1) Gtk.IconSizeSmallToolbar #endif 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 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