How to get cursor position in TextView in gtk2hs? - haskell

I have a TextView with assigned non-empty TextBuffer.
How to get current cursor position in TextView?
Or how to get current TextIter on cursor?

If you have a TextBuffer bound to the variable "buf", you can easily know where the cursor is. insertmark <- textBufferGetInsert buf is a convenient way to get the "insert" mark, which holds the cursor position. Then, you need the corresponding TextIter: cursoriter <- textBufferGetIterAtMark buf insertmark.
Now, the function textIterGetOffset cursoriter will give the position of the cursor inside the TextBuffer, starting from the first character in the buffer. textIterGetChar cursoriter which returns Maybe Char, will tell you what character there is at that position.
See the documentation of the module Graphics.UI.Gtk.Multiline.TextIter to learn more.
Note that the iter is only valid as long as the buffer remains unchanged. If the buffer contents change, you have to get the iter via the "insert" mark again.
This example code runs well on my machine (but it only shows information if you move the cursor with the arrow keys, not if you insert or delete text):
module Main where
import Graphics.UI.Gtk
main = do
initGUI
w <- windowNew
windowSetDefaultSize w 640 400
on w objectDestroy mainQuit
h <- vBoxNew False 8
b <- textBufferNew Nothing
t <- textViewNewWithBuffer b
l <- labelNew Nothing
on t moveCursor $ showInfo b l
boxPackStart h t PackGrow 0
boxPackStart h l PackNatural 0
containerAdd w h
widgetShowAll w
mainGUI
showInfo b l movementStep steps flag = do
i <- textBufferGetInsert b >>= textBufferGetIterAtMark b
p <- textIterGetOffset i
c <- textIterGetChar i
let cc = case c of
Nothing -> ""
Just ch -> [ch]
info = "Position: " ++ show p ++ "\nMovement step: " ++ show movementStep ++
"\nSteps: " ++ show steps ++ "\nExtends selection: " ++ show flag ++
"\nCharacter at cursor: " ++ cc
labelSetText l info

Related

Counter widget in Reflex-FRP

I am trying to make a counter widget in Reflex with the following qualities:
It has a minimum value of 0 -- and hitting "decrement" while at 0 results in nothing happening.
(solved) The increment button is to the right of the decrement button.
It has Bulma CSS styles applied.
This is the code I currently have:
bodyElementIncrRounds :: ObeliskWidget js t route m => m ()
bodyElementIncrRounds = do
-- el "h2" $ text "Using foldDyn with function application"
evIncr <- button "Increment"
evDecr <- button "Decrement"
-- evReset <- button "Reset"
dynNum <- foldDyn ($) (0 :: Int) $ leftmost [(+ 1) <$ evIncr, (+ (-1)) <$ evDecr]
el "h3" $ display dynNum
return ()
This is what the result is:
When I try to swap the buttons by flipping these to values: (+ 1) <$ evIncr, (+ (-1)) <$ evDecr, it has no effect at all on the location of the buttons. (I.e. increment remains on the left.)
When I try to apply Bulma code like this:
bodyElementIncrRounds :: ObeliskWidget js t route m => m ()
bodyElementIncrRounds = do
-- el "h2" $ text "Using foldDyn with function application"
evIncr <- elAttr "button" ("class" =: "button") $ button "Increment"
evDecr <- button "Decrement"
-- evReset <- button "Reset"
dynNum <- foldDyn ($) (0 :: Int) $ leftmost [(+ 1) <$ evIncr, (+ (-1)) <$ evDecr]
el "h3" $ display dynNum
return ()
It duplicates the button for some reason and also places the existing (ugly) button inside of the Bulma widget (edit: the duplication problem has been solved, but not the "button inside the button" problem):

How would I remove borders from all Floating windows in XMonad

