module Hoodle.GUI.Reflect where
import Control.Lens (view, Simple,Lens, (^.), (.~), _1,_2,_3)
import Control.Monad.State as St
import Data.Array.MArray
import qualified Data.Foldable as F (forM_,mapM_)
import qualified Data.Map as M (lookup)
import Data.Word
import qualified Graphics.UI.Gtk as Gtk
import Hoodle.Accessor
import Hoodle.Coroutine.Draw
import Hoodle.GUI.Menu
import Hoodle.Type.Canvas
import Hoodle.Type.Coroutine
import Hoodle.Type.Enum
import Hoodle.Type.Event
import Hoodle.Type.HoodleState
import Hoodle.Type.PageArrangement
import Hoodle.Type.Predefined
import Hoodle.Util
import Hoodle.View.Coordinate
changeCurrentCanvasId :: CanvasId -> MainCoroutine UnitHoodle
changeCurrentCanvasId cid = do
xst <- St.get
let uhdl = view (unitHoodles.currentUnit) xst
case setCurrentCanvasId cid uhdl of
Nothing -> return uhdl
Just uhdl' -> do
pureUpdateUhdl (const uhdl')
reflectViewModeUI
return uhdl'
chkCvsIdNInvalidate :: CanvasId -> MainCoroutine ()
chkCvsIdNInvalidate cid = do
currcid <- liftM (getCurrentCanvasId . view (unitHoodles.currentUnit) ) St.get
when (currcid /= cid) (changeCurrentCanvasId cid >> invalidateAll)
blockWhile :: (Gtk.GObjectClass w) => Maybe (Gtk.ConnectId w) -> IO () -> IO ()
blockWhile msig act = do
F.mapM_ Gtk.signalBlock msig >> act >> F.mapM_ Gtk.signalUnblock msig
reflectViewModeUI :: MainCoroutine ()
reflectViewModeUI = do
xstate <- St.get
let uhdl = view (unitHoodles.currentUnit) xstate
cinfobox = view currentCanvasInfo uhdl
ui = view gtkUIManager xstate
let mconnid = view (uiComponentSignalHandler.pageModeSignal) xstate
agr <- liftIO $ Gtk.uiManagerGetActionGroups ui
ra1 <- maybe (error "reflectUI") return =<<
liftIO (Gtk.actionGroupGetAction (head agr) "ONEPAGEA")
let wra1 = Gtk.castToRadioAction ra1
unboxBiAct (pgmodupdate_s mconnid wra1) (pgmodupdate_c mconnid wra1) cinfobox
return ()
where pgmodupdate_s mconnid wra1 _cinfo = do
liftIO $ blockWhile mconnid $
Gtk.set wra1 [Gtk.radioActionCurrentValue Gtk.:= 1 ]
pgmodupdate_c mconnid wra1 _cinfo = do
liftIO $ blockWhile mconnid $
Gtk.set wra1 [Gtk.radioActionCurrentValue Gtk.:= 0 ]
reflectPenModeUI :: MainCoroutine ()
reflectPenModeUI = do
reflectUIRadio penModeSignal "PENA" f
reflectCursor False
where
f xst = Just $
hoodleModeStateEither ((view hoodleModeState . view (unitHoodles.currentUnit)) xst) #
either (\_ -> (penType2Int. Left .view (penInfo.penType)) xst)
(\_ -> (penType2Int. Right .view (selectInfo.selectType)) xst)
reflectPenColorUI :: MainCoroutine ()
reflectPenColorUI = do
reflectUIRadio penColorSignal "BLUEA" f
reflectCursor False
where
f xst =
let mcolor =
case view (penInfo.penType) xst of
PenWork -> Just (view (penInfo.penSet.currPen.penColor) xst)
HighlighterWork -> Just (view (penInfo.penSet.currHighlighter.penColor) xst)
_ -> Nothing
in fmap color2Int mcolor
reflectPenWidthUI :: MainCoroutine ()
reflectPenWidthUI = do
reflectUIRadio penPointSignal "PENVERYFINEA" f
reflectCursor False
where
f xst =
case view (penInfo.penType) xst of
PenWork -> (Just . point2Int PenWork
. view (penInfo.penSet.currPen.penWidth)) xst
HighlighterWork ->
let x = (Just . point2Int HighlighterWork
. view (penInfo.penSet.currHighlighter.penWidth)) xst
in x
EraserWork -> (Just . point2Int EraserWork
. view (penInfo.penSet.currEraser.penWidth)) xst
_ -> Nothing
reflectNewPageModeUI :: MainCoroutine ()
reflectNewPageModeUI =
reflectUIRadio newPageModeSignal "NEWPAGEPLAINA" (Just . newPageMode2Int . (^. settings.newPageMode))
reflectUIRadio :: Simple Lens UIComponentSignalHandler (Maybe (Gtk.ConnectId Gtk.RadioAction))
-> String
-> (HoodleState -> Maybe Int)
-> MainCoroutine ()
reflectUIRadio lnz name f = do
xst <- St.get
let ui = view gtkUIManager xst
mconnid = view (uiComponentSignalHandler.lnz) xst
agr <- liftIO $ Gtk.uiManagerGetActionGroups ui
Just pma <- liftIO $ Gtk.actionGroupGetAction (head agr) name
let wpma = Gtk.castToRadioAction pma
update xst wpma mconnid
where update xst wpma mconnid = do
(f xst) #
(maybe (return ()) $ \v ->
doIOaction_ $ blockWhile mconnid (Gtk.set wpma [Gtk.radioActionCurrentValue Gtk.:= v ] )
)
reflectUIToggle :: Gtk.UIManager -> String -> Bool -> IO ()
reflectUIToggle ui str b = do
agr <- Gtk.uiManagerGetActionGroups ui >>= \x ->
case x of
[] -> error "No action group?"
y:_ -> return y
Just savea <- Gtk.actionGroupGetAction agr str
Gtk.actionSetSensitive savea b
reflectCursor :: Bool -> MainCoroutine ()
reflectCursor isforced = do
xst <- St.get
let b = view (settings.doesUseVariableCursor) xst
pinfo = view penInfo xst
pcolor = view (penSet . currPen . penColor) pinfo
pwidth = view (penSet . currPen . penWidth) pinfo
cinfo = view cursorInfo xst
(ccolor,cwidth,cvar) = cinfo
when (pcolor /= ccolor || pwidth /= cwidth || b /= cvar || isforced) $ do
msgShout "reflectCursor: change cursor"
put . (cursorInfo._1 .~ pcolor) . (cursorInfo._2 .~ pwidth) . (cursorInfo._3 .~ b) $ xst
doIOaction_ $ if b
then varyCursor xst
else do let uhdl = view (unitHoodles.currentUnit) xst
cinfobox = view currentCanvasInfo uhdl
canvas = forBoth' unboxBiAct (view drawArea) cinfobox
Just win <- Gtk.widgetGetWindow canvas
Gtk.postGUIAsync (Gtk.drawWindowSetCursor win Nothing)
return (UsrEv ActionOrdered)
where
varyCursor xst = do
putStrLn "reflectCursor : inside act"
let uhdl = view (unitHoodles.currentUnit) xst
cinfobox = view currentCanvasInfo uhdl
canvas = forBoth' unboxBiAct (view drawArea) cinfobox
cpn = PageNum $
forBoth' unboxBiAct (view currentPageNum) cinfobox
pinfo = view penInfo xst
pcolor = view (penSet . currPen . penColor) pinfo
pwidth = view (penSet . currPen . penWidth) pinfo
Just win <- Gtk.widgetGetWindow canvas
dpy <- Gtk.widgetGetDisplay canvas
geometry <-
forBoth' unboxBiAct (\c -> let arr = view (viewInfo.pageArrangement) c
in makeCanvasGeometry cpn arr canvas
) cinfobox
let p2c = desktop2Canvas geometry . page2Desktop geometry
CvsCoord (x0,_y0) = p2c (cpn, PageCoord (0,0))
CvsCoord (x1,_y1) = p2c (cpn, PageCoord (pwidth,pwidth))
cursize = (x1x0)
(r,g,b,a) = case pcolor of
ColorRGBA r' g' b' a' -> (r',g',b',a')
_ -> maybe (0,0,0,1) id (M.lookup pcolor penColorRGBAmap)
pb <- Gtk.pixbufNew Gtk.ColorspaceRgb True 8 maxCursorWidth maxCursorHeight
let numPixels = maxCursorWidth*maxCursorHeight
pbData <- (Gtk.pixbufGetPixels pb :: IO (Gtk.PixbufData Int Word8))
F.forM_ [0..numPixels1] $ \i -> do
let cvt :: Double -> Word8
cvt x | x < 0.0039 = 0
| x > 0.996 = 255
| otherwise = fromIntegral (floor (x*2561) `mod` 256 :: Int)
if (fromIntegral (i `mod` maxCursorWidth)) < cursize
&& (fromIntegral (i `div` maxCursorWidth)) < cursize
then do
writeArray pbData (4*i) (cvt r)
writeArray pbData (4*i+1) (cvt g)
writeArray pbData (4*i+2) (cvt b)
writeArray pbData (4*i+3) (cvt a)
else do
writeArray pbData (4*i) 0
writeArray pbData (4*i+1) 0
writeArray pbData (4*i+2) 0
writeArray pbData (4*i+3) 0
Gtk.drawWindowSetCursor win . Just =<<
Gtk.cursorNewFromPixbuf dpy pb (floor cursize `div` 2) (floor cursize `div` 2)
return (UsrEv ActionOrdered)