module SetHo.OptionsWidget
( GraphInfo(..)
, makeOptionsWidget
) where
import qualified Control.Concurrent as CC
import "gtk3" Graphics.UI.Gtk ( AttrOp( (:=) ) )
import qualified "gtk3" Graphics.UI.Gtk as Gtk
import System.Glib.Signals ( on )
import Text.Read ( readMaybe )
import qualified Data.Text as T
data GraphInfo =
GraphInfo { giXScaling :: Bool
, giXRange :: Maybe (Double,Double)
}
makeOptionsWidget :: CC.MVar GraphInfo -> IO Gtk.VBox
makeOptionsWidget graphInfoMVar = do
xRange <- Gtk.entryNew
Gtk.set xRange [ Gtk.entryEditable := False
, Gtk.widgetSensitive := False
]
xRangeBox <- labeledWidget "x range:" xRange
Gtk.set xRange [Gtk.entryText := "(-10,10)"]
let updateXRange = do
Gtk.set xRange [ Gtk.entryEditable := True
, Gtk.widgetSensitive := True
]
txt <- Gtk.get xRange Gtk.entryText
gi <- CC.readMVar graphInfoMVar
case readMaybe txt of
Nothing -> do
putStrLn $ "invalid x range entry: " ++ txt
Gtk.set xRange [Gtk.entryText := "(min,max)"]
Just (z0,z1) -> if z0 >= z1
then do
putStrLn $ "invalid x range entry (min >= max): " ++ txt
Gtk.set xRange [Gtk.entryText := "(min,max)"]
return ()
else do
_ <- CC.swapMVar graphInfoMVar (gi {giXRange = Just (z0,z1)})
return ()
_ <- on xRange Gtk.entryActivate updateXRange
xScalingSelector <- Gtk.comboBoxNewText
mapM_ (Gtk.comboBoxAppendText xScalingSelector . T.pack)
["linear (auto)","linear (manual)","logarithmic (auto)"]
Gtk.comboBoxSetActive xScalingSelector 0
xScalingBox <- labeledWidget "x scaling:" xScalingSelector
let updateXScaling = do
k <- Gtk.comboBoxGetActive xScalingSelector
case k of
0 -> do
Gtk.set xRange [ Gtk.entryEditable := False
, Gtk.widgetSensitive := False
]
CC.modifyMVar_ graphInfoMVar $
\gi -> return $ gi {giXScaling = False, giXRange = Nothing}
1 -> do
Gtk.set xRange [ Gtk.entryEditable := False
, Gtk.widgetSensitive := False
]
CC.modifyMVar_ graphInfoMVar $
\gi -> return $ gi {giXScaling = True, giXRange = Nothing}
_ -> error "the \"impossible\" happened: x scaling comboBox index should be < 3"
updateXScaling
_ <- on xScalingSelector Gtk.changed updateXScaling
vbox <- Gtk.vBoxNew False 4
Gtk.set vbox [ Gtk.containerChild := xScalingBox
, Gtk.boxChildPacking xScalingBox := Gtk.PackNatural
, Gtk.containerChild := xRangeBox
, Gtk.boxChildPacking xRangeBox := Gtk.PackNatural
]
return vbox
labeledWidget :: Gtk.WidgetClass a => String -> a -> IO Gtk.HBox
labeledWidget name widget = do
label <- Gtk.labelNew (Just name)
hbox <- Gtk.hBoxNew False 4
Gtk.set hbox [ Gtk.containerChild := label
, Gtk.containerChild := widget
, Gtk.boxChildPacking label := Gtk.PackNatural
]
return hbox