module Hoodle.GUI.Menu where
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
import Data.Hoodle.Predefined
import Hoodle.Coroutine.Callback
import Hoodle.Type
import Paths_hoodle_core
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
]
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 "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
]
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
]
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.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
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
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)
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)
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
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)
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)
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)
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)
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)
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)
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))
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
addtaba <- actionNewAndRegister "ADDTABA" "Add new tab" (Just "Just a Stub") Nothing (justMenu MenuAddTab)
closetaba <- actionNewAndRegister "CLOSETABA" "Close current tab" (Just "Just a Stub") Nothing (justMenu MenuCloseTab)
abouta <- actionNewAndRegister "ABOUTA" "About" (Just "Just a Stub") Nothing (justMenu MenuAbout)
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
, addtaba, 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
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 4 = Right SelectLassoWork
int2PenType 5 = Right SelectRectangleWork
int2PenType 6 = Left VerticalSpaceWork
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
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
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
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