Add hotkeys
This commit is contained in:
parent
bef0c9afe8
commit
b5a7b7d507
13
Main.hs
13
Main.hs
@ -1,3 +1,4 @@
|
|||||||
|
import Control.Monad.IO.Class
|
||||||
import Diagram
|
import Diagram
|
||||||
import Diagrams.Prelude
|
import Diagrams.Prelude
|
||||||
import Diagrams.Backend.Cairo
|
import Diagrams.Backend.Cairo
|
||||||
@ -57,6 +58,18 @@ main = do
|
|||||||
da
|
da
|
||||||
_ <- onClicked saveButton $ onClickedSaveButton fileButton
|
_ <- onClicked saveButton $ onClickedSaveButton fileButton
|
||||||
_ <- onClicked quitButton mainQuit
|
_ <- onClicked quitButton mainQuit
|
||||||
|
_ <- window `on` keyPressEvent $ tryEvent $ do
|
||||||
|
[Control] <- eventModifier
|
||||||
|
"q" <- eventKeyName
|
||||||
|
liftIO $ mainQuit
|
||||||
|
_ <- window `on` keyPressEvent $ tryEvent $ do
|
||||||
|
[Control] <- eventModifier
|
||||||
|
"s" <- eventKeyName
|
||||||
|
liftIO $ onClickedSaveButton fileButton
|
||||||
|
_ <- window `on` keyPressEvent $ tryEvent $ do
|
||||||
|
[Control] <- eventModifier
|
||||||
|
"d" <- eventKeyName
|
||||||
|
liftIO $ onClickedDrawButton fileButton da
|
||||||
|
|
||||||
-- draw widgets and start main loop
|
-- draw widgets and start main loop
|
||||||
widgetShowAll window
|
widgetShowAll window
|
||||||
|
Loading…
Reference in New Issue
Block a user