diff --git a/App/Widgets/GtkMouseKeyboard.hs b/App/Widgets/GtkMouseKeyboard.hs new file mode 100644 --- /dev/null +++ b/App/Widgets/GtkMouseKeyboard.hs @@ -0,0 +1,69 @@ +-- | Gtk mouse keyboard widget. +-- +-- For a mouse button press or release, add events named SingleClick or ClickRelease respectively to the bus. +-- For this widget, all events have source \"KeyboardMouseWidget\", and group \"Mouse\" +-- Additionally, the data attached to the event follows the form [EString SingleClick|ClickRelease, EDouble x, EDouble y, EStringL [Gtk modifier names]] +-- +-- For a keyboard press or release, add events named KeyDown or KeyUp respectively to the bus. +-- All keyboard events have group ''Keyboard'' and source ''WidgetName.KeyboardMouseWidget'' +-- Additionally, the data attached to a keyboard event follows the form [EString keyName | EChar keyChar, EStringL [Gtk modifier names]] +-- +-- For a tablet proximity, add events named \"Proximity\" with source WidgetName.KeyboardMouseWidget, group \"Mouse\" and with attached data +-- [EBool True] for the tablet is in proximity and [EBool False] for the tablet is out of proximity. +-- +-- For mouse motion, add events named \"Position\" with group \"Mouse\" and attached data [EDouble x, EDouble y, EStringL modifiers] +-- +module App.Widgets.GtkMouseKeyboard where + +import Control.Applicative +import Control.Concurrent +import Data.Maybe +import qualified Graphics.UI.Gtk as Gtk +import qualified Graphics.UI.Gtk.Gdk.Events as Gtk +import App.EventBus + +-- Gtk's button click event system is annoying, so we're ignoring it and only bothering with the single clicks. +-- when we receive a click, fire off a thread (once) that waits for 100ms to see how many clicks we get total in that time. Then fire off that number. +buttonHandler _ _ (Gtk.Button _ Gtk.DoubleClick _ _ _ _ _ _ _) = return True +buttonHandler _ _ (Gtk.Button _ Gtk.TripleClick _ _ _ _ _ _ _) = return True +buttonHandler wname b (Gtk.Button sent click time x y modifiers button _ _) = do + produce' "Mouse" (wname ++ ".KeyboardMouseWidget") (show click) once [EAssocL [("button", EString . show $ button) + ,("coords", EDoubleL [x,y]) + ,("modifiers", EStringL . map show $ modifiers)]] b + return True + +scrollWheelHandler wname b (Gtk.Scroll _ _ x y direction _ _) = do + produce' "Mouse" (wname ++ ".KeyboardMouseWidget") (show direction) once [EDouble x, EDouble y] b + return True + +keyboardHandler wname b (Gtk.Key released sent time modifiers withCapsLock withNumLock withScrollLock keyVal keyName keyChar) = do + produce' "Keyboard" (wname ++ "KeyboardMouseWidget") (if released then "KeyUp" else "KeyDown") once + [EAssocL [("key", fromMaybe (EString . show $ keyName) (EChar <$> keyChar)) + ,("modifiers", EStringL . map show $ modifiers)]] b + return False + +motionHandler wname w b evt = do + produce' "Mouse" (wname ++ ".KeyboardMouseWidget") "Position" once [EAssocL [("coords", EDoubleL [Gtk.eventX evt, Gtk.eventY evt]) + ,("modifiers", EStringL . map show . Gtk.eventModifier $ evt)]] b + dwin <- Gtk.widgetGetDrawWindow w + Gtk.drawWindowGetPointer dwin + return False + +proximityHandler wname b evt = do + produce' "Mouse" (wname ++ ".KeyboardMouseWidget") "Proximity" once [EBool . Gtk.eventInContact $ evt] b + return False + +-- | Bind a keyboard mouse widget to the given Gtk widget. Se module documentation for description of events. +bindMouseKeyboardWidget :: Gtk.Widget -> Widget [EData a] +bindMouseKeyboardWidget w b = do + ref <- newEmptyMVar + wname <- Gtk.widgetGetName w + Gtk.onButtonPress w (buttonHandler wname b) + Gtk.onButtonRelease w (buttonHandler wname b) + Gtk.onScroll w (scrollWheelHandler wname b) + Gtk.onKeyPress w (keyboardHandler wname b) + Gtk.onKeyRelease w (keyboardHandler wname b) + Gtk.onMotionNotify w True (motionHandler wname w b) + Gtk.onProximityIn w (proximityHandler wname b) + Gtk.onProximityOut w (proximityHandler wname b) + return () diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,6 @@ +#!/usr/bin/runhaskell +> module Main where +> import Distribution.Simple +> main :: IO () +> main = defaultMain + diff --git a/buster-gtk.cabal b/buster-gtk.cabal new file mode 100644 --- /dev/null +++ b/buster-gtk.cabal @@ -0,0 +1,56 @@ +name: buster-gtk +version: 1.0 +cabal-version: -any +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: 2009 Renaissance Computing Institute +maintainer: Jeff Heard +build-depends: buster >= 1.0, gtk -any, binary -any, parsec >=3.0.0, pretty -any, mtl -any, bytestring -any, base -any, containers -any, time -any, old-locale -any, dataenc -any +stability: Experimental +homepage: http://vis.renci.org/jeff/buster +package-url: +bug-reports: +synopsis: Almost but not quite entirely unlike FRP +description: Buster is best described by the following blog post: http:\/\/vis.renci.org\/jeff\/2009\/03\/31\/almost-but-not-quite-entirely-like-frp\/ + . + It is an engine for orchestrating large, complex, and multifaceted applications by couching them in terms of time, events, a bus, + behaviours, and widgets. Time is continuous and infininte. Events are discrete and exist for a particular time. The bus is a + discrete sample of time made available to behaviours. Behaviours are continuous and exist for all time, but sample time via + the bus. They filter Events to determine what is on the bus at future times. Widgets are input-only objects that sample the + outside world and assign events to discrete portions of time. + . + Buster is designed to be flexible, with a flexible event model and the ability to add custom data to events, and designed to be + high performance. It is simple to integrate with Gtk while at the same time able to handle other kinds of resources, like files + and sockets. +category: FRP +author: Jeff Heard +tested-with: +data-files: +data-dir: "" +extra-source-files: +extra-tmp-files: +exposed-modules: App.Widgets.GtkMouseKeyboard +exposed: True +buildable: True +build-tools: +cpp-options: +cc-options: +ld-options: +pkgconfig-depends: +frameworks: +c-sources: +extensions: +extra-libraries: +extra-lib-dirs: +includes: +install-includes: +include-dirs: +hs-source-dirs: . +other-modules: +ghc-prof-options: +ghc-shared-options: +ghc-options: +hugs-options: +nhc98-options: +jhc-options: