{-# LANGUAGE QuasiQuotes #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Hoodle.GUI.Menu 
-- Copyright   : (c) 2011-2013 Ian-Woo Kim
--
-- License     : BSD3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-- Construct hoodle menus 
--
-----------------------------------------------------------------------------

module Hoodle.GUI.Menu where

-- from other packages
import           Control.Lens (set)
import           Control.Monad
import           Graphics.UI.Gtk hiding (set,get)
import qualified Graphics.UI.Gtk as Gtk (set)
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 

-- | 
-- uiDecl :: String 
-- uiDecl = [verbatim|
-- |]

iconList :: [ (String,String) ]
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 :: [RadioActionEntry] 
viewmods = [ RadioActionEntry "CONTA" "Continuous" Nothing Nothing Nothing 0
           , RadioActionEntry "ONEPAGEA" "One Page" Nothing Nothing Nothing 1
           ]
           
-- | 
pointmods :: [RadioActionEntry] 
pointmods = [ RadioActionEntry "PENVERYFINEA" "Very fine" Nothing Nothing Nothing 0
            , RadioActionEntry "PENFINEA" "Fine" (Just "mythin") Nothing Nothing 1
            
            , RadioActionEntry "PENTHICKA" "Thick" (Just "mythick") Nothing Nothing 3 
            , RadioActionEntry "PENVERYTHICKA" "Very Thick" Nothing Nothing Nothing 4 
            , RadioActionEntry "PENULTRATHICKA" "Ultra Thick" Nothing Nothing Nothing 5   
            , RadioActionEntry "PENMEDIUMA" "Medium" (Just "mymedium") Nothing Nothing 2              
--             , RadioActionEntry "NOWIDTH" "Unknown" Nothing Nothing Nothing 999 
            ]            

-- | 

penmods :: [RadioActionEntry] 
penmods = [ RadioActionEntry "PENA"    "Pen"         (Just "mypen")         Nothing Nothing 0 
          , RadioActionEntry "ERASERA" "Eraser"      (Just "myeraser")      Nothing Nothing 1
          , RadioActionEntry "HIGHLTA" "Highlighter" (Just "myhighlighter") Nothing Nothing 2
--           , RadioActionEntry "TEXTA"   "Text"        (Just "mytext")        Nothing Nothing 3 
          , RadioActionEntry "SELREGNA" "Select Region"     (Just "mylasso")        Nothing Nothing 4
          , RadioActionEntry "SELRECTA" "Select Rectangle" (Just "myrectselect")        Nothing Nothing 5
          , RadioActionEntry "VERTSPA" "Vertical Space"    (Just "mystretch")        Nothing Nothing 6
          ]            

--          , RadioActionEntry "HANDA"   "Hand Tool"         (Just "myhand")        Nothing Nothing 7


-- | 

colormods :: [RadioActionEntry]
colormods = [ RadioActionEntry "BLUEA"       "Blue"       (Just "myblue")       Nothing Nothing 1
            , RadioActionEntry "REDA"        "Red"        (Just "myred")        Nothing Nothing 2
            , RadioActionEntry "GREENA"      "Green"      (Just "mygreen")      Nothing Nothing 3
            , RadioActionEntry "GRAYA"       "Gray"       (Just "mygray")       Nothing Nothing 4
            , RadioActionEntry "LIGHTBLUEA"  "Lightblue"  (Just "mylightblue")  Nothing Nothing 5     
            , RadioActionEntry "LIGHTGREENA" "Lightgreen" (Just "mylightgreen") Nothing Nothing 6
            , RadioActionEntry "MAGENTAA"    "Magenta"    (Just "mymagenta")    Nothing Nothing 7
            , RadioActionEntry "ORANGEA"     "Orange"     (Just "myorange")     Nothing Nothing 8
            , RadioActionEntry "YELLOWA"     "Yellow"     (Just "myyellow")     Nothing Nothing 9
            , RadioActionEntry "WHITEA"      "White"      (Just "mywhite")      Nothing Nothing 10
            , RadioActionEntry "BLACKA"      "Black"      (Just "myblack")      Nothing Nothing 0              
---             , RadioActionEntry "NOCOLOR"     "Unknown"    Nothing Nothing Nothing 999 
            ]

-- | 
bkgstyles :: [RadioActionEntry] 
bkgstyles = [ RadioActionEntry "BKGGRAPHA" "Graph" Nothing Nothing Nothing 3 
            , RadioActionEntry "BKGPLAINA" "Plain" Nothing Nothing Nothing 0
            , RadioActionEntry "BKGLINEDA" "Lined" Nothing Nothing Nothing 1
            , RadioActionEntry "BKGRULEDA" "Ruled" Nothing Nothing Nothing 2 
            ]

-- | 
iconResourceAdd :: IconFactory -> FilePath -> (FilePath, StockId) 
                   -> IO ()
iconResourceAdd iconfac resdir (fp,stid) = do 
  myIconSource <- iconSourceNew 
  iconSourceSetFilename myIconSource (resdir </> fp)
  iconSourceSetSize myIconSource IconSizeLargeToolbar
  myIconSourceSmall <- iconSourceNew 
  iconSourceSetFilename myIconSourceSmall (resdir </> fp)
  iconSourceSetSize myIconSource IconSizeMenu
  myIconSet <- iconSetNew 
  iconSetAddSource myIconSet myIconSource 
  iconSetAddSource myIconSet myIconSourceSmall
  iconFactoryAdd iconfac stid myIconSet

-- | 

actionNewAndRegisterRef :: EventVar                            
                           -> String -> String 
                           -> Maybe String -> Maybe StockId
                           -> Maybe UserEvent 
                           -> IO Action
actionNewAndRegisterRef evar name label tooltip stockId myevent = do 
    a <- actionNew name label tooltip stockId 
    case myevent of 
      Nothing -> return a 
      Just ev -> do 
        a `on` actionActivated $ do 
          eventHandler evar (UsrEv ev)
        return a

-- | 

getMenuUI :: EventVar -> IO (UIManager,UIComponentSignalHandler)
getMenuUI evar = do 
  let actionNewAndRegister = actionNewAndRegisterRef evar  
  -- icons   
  myiconfac <- iconFactoryNew 
  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
  jma     <- actionNewAndRegister "JMA"   "Page" Nothing Nothing Nothing
  tma     <- actionNewAndRegister "TMA"   "Tools" Nothing Nothing Nothing
  oma     <- actionNewAndRegister "OMA"   "Options" Nothing Nothing Nothing
  hma     <- actionNewAndRegister "HMA"   "Help" Nothing Nothing Nothing

  -- file menu
  newa    <- actionNewAndRegister "NEWA"  "New" (Just "Just a Stub") (Just stockNew) (justMenu MenuNew)
  opena   <- actionNewAndRegister "OPENA" "Open" (Just "Just a Stub") (Just stockOpen) (justMenu MenuOpen)
  savea   <- actionNewAndRegister "SAVEA" "Save" (Just "Just a Stub") (Just stockSave) (justMenu MenuSave)
  saveasa <- actionNewAndRegister "SAVEASA" "Save As" (Just "Just a Stub") (Just stockSaveAs) (justMenu MenuSaveAs)
  reloada <- actionNewAndRegister "RELOADA" "Reload File" (Just "Just a Stub") Nothing (justMenu MenuReload)
  recenta <- actionNewAndRegister "RECENTA" "Recent Document" (Just "Just a Stub") Nothing (justMenu MenuRecentDocument)
  annpdfa <- actionNewAndRegister "ANNPDFA" "Annotate PDF" (Just "Just a Stub") Nothing (justMenu MenuAnnotatePDF)
  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)
  latexa <- actionNewAndRegister "LATEXA" "LaTeX" (Just "Just a Stub") (Just "mylatex") (justMenu MenuLaTeX)
  combinelatexa <- actionNewAndRegister "COMBINELATEXA" "Combine LaTeX texts to ..." (Just "Just a Stub") Nothing (justMenu MenuCombineLaTeX)  
  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)
  printa  <- actionNewAndRegister "PRINTA" "Print" (Just "Just a Stub") Nothing (justMenu MenuPrint)
  exporta <- actionNewAndRegister "EXPORTA" "Export" (Just "Just a Stub") Nothing (justMenu MenuExport)
  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)    
  quita   <- actionNewAndRegister "QUITA" "Quit" (Just "Just a Stub") (Just stockQuit) (justMenu MenuQuit)
  
  -- edit menu
  undoa   <- actionNewAndRegister "UNDOA"   "Undo" (Just "Just a Stub") (Just stockUndo) (justMenu MenuUndo)
  redoa   <- actionNewAndRegister "REDOA"   "Redo" (Just "Just a Stub") (Just stockRedo) (justMenu MenuRedo)
  cuta    <- actionNewAndRegister "CUTA"    "Cut" (Just "Just a Stub")  (Just stockCut) (justMenu MenuCut)
  copya   <- actionNewAndRegister "COPYA"   "Copy" (Just "Just a Stub") (Just stockCopy) (justMenu MenuCopy)
  pastea  <- actionNewAndRegister "PASTEA"  "Paste" (Just "Just a Stub") (Just stockPaste) (justMenu MenuPaste)
  deletea <- actionNewAndRegister "DELETEA" "Delete" (Just "Just a Stub") (Just stockDelete) (justMenu MenuDelete)

  -- view menu
  fscra     <- actionNewAndRegister "FSCRA"     "Full Screen" (Just "Just a Stub") (Just "myfullscreen") (justMenu MenuFullScreen)
  zooma     <- actionNewAndRegister "ZOOMA"     "Zoom" (Just "Just a Stub") Nothing Nothing -- (justMenu MenuZoom)
  zmina     <- actionNewAndRegister "ZMINA"     "Zoom In" (Just "Zoom In") (Just stockZoomIn) (justMenu MenuZoomIn)
  zmouta    <- actionNewAndRegister "ZMOUTA"    "Zoom Out" (Just "Zoom Out") (Just stockZoomOut) (justMenu MenuZoomOut)
  nrmsizea  <- actionNewAndRegister "NRMSIZEA"  "Normal Size" (Just "Normal Size") (Just stockZoom100) (justMenu MenuNormalSize)
  pgwdtha   <- actionNewAndRegister "PGWDTHA" "Page Width" (Just "Page Width") (Just stockZoomFit) (justMenu MenuPageWidth)
  pgheighta <- actionNewAndRegister "PGHEIGHTA" "Page Height" (Just "Page Height") Nothing (justMenu MenuPageHeight)
  setzma    <- actionNewAndRegister "SETZMA"  "Set Zoom" (Just "Set Zoom") (Just stockFind) (justMenu MenuSetZoom)
  fstpagea  <- actionNewAndRegister "FSTPAGEA"  "First Page" (Just "Just a Stub") (Just stockGotoFirst) (justMenu MenuFirstPage)
  prvpagea  <- actionNewAndRegister "PRVPAGEA"  "Previous Page" (Just "Just a Stub") (Just stockGoBack) (justMenu MenuPreviousPage)
  nxtpagea  <- actionNewAndRegister "NXTPAGEA"  "Next Page" (Just "Just a Stub") (Just stockGoForward) (justMenu MenuNextPage)
  lstpagea  <- actionNewAndRegister "LSTPAGEA"  "Last Page" (Just "Just a Stub") (Just stockGotoLast) (justMenu MenuLastPage)
  shwlayera <- actionNewAndRegister "SHWLAYERA" "Show Layer" (Just "Just a Stub") Nothing (justMenu MenuShowLayer)
  hidlayera <- actionNewAndRegister "HIDLAYERA" "Hide Layer" (Just "Just a Stub") Nothing (justMenu MenuHideLayer)
  hsplita <- actionNewAndRegister "HSPLITA" "Horizontal Split" (Just "horizontal split") Nothing (justMenu MenuHSplit)
  vsplita <- actionNewAndRegister "VSPLITA" "Vertical Split" (Just "vertical split") Nothing (justMenu MenuVSplit)
  delcvsa <- actionNewAndRegister "DELCVSA" "Delete Current Canvas" (Just "delete current canvas") Nothing (justMenu MenuDelCanvas)

  -- 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)
  expsvga <- actionNewAndRegister "EXPSVGA" "Export Current Page to SVG" (Just "Just a Stub") Nothing (justMenu MenuExportPageSVG) 
  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)
  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)
  -- ldbkga  <- actionNewAndRegister "LDBKGA"  "Load Background" (Just "Just a Stub") Nothing (justMenu MenuLoadBackground)
  -- bkgscrshta <- actionNewAndRegister "BKGSCRSHTA" "Background Screenshot" (Just "Just a Stub") Nothing (justMenu MenuBackgroundScreenshot)
  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
  texta <- actionNewAndRegister "TEXTA" "Text" (Just "Text") (Just "mytext") (justMenu MenuText)
  linka <- actionNewAndRegister "LINKA" "Add Link" (Just "Add Link") (Just stockIndex) (justMenu MenuAddLink)
  shpreca   <- actionNewAndRegister "SHPRECA" "Shape Recognizer" (Just "Just a Stub") (Just "myshapes") (justMenu MenuShapeRecognizer)
  rulera    <- actionNewAndRegister "RULERA" "Ruler" (Just "Just a Stub") (Just "myruler") (justMenu MenuRuler)
  -- selregna  <- actionNewAndRegister "SELREGNA" "Select Region" (Just "Just a Stub") (Just "mylasso") (justMenu MenuSelectRegion)
  -- selrecta  <- actionNewAndRegister "SELRECTA" "Select Rectangle" (Just "Just a Stub") (Just "myrectselect") (justMenu MenuSelectRectangle)
  -- vertspa   <- actionNewAndRegister "VERTSPA" "Vertical Space" (Just "Just a Stub") (Just "mystretch") (justMenu MenuVerticalSpace)
  clra      <- actionNewAndRegister "CLRA" "Color" (Just "Just a Stub") Nothing Nothing
  clrpcka   <- actionNewAndRegister "CLRPCKA" "Color Picker.." (Just "Just a Stub") (Just 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)
  relauncha <- actionNewAndRegister "RELAUNCHA" "Relaunch Application" (Just "Just a Stub") Nothing (justMenu MenuRelaunch)
    
  -- options menu 
  uxinputa <- toggleActionNew "UXINPUTA" "Use XInput" (Just "Just a Stub") Nothing 
  uxinputa `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuUseXInput))
  -- handa <- actionNewAndRegister "HANDA" "Use Touch" (Just "Use touch") (Just "myhand") (justMenu MenuUseTouch)    
  handa     <- toggleActionNew "HANDA" "Use Touch" (Just "Toggle touch") (Just "myhand") 
  handa `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuUseTouch))
  smthscra <- toggleActionNew "SMTHSCRA" "Smooth Scrolling" (Just "Just a stub") Nothing
  smthscra `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuSmoothScroll))
  popmenua <- toggleActionNew "POPMENUA" "Use Popup Menu" (Just "Just a stub") Nothing
  popmenua `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuUsePopUpMenu))
  ebdimga <- toggleActionNew "EBDIMGA" "Embed PNG/JPG Image" (Just "Just a stub") Nothing
  ebdimga `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuEmbedImage))
  ebdpdfa <- toggleActionNew "EBDPDFA" "Embed PDF" (Just "Just a stub") Nothing
  ebdpdfa `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuEmbedPDF))
  flwlnka <- toggleActionNew "FLWLNKA" "Follow Links" (Just "Just a stub") Nothing
  flwlnka `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuFollowLinks))    
  keepratioa <- toggleActionNew "KEEPRATIOA" "Keep Aspect Ratio" (Just "Just a stub") Nothing
  keepratioa `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuKeepAspectRatio))
  -- temporary implementation (later will be as submenus with toggle action. appropriate reflection)
  togpanzooma <- actionNewAndRegister "TOGPANZOOMA" "Toggle Pan/Zoom Widget"  (Just "Just a stub") Nothing (justMenu MenuTogglePanZoomWidget)
  toglayera <- actionNewAndRegister "TOGLAYERA" "Toggle Layer Widget"  (Just "Just a stub") Nothing (justMenu MenuToggleLayerWidget)
  togclocka <- actionNewAndRegister "TOGCLOCKA" "Toggle Clock Widget"  (Just "Just a stub") Nothing (justMenu MenuToggleClockWidget)
    
  dcrdcorea <- actionNewAndRegister "DCRDCOREA" "Discard Core Events" (Just "Just a Stub") Nothing (justMenu MenuDiscardCoreEvents)
  ersrtipa <- actionNewAndRegister "ERSRTIPA" "Eraser Tip" (Just "Just a Stub") Nothing (justMenu MenuEraserTip)
  pressrsensa <- toggleActionNew "PRESSRSENSA" "Pressure Sensitivity" (Just "Just a Stub") Nothing 
  pressrsensa `on` actionToggled $ do 
    eventHandler evar (UsrEv (Menu MenuPressureSensitivity))


  
  
  
  pghilta <- actionNewAndRegister "PGHILTA" "Page Highlight" (Just "Just a Stub") Nothing (justMenu MenuPageHighlight)
  mltpgvwa <- actionNewAndRegister "MLTPGVWA" "Multiple Page View" (Just "Just a Stub") Nothing (justMenu MenuMultiplePageView) 
  mltpga <- actionNewAndRegister "MLTPGA" "Multiple Pages" (Just "Just a Stub") Nothing (justMenu MenuMultiplePages)
  btn2mapa <- actionNewAndRegister "BTN2MAPA" "Button 2 Mapping" (Just "Just a Stub") Nothing (justMenu MenuButton2Mapping)
  btn3mapa <- actionNewAndRegister "BTN3MAPA" "Button 3 Mapping" (Just "Just a Stub") Nothing (justMenu MenuButton3Mapping)
  antialiasbmpa <- actionNewAndRegister "ANTIALIASBMPA" "Antialiased Bitmaps" (Just "Just a Stub") Nothing (justMenu MenuAntialiasedBitmaps)
  prgrsbkga <- actionNewAndRegister "PRGRSBKGA" "Progressive Backgrounds" (Just "Just a Stub") Nothing (justMenu MenuProgressiveBackgrounds)
  prntpprulea <- actionNewAndRegister "PRNTPPRULEA" "Print Paper Ruling" (Just "Just a Stub") Nothing (justMenu MenuPrintPaperRuling)
  lfthndscrbra <- actionNewAndRegister "LFTHNDSCRBRA" "Left-Handed Scrollbar" (Just "Just a Stub") Nothing (justMenu MenuLeftHandedScrollbar)
  shrtnmenua <- actionNewAndRegister "SHRTNMENUA" "Shorten Menus" (Just "Just a Stub") Nothing (justMenu MenuShortenMenus)
  autosaveprefa <- actionNewAndRegister "AUTOSAVEPREFA" "Auto-Save Preferences" (Just "Just a Stub") Nothing (justMenu MenuAutoSavePreferences)
  saveprefa <- actionNewAndRegister "SAVEPREFA" "Save Preferences" (Just "Just a Stub") Nothing (justMenu MenuSavePreferences)
  
  -- 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 <- actionGroupNew "AGR"
  mapM_ (actionGroupAddAction agr) 
        [fma,ema,vma,jma,tma,oma,hma]
  mapM_ (actionGroupAddAction agr)   
        [ undoa, redoa, cuta, copya, pastea, deletea ] 
  mapM_ (\act -> actionGroupAddActionWithAccel agr act Nothing)   
        [ newa, annpdfa, ldpnga, ldsvga, latexa, combinelatexa, ldpreimga, ldpreimg2a, ldpreimg3a, opena, savea, saveasa
        , reloada, recenta, printa, exporta, synca, versiona, showreva, showida, quita
        , fscra, zooma, zmina, zmouta, nrmsizea, pgwdtha, pgheighta, setzma
        , fstpagea, prvpagea, nxtpagea, lstpagea, shwlayera, hidlayera
        , hsplita, vsplita, delcvsa
        , newpgba, newpgaa, newpgea, delpga, expsvga, newlyra, nextlayera, prevlayera, gotolayera, dellyra, ppsizea, ppclra
        , ppstya 
        , apallpga, embedbkgpdfa, defppa, setdefppa
        , texta, linka, shpreca, rulera, clra, clrpcka, penopta 
        , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta
        , setdefopta, relauncha
        , togpanzooma, toglayera, togclocka
        , dcrdcorea, ersrtipa, pghilta, mltpgvwa
        , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea 
        , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa 
        , abouta 
        , defaulta         
        ] 
    
  mapM_ (actionGroupAddAction agr) 
    [uxinputa, handa, smthscra, popmenua, ebdimga, ebdpdfa, flwlnka, keepratioa, pressrsensa]
  -- actionGroupAddRadioActions agr viewmods 0 (assignViewMode evar)
  mpgmodconnid <- 
    actionGroupAddRadioActionsAndGetConnID agr viewmods 0 (assignViewMode evar) -- const (return ()))
  _mpointconnid <- 
    actionGroupAddRadioActionsAndGetConnID agr pointmods 0 (assignPoint evar)
  mpenmodconnid <- 
    actionGroupAddRadioActionsAndGetConnID agr penmods   0 (assignPenMode evar)
  _mcolorconnid <-  
    actionGroupAddRadioActionsAndGetConnID agr colormods 0 (assignColor evar) 
  actionGroupAddRadioActions agr bkgstyles 2 (assignBkgStyle evar)
  
  
  let disabledActions = 
        [ recenta, printa
        , cuta, copya, deletea
        ,  setzma
        , shwlayera, hidlayera
        , newpgea, ppsizea, ppclra
        , defppa, setdefppa
        , shpreca, rulera 
        , erasropta, hiltropta, txtfnta, defpena, defersra, defhiltra, deftxta
        , setdefopta
        , dcrdcorea, ersrtipa, pghilta, mltpgvwa
        , mltpga, btn2mapa, btn3mapa, antialiasbmpa, prgrsbkga, prntpprulea 
        , lfthndscrbra, shrtnmenua, autosaveprefa, saveprefa 
        , abouta 
        , defaulta         
        ] 
      enabledActions = 
        [ opena, savea, saveasa, reloada, versiona, showreva, showida, quita
        , pastea, fstpagea, prvpagea, nxtpagea, lstpagea
        , clra, penopta, zooma, nrmsizea, pgwdtha, texta  
        ]
  --
  mapM_ (\x->actionSetSensitive x True) enabledActions  
  mapM_ (\x->actionSetSensitive x False) disabledActions
  --
  -- 
  -- radio actions
  --
  ui <- uiManagerNew
  
  uiDecl <- readFile (resDir </> "menu.xml")   
  uiManagerAddUiFromString ui uiDecl
  uiManagerInsertActionGroup ui agr 0 
  Just ra2 <- actionGroupGetAction agr "PENFINEA"
  Gtk.set (castToRadioAction ra2) [radioActionCurrentValue := 2]
  Just ra3 <- actionGroupGetAction agr "SELREGNA"
  actionSetSensitive ra3 True 
  Just ra4 <- actionGroupGetAction agr "VERTSPA"
  actionSetSensitive ra4 True
  -- Just ra5 <- actionGroupGetAction agr "HANDA"
  -- actionSetSensitive ra5 False
  Just ra6 <- actionGroupGetAction agr "CONTA"
  actionSetSensitive ra6 True
  Just _ra7 <- actionGroupGetAction agr "PENA"
  actionSetSensitive ra6 True  
  Just toolbar1 <- uiManagerGetWidget ui "/ui/toolbar1"
  toolbarSetStyle (castToToolbar toolbar1) ToolbarIcons 
  toolbarSetIconSize (castToToolbar toolbar1) IconSizeSmallToolbar
  Just toolbar2 <- uiManagerGetWidget ui "/ui/toolbar2"
  toolbarSetStyle (castToToolbar toolbar2) ToolbarIcons 
  toolbarSetIconSize (castToToolbar toolbar2) IconSizeSmallToolbar  
  
  -- Just pendropdown <- uiManagerGetWidget ui "/ui/toolbar2/PENDROPDOWN"
  
  
  let uicomponentsignalhandler = set penModeSignal mpenmodconnid 
                                 . set pageModeSignal mpgmodconnid 
                                 $ defaultUIComponentSignalHandler 
  return (ui,uicomponentsignalhandler)   


