module LGtk
(
MonadRefState (..)
, Reference
, RefState
, RefReader
, readRef
, writeRef
, lensMap
, joinRef
, unitRef
, ExtRef
, Ref
, extRef
, newRef
, ReadRef
, WriteRef
, liftReadRef
, modRef
, readRef'
, memoRead
, undoTr
, EqReference (..)
, EqRef
, eqRef
, newEqRef
, toRef
, EffRef
, onChange
, SafeIO
, getArgs
, getProgName
, lookupEnv
, EffIORef
, asyncWrite
, putStr_
, getLine_
, fileRef
, putStrLn_
, Widget
, runWidget
, label
, checkbox
, combobox
, entry
, vcat
, hcat
, button_
, Color (..)
, notebook
, cell_
, action
, canvas
, Dia
, MouseEvent (..)
, MousePos (..)
, Modifier
, KeyVal
, keyName
, keyToChar
, ScrollDirection (..)
, hscale
, empty
, entryShow
, button
, smartButton
, cell
, cellNoMemo
, button__
) where
import Data.Maybe
import Data.Monoid
import Control.Monad
import Data.Lens.Common
import Control.Monad.ExtRef
import Control.Monad.EffRef
import GUI.Gtk.Structures hiding (Send, Receive, SendReceive, Widget)
import qualified GUI.Gtk.Structures as Gtk
import qualified GUI.Gtk.Structures.IO as Gtk
import Control.Monad.Restricted
type Widget m = Gtk.Widget (EffectM m) m (CallbackM m)
runWidget :: (forall m . EffIORef m => Widget m) -> IO ()
runWidget = Gtk.runWidget
vcat :: Monad m => [Widget m] -> Widget m
vcat = return . List Vertical
hcat :: Monad m => [Widget m] -> Widget m
hcat = return . List Horizontal
empty :: Monad m => Widget m
empty = hcat []
label :: EffRef m => ReadRef m String -> Widget m
label = return . Label . rEffect True
button__
:: EffRef m
=> ReadRef m String
-> ReadRef m Bool
-> ReadRef m Color
-> WriteRef m ()
-> Widget m
button__ r x c y = return $ Button (rEffect True r) (rEffect True x) (rEffect True c) (toReceive $ \() -> y)
button_
:: EffRef m
=> ReadRef m String
-> ReadRef m Bool
-> WriteRef m ()
-> Widget m
button_ r x y = return $ Button (rEffect True r) (rEffect True x) (const $ return ()) (toReceive $ \() -> y)
button
:: EffRef m
=> ReadRef m String
-> ReadRef m (Maybe (WriteRef m ()))
-> Widget m
button r fm = button_ r (liftM isJust fm) (liftRefStateReader fm >>= maybe (return ()) id)
smartButton
:: (EffRef m, EqReference r, RefState r ~ RefState (Ref m))
=> ReadRef m String
-> r a
-> (a -> a)
-> Widget m
smartButton s r f
= button_ s (hasEffect r f) (modRef r f)
checkbox :: EffRef m => Ref m Bool -> Widget m
checkbox r = return $ Checkbox (rEffect True (readRef r), toReceive $ writeRef r)
combobox :: EffRef m => [String] -> Ref m Int -> Widget m
combobox ss r = return $ Combobox ss (rEffect True (readRef r), toReceive $ writeRef r)
entry :: (EffRef m, Reference r, RefState r ~ RefState (Ref m)) => r String -> Widget m
entry r = return $ Entry (rEffect True (readRef r), toReceive $ writeRef r)
entryShow :: (EffRef m, Show a, Read a, Reference r, RefState r ~ RefState (Ref m)) => r a -> Widget m
entryShow r = entry $ showLens `lensMap` r
notebook :: EffRef m => [(String, Widget m)] -> Widget m
notebook xs = do
currentPage <- newRef 0
let f index (title, w) = (,) title $ cell (liftM (== index) $ readRef currentPage) $ \b -> case b of
False -> hcat []
True -> w
return $ Notebook' (toReceive $ writeRef currentPage) $ zipWith f [0..] xs
cell_ :: (EffRef m, Eq a) => ReadRef m a -> (forall x . (Widget m -> m x) -> a -> m (m x)) -> Widget m
cell_ r = return . Cell (onChange True r)
cell :: (EffRef m, Eq a) => ReadRef m a -> (a -> Widget m) -> Widget m
cell r m = cell_ r $ \mk -> liftM return . mk . m
cellNoMemo :: (EffRef m, Eq a) => ReadRef m a -> (a -> Widget m) -> Widget m
cellNoMemo r m = cell_ r $ \mk -> return . mk . m
action :: EffRef m => m (Widget m) -> Widget m
action = join
canvas :: (EffRef m, Eq b, Eq a, Monoid a) => Int -> Int -> Double -> (MouseEvent a -> WriteRef m ()) -> ReadRef m b -> (b -> Dia a) -> Widget m
canvas w h sc me r f = return $ Canvas w h sc (toReceive me) (rEffect True r) f
hscale :: (EffRef m) => Double -> Double -> Double -> Ref m Double -> Widget m
hscale a b c r = return $ Scale a b c (rEffect True $ readRef r, toReceive $ writeRef r)