There are several similar questions but none quite solve it for me, for example this question explains how to remove borders from fullscreen floating windows.
Using XMonad.Layout.NoBorders you can do lots of cool stuff like remove borders from certain windows or if it is the only window or only fullscreen floating windows.
I couldn't find anything for all floating windows, however if someone could just point me to some tool that I could use to check if a window is floating or not, I am sure I could try hack up a solution.
Any suggestions are welcome
I'll be using the source code of XMonad.Layout.NoBorders as a reference, since I can't find anything more fitting that already exists. We want to see how it implements "remove borders on fullscreen floating windows", to see if it can be easily relaxed to "remove borders on floating windows" (without the fullscreen constraint).
According to the answer on the question you linked:
layoutHook = lessBorders OnlyFloat $ avoidStruts $ myLayout
OnlyFloat seems to be the specifier for "remove borders on fullscreen floating windows", so let's check the definition of that:
data Ambiguity = Combine With Ambiguity Ambiguity
| OnlyFloat
| Never
| EmptyScreen
| OtherIndicated
| Screen
deriving (Read, Show)
Not too helpful on its own. We should look elsewhere to see how the code treats these values.
It's a pretty safe bet that the first function to check is lessBorders:
lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) =>
p -> l a -> ModifiedLayout (ConfigurableBorder p) l a
lessBorders amb = ModifiedLayout (ConfigurableBorder amb [])
From the type signature of lessBorders, we can see that:
OnlyFloat :: (SetsAmbiguous p, Read p, Show p) => p
This is a good sign, as it means lessBorders doesn't explicitly expect an Ambiguity: we can extend the functionality here by implementing our own SetsAmbiguous and passing it to the existing lessBorders. Let's now look at SetsAmbiguous, and Ambiguity's implementation of it:
class SetsAmbiguous p where
hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
instance SetsAmbiguous Ambiguity where
hiddens amb wset mst wrs
| Combine Union a b <- amb = on union next a b
| Combine Difference a b <- amb = on (\\) next a b
| Combine Intersection a b <- amb = on intersect next a b
| otherwise = tiled ms ++ floating
where next p = hiddens p wset mst wrs
nonzerorect (Rectangle _ _ 0 0) = False
nonzerorect _ = True
screens =
[ scr | scr <- W.screens wset,
case amb of
Never -> True
_ -> not $ null $ integrate scr,
nonzerorect . screenRect $ W.screenDetail scr]
floating = [ w |
(w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
px <= 0, py <= 0,
wx + px >= 1, wy + py >= 1]
ms = filter (`elem` W.integrate' mst) $ map fst wrs
tiled [w]
| Screen <- amb = [w]
| OnlyFloat <- amb = []
| OtherIndicated <- amb
, let nonF = map integrate $ W.current wset : W.visible wset
, length (concat nonF) > length wrs
, singleton $ filter (1==) $ map length nonF = [w]
| singleton screens = [w]
tiled _ = []
integrate y = W.integrate' . W.stack $ W.workspace y
hiddens is the only method here that we need to implement. Its arguments are our SetsAmbiguous value, a WindowSet, and some other things, and it returns a list of windows that should not show borders. There's a lot of logic for the combining operations and other Ambiguity values, but those don't matter to us right now. What we care about is this snippet:
floating = [ w |
(w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
px <= 0, py <= 0,
wx + px >= 1, wy + py >= 1]
This is very promising. It defines a set of floating windows by extracting all windows from the floating section of the WindowSet, converting it to a list (initially it's a Data.Map), and filtering out all the windows that don't cover the entire screen. All we need to do is remove the filter.
After making that change, and removing all unnecessary code pertaining to tiled windows and set operations (which is most of the implementation), we end up with simply:
import XMonad.Layout.NoBorders
import qualified XMonad.StackSet as W
import qualified Data.Map as M
data AllFloats = AllFloats deriving (Read, Show)
instance SetsAmbiguous AllFloats where
hiddens _ wset _ _ = M.keys $ W.floating wset
We can then say:
layoutHook = lessBorders AllFloats $ myLayout...

Why are buttons not rendering in a table in gtk2hs

I'm trying to write a simple UI in gtk2hs. It starts with two text boxes and a button. When the button is pressed, it makes a table of buttons of size (m,n) where m and n are taken from the text boxes. For some reason, when the button is pressed, space is allocated for the table but none of the buttons are shown!
import Graphics.UI.Gtk
import Control.Concurrent
t2l :: Int -> Int -> Int -> Int -> Int
t2l r c rr cc = (r * cc) + c
buildTable :: Int -> Int -> IO(Table, [Button])
buildTable r c = do
t <- tableNew r c True
buttons <- sequence $ take (r * c) (repeat buttonNew)
mapM (`set` [buttonLabel := "HELLO"]) buttons
return [tableAttachDefaults t (buttons !! (t2l rr cc r c)) cc (cc+1) rr (rr+1) | cc <- [0..(c+1)] , rr <- [0..(r+1)]]
return (t,buttons)
main = do
initGUI
window <- windowNew
mainSplit <- vBoxNew False 10
contPannel <- hBoxNew False 5
rowTF <- entryNew
colTF <- entryNew
buildBTN <- buttonNew
set buildBTN [buttonLabel := "Build Table"]
set window [containerChild := mainSplit]
boxPackStart mainSplit contPannel PackGrow 0
boxPackStart contPannel rowTF PackGrow 0
boxPackStart contPannel colTF PackGrow 0
boxPackStart contPannel buildBTN PackNatural 0
on window objectDestroy mainQuit
widgetShowAll window
on buildBTN buttonActivated $ do
rT <- get rowTF entryText
cT <- get colTF entryText
r <- return $ read rT
c <- return $ read cT
(t,b) <- buildTable r c
boxPackStart mainSplit t PackGrow 0
widgetShowAll t
return ()
mainGUI
I'm not 100% sure why the error arose, I have some new code which works:
import Graphics.UI.Gtk
import Control.Concurrent
mkBtn :: String -> IO Button
mkBtn label = buttonNew >>= (\b -> set b [buttonLabel := label] >> return b)
buildTable :: Int -> Int -> IO(Grid)
buildTable r c = do
t <- gridNew
gridSetRowHomogeneous t True
mapM (\f -> mkBtn "Hello" >>= (\b -> gridAttach t b (f `mod` c) (f `div` c) 1 1)) [0..(r*c)-1]
return (t)
main = do
initGUI
window <- windowNew
mainSplit <- vBoxNew False 10
contPannel <- hBoxNew False 5
rowTF <- entryNew
colTF <- entryNew
buildBTN <- buttonNew
set buildBTN [buttonLabel := "Build Table"]
set window [containerChild := mainSplit]
boxPackStart mainSplit contPannel PackGrow 0
boxPackStart contPannel rowTF PackGrow 0
boxPackStart contPannel colTF PackGrow 0
boxPackStart contPannel buildBTN PackNatural 0
on window objectDestroy mainQuit
widgetShowAll window
on buildBTN buttonActivated $ do
rT <- get rowTF entryText
cT <- get colTF entryText
r <- return $ read rT
c <- return $ read cT
t <- buildTable r c
boxPackStart mainSplit t PackGrow 0
widgetShowAll t
return ()
mainGUI
Maybe someone will know why this works and the last didn't? I assume it was how I was creating new buttons.
First thing I changed was from gtk2 to 3, this enabled me to use grid instead of table. Instead of using repeat, I used a helper function mkBtn. The other changes are just how I went about populating the grid. Instead of a rather silly list comprehension, I used mapM and converted the index in the list of buttons to table coords instead of table coords to list index (originally done in t2l)

How do I cast Widget to Label in Haskell's GI-Gtk?

I have this sample code where I have a ListBox containing ListBoxRows, which in turn contain a Label. When I click on the ListBox, I get a ListBoxRow. So far so good. The problems start when I want to interact with the ListBoxRows children.
I have used this function to get the Label, which is the child of the ListBoxRow.
https://hackage.haskell.org/package/gi-gtk-3.0.18/docs/GI-Gtk-Objects-Container.html#g:13
However, the returned type is Widget. How do I convert the type of the object? Function widgetGetName tells me it is a label, but the Haskell Type system insists it is a Widget, so I can not use label specific functions.
working code
_ <- onListBoxRowSelected listbox2 (\(Just r) -> do
cc <- containerGetChildren r
mlabel <- castTo Label (head cc)
case mlabel of
Nothing -> putStrLn "Not a label!"
Just label -> (labelGetText label) >>= putStrLn . unpack)
Thanks to Dan
Try this:
cc <- containerGetChildren r
mlabel <- castTo Label (head cc)
case mlabel of
Nothing -> putStrLn “Not a label!”
Just label -> labelGetText label >>= putStrLn

Timer function using gtk2hs

I'm trying to make a Timer in Haskell using gtk2hs.
I found an example on this website wiki.haskell Tutorial Threaded GUI
which I could successfully implement in my project. The only problem I'm facing is creating a restart button for the timer.
My goal is that when people pres the "New game" button, that a new game starts and that the timer resets.
If a want to just restart a game I can use this line of code
onClicked button1 (startNewGame table window)
, which works. The problem is I can't find a way to bind a the start timer function to a button.
I tried doing this:
onClicked button1 (do (startTimer box) (startNewGame table window))
Which does not work, also this does not work:
onClicked button1 (startTimer box)
How am I suppose to restart a thread correctly?
When I run this code:
onClicked button1 (startTimer box)
I get this error:
gui.hs:29:25:
Couldn't match type `ThreadId' with `()'
Expected type: IO ()
Actual type: IO ThreadId
In the return type of a call of `startTimer'
In the second argument of `onClicked', namely `(startTimer box)'
In a stmt of a 'do' block: onClicked button1 (startTimer box)
How can I bind the (startTimer box) function to a button?
Source code:
import Graphics.UI.Gtk
import SetTest
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Control.Monad.Trans(liftIO)
import Debug.Trace
import Control.Concurrent
import Control.Concurrent.MVar
import System.Exit
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowTitle := "Minesweeper",
windowDefaultWidth := 450, windowDefaultHeight := 200]
box <- vBoxNew False 0
containerAdd window box
button1 <- buttonNewWithLabel "New game"
boxPackStart box button1 PackGrow 0
widgetShowAll window
table <- tableNew 5 5 True
--onClicked button1 (do (startTimer box) (startNewGame table window))
--onClicked button1 (startTimer box)
onClicked button1 (startNewGame table window)
startTimer box
containerAdd window table
startNewGame table window
boxPackStart box table PackNatural 0
widgetShowAll window
onDestroy window mainQuit
mainGUI
startTimer :: BoxClass self => self -> IO ThreadId
startTimer box = do
timeLabel <- labelNew Nothing
boxPackStart box timeLabel PackNatural 0
forkIO $ do
let
printTime t = do{
threadDelay 1000000;
postGUIAsync $ labelSetText timeLabel (show t);
printTime (t+1)}
printTime 0
startNewGame:: (WidgetClass self, TableClass self1) => self1 -> self -> IO ()
startNewGame table window = let board = (SetTest.initialize 5 (5,5) (1,1)) :: MyBoard
in checkStatusGame table board window
:: (WidgetClass self, TableClass self1) =>
self1 -> MyBoard -> self -> IO ()
checkStatusGame table board window
| won board = do
cleanAndGenerateTable board table window True
(dialogMessage "hurray hurray hurray" "Gratz, you won!!!")
| lost board = do
(dialogMessage "Baby rage window" "Soz, you lost...")
cleanAndGenerateTable board table window True
| otherwise = (cleanAndGenerateTable board table window False)
cleanAndGenerateTable :: (WidgetClass self, TableClass self1) =>
MyBoard -> self1 -> self -> Bool -> IO ()
cleanAndGenerateTable board table window finished = do
let fieldList = [(x,y) | x <- [0 .. (height board)] , y <- [0 .. (width board)] ]
children <- containerGetChildren table
mapM_ (\child -> containerRemove table child >> widgetDestroy child) children
if finished
then mapM_(generateTableFinished board table window) fieldList
else mapM_ (generateTable board table window) fieldList
widgetShowAll window
generateTable board table window (x,y)
| Set.member (x,y) (flaggedCells board) = createButton "flag.jpg" (x,y) table board window
| Map.member (x,y) (clickedCells board) = createClickedButton (show (Map.findWithDefault (-1) (x,y) (clickedCells board))) (x,y) table
| otherwise = createButton "masked.png" (x,y) table board window
generateTableFinished board table window (x,y)
| Set.member (x,y) (bombs board) = createButtonNoAction "bomb.jpg" (x,y) table board window
| Map.member (x,y) (clickedCells board) = createClickedButton (show (Map.findWithDefault (-1) (x,y) (clickedCells board))) (x,y) table
| otherwise = createClickedButton (show (Map.findWithDefault (-1) (x,y) (maskedCells board))) (x,y) table
createButtonNoAction pth (x,y) table board window = do
button <- buttonNew
box <- hBoxNew False 0
image <- imageNewFromFile pth
boxPackStart box image PackRepel 0
containerAdd button box
tableAttachDefaults table button x (x+1) y (y+1)
createClickedButton lbl (x,y) table = do
button <- buttonNew
box <- hBoxNew False 0
label <- labelNew (Just lbl)
boxPackStart box label PackRepel 0
containerAdd button box
tableAttachDefaults table button x (x+1) y (y+1)
createButton pth (x,y) table board window = do
button <- buttonNew
box <- hBoxNew False 0
image <- imageNewFromFile pth
boxPackStart box image PackRepel 0
containerAdd button box
tableAttachDefaults table button x (x+1) y (y+1)
on button buttonReleaseEvent $ do
click <- eventButton
liftIO $ case click of { LeftButton -> (checkStatusGame table (SetTest.click (x,y) board) window); RightButton -> (checkStatusGame table (SetTest.flag (x,y) board) window) }
return False
return ()
dialogMessage title msg = do dialog <- messageDialogNew Nothing [] MessageOther ButtonsOk msg
set dialog [windowTitle := title]
widgetShowAll dialog
dialogRun dialog
widgetDestroy dialog
If you want to communicate with your timer thread, you will need to hand it a communication channel. An MVar seems appropriate here.
startTimer :: BoxClass self => self -> MVar Integer -> IO ThreadId
startTimer box timer = do
timeLabel <- labelNew Nothing
boxPackStart box timeLabel PackNatural 0
forkIO . forever $ do
threadDelay 1000000
t <- takeMVar timer
putMVar timer (t+1)
postGUIAsync $ labelSetText timeLabel (show t)
At the top of main, you can now create a fresh MVar with timer <- newMVar 0, and pass this to startTimer. In your button callback, you can takeMVar timer >> putMVar timer 0 to reset the timer.

Resources