-- |
actionGroupAddRadioActionsAndGetConnID :: ActionGroup 
                                       -> [RadioActionEntry]
                                       -> Int  
                                       -> (RadioAction -> IO ()) 
                                       -> IO (Maybe (ConnectId RadioAction))
actionGroupAddRadioActionsAndGetConnID self entries _value onChange = do 
  mgroup <- foldM 
    (\mgroup (n,RadioActionEntry name label stockId accelerator tooltip value) -> do
     action <- radioActionNew name label tooltip stockId value
     case mgroup of 
       Nothing -> return () 
       Just gr -> radioActionSetGroup action gr
     when (n==value) (toggleActionSetActive action True)
     actionGroupAddActionWithAccel self action accelerator
     return (Just action))
    Nothing (zip [0..] entries)
  case mgroup of 
    Nothing -> return Nothing 
    Just gr -> do 
      connid <- (gr `on` radioActionChanged) onChange
      return (Just connid)


-- | 
assignViewMode :: EventVar -> RadioAction -> IO ()
assignViewMode evar a = viewModeToUserEvent a >>= eventHandler evar . UsrEv
    
-- | 
assignPenMode :: EventVar -> RadioAction -> IO ()
assignPenMode evar a = do 
    v <- radioActionGetCurrentValue a
    eventHandler evar (UsrEv (AssignPenMode (int2PenType v)))

      
-- | 
assignColor :: EventVar -> RadioAction -> IO () 
assignColor evar a = do 
    v <- radioActionGetCurrentValue a
    let c = int2Color v
    eventHandler evar (UsrEv (PenColorChanged c))

-- | 
assignPoint :: EventVar -> RadioAction -> IO ()  
assignPoint evar a = do 
    v <- radioActionGetCurrentValue a
    eventHandler evar (UsrEv (PenWidthChanged v))


-- | 
assignBkgStyle :: EventVar -> RadioAction -> IO ()
assignBkgStyle evar a = do 
    v <- radioActionGetCurrentValue a 
    let sty = int2BkgStyle v 
    eventHandler evar (UsrEv (BackgroundStyleChanged sty))

-- | 
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