How can I set an action to occur on a key release in xmonad?
I don't like menu bars and panels.
Instead of a panel like xmobar I want to have a full screen page of info, (time, currently selected window and workspace etc) appear when I hold down a key combo and then vanish when I let the keys go.
I could code the info page application myself.
I can set the info page to spawn on a key press.
I can not set anything to happen on a key release.
How can I set an action to occur on a key release?
I am considering extending xmonad myself to do this.
I hope I don't have to though because it'd be really annoying.
XMonad passes all received events, including KeyPress events, to the handleEventHook, so this code would be able to react on keyRelease events:
module KeyUp where
import Data.Monoid
import qualified Data.Map as M
import XMonad
import Control.Monad
keyUpEventHook :: Event -> X All
keyUpEventHook e = handle e >> return (All True)
keyUpKeys (XConf{ config = XConfig {XMonad.modMask = modMask} }) = M.fromList $
[ ((modMask, xK_v), io (print "Hi")) ]
handle :: Event -> X ()
handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
| t == keyRelease = withDisplay $ \dpy -> do
s <- io $ keycodeToKeysym dpy code 0
mClean <- cleanMask m
ks <- asks keyUpKeys
userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
handle _ = return ()
You would use it like that in your xmonad.hs file:
handleEventHook = handleEventHook defaultConfig `mappend`
keyUpEventHook `mappend`
fullscreenEventHook
Unfortunately, this does not work yet: It will only react on KeyRelease events that have a corresponding entry in the regular keys configuration. This is due to grayKeys in XMonad.Main, grabbing only keys mentioned in keys. You can work-around this by defining a dummy action for every combination that you want to handle in KeyUp:
myKeys conf#(XConfig {XMonad.modMask = modMask}) = M.fromList $
...
, ((modMask , xK_v ), return ())
myStartupHook :: X ()
myStartupHook = do
XConf { display = dpy, theRoot = rootw } <- ask
myKeyCode <- io $ (keysymToKeycode dpy xK_Super_R)
io $ grabKey dpy (myKeyCode) anyModifier rootw True grabModeAsync grabModeAsync
spawn "~/ScriptsVcs/hideTint2.sh"
myHook :: Event -> X All
myHook e = do
case e of
ke#(KeyEvent _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) -> do
if ev_keycode ke == 134
then if ev_state ke == 0
then do
-- key has been pressed
spawn "~/ScriptsVcs/showTint2.sh"
else do
spawn "~/ScriptsVcs/hideTint2.sh"
else pure ()
_ -> pure ()
pure $ All True
The above is an example. Do take note that a 'key release' could occur with a modifier key (ev_state).
Related
Suppose:
The events are A perceived, B perceived or Ping perceived.
A possible sequence of events could be A,A,A,B,Ping.
The states are InA, InB, PingMissing.
The rules are
No Ping in all events -> PingMissing.
A -> InA
B -> InB
(Only Ping events -> InA)
I would like to have one recommended action/ state.
I see three possibilities for the transition function f(s,e)->s:
Create a pseudo event likePingMissing perceived. Hence everything is in one function.
Two separate transition functions and combining the result.
One transition function with two states as a tuple and combining the result.
Any thoughts? Best practices?
Implementation of 2. in F# (language doesn't really matter):
type Event =
| A
| B
| Ping
type State1 =
| InA
| InB
type State2 =
| PingReceived
| PingMissing
type StateCombined =
| InA'
| InB'
| PingMissing'
let f1 s e :State1 =
match s,e with
| _, A -> InA
| _, B -> InB
| _, _ -> s
let f2 s e :State2 =
match s,e with
| _, Ping -> PingReceived
| _, _ -> s
let fCombined events =
let finalState1 = events |> Seq.fold f1 InA
let finalState2 = events |> Seq.fold f2 PingMissing
match finalState1, finalState2 with
| _, PingMissing -> PingMissing'
| InA, _ -> InA'
| InB, _ -> InB'
fCombined [A;A;A;B]
// PingMissing'
fCombined [A;A;A;B;Ping]
// InB'
I would tend to model the unified state as a tuple of the two substates (broadly in this case: "has a ping been received" and "if a ping has been received, was the last perception an A or a B"). A convenience function can then distill that into a recommendation.
This has the advantage of not reusing the sequence of events, so is a bit more compatible with a view of the events as a stream: at the very least this results in not having to refetch the events from an event store or keep the entire sequence of events in memory.
For example, in Scala (and explicitly modeling the situation where no A nor B has been perceived yet):
sealed trait Event
case object A extends Event
case object B extends Event
case object Ping extends Event
sealed trait PingState
case object PingReceived extends Event // Don't strictly need...
case object PingMissing extends Event
sealed trait LastPerceivedState
case object InA extends Event
case object InB extends Event
// ... could just as well be (Option[PingMissing], Option[LastPerceivedState])...
type State = (PingState, Option[LastPerceivedState])
// ... in which case, this is (Some(PingMissing), None)
val InitialState = PingMissing -> None
def distilledState(state: State): Either[PingMissing, Option[LastPerceivedState]] =
state match {
case (PingMissing, _) => Left(PingMissing)
case (_, lpsOpt) => Right(lpsOpt)
}
The transition function could then be written directly (taking advantage of the fact that the events can be partitioned into events which affect PingState or LastPerceivedState but never both):
val transitionF = { (state: State, evt: Event) =>
val (ps, lpsOpt) = state
evt match {
case A => ps -> Some(InA)
case B => ps -> Some(InB)
case Ping => PingReceived -> lpsOpt
}
}
In the event that there are events which affect both, then decomposing into subhandlers might simplify the code (at the expense of some possibly redundant invocations):
val pingStateTransition = { (ps: PingState, evt: Event) =>
if (ps == PingReceived) PingReceived
else if (evt == Ping) PingReceived
else ps
}
val lastPerceivedStateTransition = { (lpsOpt: Option[LastPerceivedState], evt: Event) =>
evt match {
case A => Some(InA)
case B => Some(InB)
case _ => lpsOpt
}
}
val transitionF = { (state: State, evt: Evt) =>
pingStateTransition(state._1, evt) -> lastPerceivedStateTransition(state._2, evt)
}
I'm new to Fabulous and MUV model, and I'm trying to implement application that works with BLE. I'm also a bit new to F#, mostly worked with erlang and C# in the past, so a bit lost with external events processing. CrossBluetoothLE.Current.Adapter has DeviceDiscovered event handler (IEvent). What's the most correct way of linking this event handler to the Fabulous update function?
E.g. after I will call CrossBluetoothLE.Current.Adapter.StartScanningForDevicesAsync(), I want that this event handler supply newly discovered devices to the update function.
And if I will do something like this (this is not working):
type MyApp () as app =
inherit Application ()
let deviceDiscovered dispatch =
CrossBluetoothLE.Current.Adapter.DeviceDiscovered.Subscribe (fun x -> dispatch (App.Msg.Discovered x.Device) )
let runner =
App.program
|> Program.withConsoleTrace
|> Program.withSubscription (fun _ -> Cmd.ofSub deviceDiscovered)
|> XamarinFormsProgram.run app
if it works, it will be ok for device discovery because CrossBluetoothLE.Current.Adapter is static. However after device will be discovered, I will need to work with (e.g. receive notifications or replies from it), and it will not be possible to include dynamic device handler into Program.withSubscription.
Not sure whether the Fabulous is applicable here.
Ok, I was able to find some solution and it works now, but the overall architecture looks a bit weird. So generic approach is to create an external mailbox, that will dispatch messages to the MUV loop.
Describe all messages of the MUV in the external module, e.g.:
type Msg =
| Scan
| Discovered of IDevice
| Connect of IDevice
| ClockMsg of System.DateTime
| TextMsg of string
Create type that encapsulates mailbox:
type DispatchFunc = Msgs.Msg -> unit
type State =
| Initialized of DispatchFunc
| NotInitialized
type Mail =
| Dispatch of DispatchFunc
| Msg of Msgs.Msg
| None
let rand = System.Random()
let id = rand.NextDouble()
let postbox = MailboxProcessor.Start(fun inbox ->
let rec messageLoop (state:State) = async{
let! mail = inbox.Receive()
let new_state =
match mail with
| None ->
state
| Msg msg ->
match state with
| NotInitialized -> NotInitialized
| Initialized df ->
df msg
state
| Dispatch df ->
Initialized df
return! messageLoop (new_state)
}
messageLoop (NotInitialized))
let post(o) =
postbox.Post o
Here, mailbox starts with NotInitialized state and wait while application will start. When everything is done, mailbox received dispatch function, that will be used in further dispatching of the external messages to the MUV main loop.
Pass dispatch handler to the mailbox:
type MyApp () as app =
inherit Application ()
// generate initial events + start threads + pass dispatch reference to the mailbox
let initThreads dispatch =
// init & start external (e.g. bluetooth receiver) threads here
// or start them asynchronously from MUV loop
Postbox.post (Postbox.Dispatch dispatch)
()
let runner =
App.program
|> Program.withConsoleTrace
|> Program.withSubscription (fun _ -> Cmd.ofSub initThreads)
|> XamarinFormsProgram.run app
So now, if you want to send event to the MUV from external thread, just start it inside initThreads (or, e.g. from within MUV loop) and use something like: Postbox.post (Postbox.Msg (Msgs.TextMsg "It works!")).
E.g. for my purposes (BLE discovery) it will look like this:
let update msg model =
match msg with
| Msgs.Scan ->
CrossBluetoothLE.Current.Adapter.StopScanningForDevicesAsync() |> Async.AwaitTask |> ignore
CrossBluetoothLE.Current.Adapter.DeviceDiscovered.Subscribe (
fun (a) ->
Postbox.post (Postbox.Msg (Msgs.Discovered a.Device))
()
) |> ignore
CrossBluetoothLE.Current.Adapter.StartScanningForDevicesAsync() |> Async.AwaitTask |> ignore
model, Cmd.none
| Msgs.ClockMsg msg ->
{ model with label = msg.ToString() }, Cmd.none
| Msgs.TextMsg msg ->
{ model with label = msg }, Cmd.none
| Msgs.Discovered d ->
{ model with gattDevices = d::model.gattDevices; label = "Discovered " + d.ToString() }, Cmd.none
| Msgs.Connect d -> { model with connectedDevice = d }, Cmd.none
This is for sure a very ugly solution, but I wasn't able to imagine something more beautiful :(.
I have a Haskell application which uses optparse-applicative library for CLI arguments parsing. My data type for CLI arguments contains FilePaths (both files and directories), Doubles and etc. optparse-applicative can handle parse errors but I want to ensure that some files and some directories exist (or don't exist), numbers are >= 0 and etc.
What can be done is an implementation of a bunch of helper functions like these ones:
exitIfM :: IO Bool -> Text -> IO ()
exitIfM predicateM errorMessage = whenM predicateM $ putTextLn errorMessage >> exitFailure
exitIfNotM :: IO Bool -> Text -> IO ()
exitIfNotM predicateM errorMessage = unlessM predicateM $ putTextLn errorMessage >> exitFailure
And then I use it like this:
body :: Options -> IO ()
body (Options path1 path2 path3 count) = do
exitIfNotM (doesFileExist path1) ("File " <> (toText ledgerPath) <> " does not exist")
exitIfNotM (doesDirectoryExist path2) ("Directory " <> (toText skKeysPath) <> " does not exist")
exitIfM (doesFileExist path3) ("File " <> (toText nodeExe) <> " already exist")
exitIf (count <= 0) ("--counter should be positive")
This looks too ad-hoc and ugly to me. Also, I need similar functionality for almost every application I write. Are there some idiomatic ways to deal with this sort of programming pattern when I want to do a bunch of checks before actually doing something with data type? The less boilerplate involved the better it is :)
Instead of validating the options record after it has been constructed, perhaps we could use applicative functor composition to combine argument parsing and validation:
import Control.Monad
import Data.Functor.Compose
import Control.Lens ((<&>)) -- flipped fmap
import Control.Applicative.Lift (runErrors,failure) -- form transformers
import qualified Options.Applicative as O
import System.Directory -- from directory
data Options = Options { path :: FilePath, count :: Int } deriving Show
main :: IO ()
main = do
let pathOption = Compose (Compose (O.argument O.str (O.metavar "FILE") <&> \file ->
do exists <- doesPathExist file
pure $ if exists
then pure file
else failure ["Could not find file."]))
countOption = Compose (Compose (O.argument O.auto (O.metavar "INT") <&> \i ->
do pure $ if i < 10
then pure i
else failure ["Incorrect number."]))
Compose (Compose parsy) = Options <$> pathOption <*> countOption
io <- O.execParser $ O.info parsy mempty
errs <- io
case runErrors errs of
Left msgs -> print msgs
Right r -> print r
The composed parser has type Compose (Compose Parser IO) (Errors [String]) Options. The IO layer is for performing file existence checks, while Errors is a validation-like Applicative from transformers that accumulates error messages. Running the parser produces an IO action that, when run, produces an Errors [String] Options value.
The code is a bit verbose but those argument parsers could be packed in a library and reused.
Some examples form the repl:
Λ :main "/tmp" 2
Options {path = "/tmp", count = 2}
Λ :main "/tmpx" 2
["Could not find file."]
Λ :main "/tmpx" 22
["Could not find file.","Incorrect number."]
Here is my source code I'm trying to get to work:
In Main.hs:
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Bindings
import Data.IORef
main = do
(progname,_) <- getArgsAndInitialize
createWindow "Hello World"
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboardMouse
angle <- newIORef 0.0
displayCallback $= display
idleCallback $= Just idle
mouseWheelCallback $= Just mouseWheel
mainLoop
In Bindings.hs:
module Bindings where
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
display :: IO ()
display = return ()
overlayDisplay :: IO ()
overlayDisplay = return ()
visibility :: Visibility -> IO ()
visibility v = return ()
reshape :: Size -> IO ()
reshape s#(Size w h) = do
viewport $= (Position 0 0, s)
close :: IO ()
close = return ()
keyboardMouse :: Key -> KeyState -> Modifiers -> Position -> IO ()
keyboardMouse key state modifiers position = return ()
mouseWheel :: WheelNumber -> WheelDirection -> Position -> IO ()
mouseWheel wn wd p = return ()
idle :: IO ()
idle = return ()
It works if I use normal glut32.dll and none of the freeglut extensions in my code, but I want to use the freeglut extensions.
When I use freeglut.dll, rename it to glut32.dll, and put it in the same folder as my .exe, it gives me the error:
main: user error (unknown GLUT entry glutInit)
When I use the normal glut32.dll in the same way I get the error:
main: user error (unknown GLUT entry glutMouseWheelFunc)
download glut from http://www.transmissionzero.co.uk/software/freeglut-devel/. Be sure to download the MinGW version.
copy the file freeglut-MinGW-3.0.0-1.mp.zip\freeglut\bin\x64\freeglut.dll to C:\Windows\System32. Make sure you get the 64 bit version from the x64 folder.
rename it as glut32.dll
I just solved this problem and hope this could help others.
You have to use freeglut .lib/.dll from Mingw or compile it yourself.
I am trying to convert a Haskell program to a Haskell GUI program,
but since I am very very new at Haskell,
every time I try something I get lots of errors.
I asked on Stack Overflow many time for this program,
but whenever an error disappears, two errors arise.
Sorry for asking similar question, but
the program's ability what I intend to convert is
very simple word searching.
Receive input string, search the word, print on window.
Any advice, hint or example would be very helpful for me.
I am on Windows XP. Sorry for very poor code.
--GUI routine
import Graphics.UI.Gtk
import Text.Regex.Posix ((=~))
import Control.Monad (when)
--core routine
matchWord :: String -> String -> Int
matchWord file word = length . filter (== word) . concat $ file =~ "[^- \".,\n]+"
--main start
main :: IO ()
main =
do initGUI
win <- windowNew
windowSetTitle win "WORD SEARCHER"
win `onDestroy` mainQuit
fch <- fileChooserWidgetNew FileChooserActionOpen
containerAdd win fch
targetFile <- fileChooserGetFilename fch --wrong?
ent <- entryNew
btn <- buttonNewWithLabel "Click to search"
st <- labelNew $ Just "Found : 0 "
col <- vBoxNew False 5
containerAdd col ent
containerAdd col btn
containerAdd col st
btn `onClicked` do targetWord <- entryGetText ent
fileData <- readFile Just targetFile
found <- matchWord fileData targetWord
labelSetText st found
containerAdd win col
widgetShowAll win
mainGUI
thank you for reading
This will get you started.
targetFile <- fileChooserGetFilename fch
At this point, targetFile has type Maybe String; that is, it will return either Just "somestring" or Nothing. You want the "somestring" part, if it's available. You can get it by pattern matching:
Just targetFile <- fileChooserGetFilename fch
This will fail with an opaque error message if the result of fileChooserGetFilename returned Nothing. For more robustness you can case analyse the result:
maybeTargetFile <- fileChooserGetFilename fch
targetFile <- case maybeTargetFile of
Nothing -> fail "I need a filename!"
Just file -> return file
The other problem is in this line:
found <- matchWord fileData targetWord
x <- m is used to bind the result of an action m into the variable x, but matchWord returns an Int, not an action (eg. IO a for some a).