Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
517 lines (432 sloc) 23.3 KB
{-# LANGUAGE TypeSynonymInstances, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O0 #-}
-- |
-- Module : App.DebugEventBus
-- Copyright : (c) Renaissance Computing Institute 2009
-- License : BSD3
--
-- Not exactly the FRP model, but rather a model of a large application with
-- heterogenous data and many inputs and outputs. An application is in its
-- essence a collection of widgets and behaviours and events with a bus.
-- The bus holds events and manages the event timeline. Behaviours and
-- widgets are continuous. Widgets applied to the bus make insertions and
-- never deletions. Behaviours applied to the bus make insertions and deletions.
--
-- Behaviours are composable using combinators that set one Behaviour as either
-- behind, in front, or beside another behaviour on the bus. The in front and
-- behind combinators establish that the behaviour "behind" the others
-- sees the results of the other behaviours' application to the bus. The beside
-- combinator says that the combinators see the same bus.
--
module App.DebugEventBus where
import Control.Applicative
import Control.Concurrent
import Control.Monad
import Data.Maybe
import Data.List (foldl', foldl1')
import Data.Monoid
import qualified Data.Set as Set
import Data.Time.Clock
import Data.Time.Format
import System.Locale
import qualified Data.Map as Map
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import System.IO.Unsafe
import System.IO
import Debug.Trace
-- generic functions for key ordering. move somewhere else later
EQ />/ b = b
a />/ _ = a
a /</ EQ = a
_ /</ b = b
g %=> f = f `on` g
on f g a b = f (g a) (g b)
-- IO version of the <* Applicative operator
a =<<^ b = \m -> b >> a m
data BusIterationChanges =
Deleted String String String String String
| Inserted String String String String String
| Click
deriving (Eq,Show,Read)
-- | Defines the amount of time that an event exists.
data TimeSpan =
Persistent -- ^ The event exists forever
| Time DiffTime -- ^ The event exists for a specified amount of real time
| Iterations Int -- ^ The event exists for a certain number of samples of time from its inception.
deriving (Eq,Ord,Show)
seconds :: Integer -> TimeSpan
seconds = Time . secondsToDiffTime
minutes :: Integer -> TimeSpan
minutes = Time . secondsToDiffTime . (60*)
hours :: Integer -> TimeSpan
hours = Time . secondsToDiffTime . (3600*)
days :: Integer -> TimeSpan
days = Time . secondsToDiffTime . (86400*)
once :: TimeSpan
once = Iterations 1
-- | Defines time in terms of the differences from time t0 to the next instant. This is the type
-- returned by Behaviours to describe time directly after the Behaviour.
data Diff a =
Insertion (Event a) -- ^ Time t1 contains all events at time t0 plus this event.
| Deletion (Event a) -- ^ Time t1 contains all events at time t0 minus this event.
| InstrumentedBehaviour String
instance Show (Diff a) where
show (Insertion a) = show ("Insertion",group a, src a, ename a, timespan a)
show (Deletion a) = show ("Deletion",group a, src a, ename a, timespan a)
-- | Defines the data attachable to events.
data EData a =
EString String
| EByteString B.ByteString
| EByteStringL [B.ByteString]
| ELByteString LB.ByteString
| ELByteStringL [LB.ByteString]
| EChar Char
| EDouble Double
| EInt Int
| EBool Bool
| EStringL [String]
| EDoubleL [Double]
| EIntL [Int]
| EBoolL [Bool]
| EOther a
| EAssoc (String,EData a)
| EAssocL [(String,EData a)]
| EOtherL [a]
deriving (Eq, Show, Read)
fromEString (EString a) = a
fromEByteString (EByteString a) = a
fromEByteStringL (EByteStringL a) = a
fromELByteString (ELByteString a) = a
fromELByteStringL (ELByteStringL a) = a
fromEChar (EChar a) = a
fromEDouble (EDouble a) = a
fromEInt (EInt a) = a
fromEBool (EBool a) = a
fromEStringL (EStringL a) = a
fromEDoubleL (EDoubleL a) = a
fromEIntL (EIntL a) = a
fromEBoolL (EBoolL a) = a
fromEOther (EOther a) = a
fromEAssoc (EAssoc a) = a
fromEAssocL (EAssocL a) = a
fromEOtherL (EOtherL a) = a
-- | Show without risking running into an unshowable type.
safeShow :: Maybe Int -> EData a -> String
safeShow n (EString s) = maybe s ((flip take) s) n
safeShow n (EStringL s) = maybe (show s) ((flip take) (show s)) n
safeShow n (EByteString _) = "ByteString data"
safeShow n (EByteStringL _) = "ByteString list data"
safeShow n (EChar c) = [c]
safeShow n (EDouble x) = maybe (show x) ((flip take) (show x)) n
safeShow n (EDoubleL x) = maybe (show x) ((flip take) (show x)) n
safeShow n (EInt x) = maybe (show x) ((flip take) (show x)) n
safeShow n (EIntL x) = maybe (show x) ((flip take) (show x)) n
safeShow n (EBool x) = maybe (show x) ((flip take) (show x)) n
safeShow n (EBoolL x) = maybe (show x) ((flip take) (show x)) n
safeShow n (EAssoc (x,y)) = x ++ " -> " ++ safeShow n y
safeShow n (EAssocL xs) = concat $ (\(a,b) -> "(" ++ a ++ " -> " ++ safeShow n b ++ ")\n" ) <$> xs
safeShow n (EOther _) = "Other data"
safeShow n (EOtherL _) = "Other data list"
-- | An discrete event in time
data Event a = Event
{ ename :: String -- ^ The unique name of an event. Group + src + name = the fully qualified name FQN of the event.
, group :: String -- ^ The group of an event.
, timespan :: TimeSpan -- ^ The timespan from "time" that an event exists.
, eventdata :: a -- ^ The data attached to the event.
, src :: String -- ^ The behaviour or widget that assigned the event to time.
, time :: UTCTime } -- ^ The time of the event's inception.
instance Ord (Event a) where
compare l r = ((src %=> compare) l r) />/
((group %=> compare) l r) />/
((ename %=> compare) l r)
instance Eq (Event a) where
x == y = (ename %=> (==)) x y &&
(group %=> (==)) x y &&
(src %=> (==)) x y
-- | The type of a discrete sample of continuous time.
data Bus a = Bus
{ nameMap :: Map.Map String (Set.Set (Event a)) -- ^ The map of just Event.name to events.
, srcMap :: Map.Map String (Set.Set (Event a)) -- ^ The map of just Event.src to events.
, groupMap :: Map.Map String (Set.Set (Event a)) -- ^ The map of just Event.group to events.
, fullyQualifiedMap :: Map.Map (String,String,String) (Event a) -- ^ The map of FQNs to events.
, currentProducerConsumer :: Maybe String
, debugout :: Handle }
instance Show (Bus a) where
show = concat . map showQName . Map.elems . fullyQualifiedMap
showQName ev = show (group ev, src ev, ename ev, timespan ev)
eventsByName :: String -> Bus a -> Set.Set (Event a)
eventsByName n = fromMaybe Set.empty . Map.lookup n . nameMap
eventsBySource :: String -> Bus a -> Set.Set (Event a)
eventsBySource s = fromMaybe Set.empty . Map.lookup s . srcMap
eventsByGroup :: String -> Bus a -> Set.Set (Event a)
eventsByGroup g = fromMaybe Set.empty . Map.lookup g . groupMap
eventByQName:: String -> String -> String -> Bus a -> Maybe (Event a)
eventByQName g s n = Map.lookup (g,s,n) . fullyQualifiedMap
eventsFor (Just g) Nothing Nothing b = eventsByGroup g b
eventsFor Nothing (Just s) Nothing b = eventsBySource s b
eventsFor Nothing Nothing (Just n) b = eventsByName n b
eventsFor (Just g) (Just s) (Just n) b = maybe Set.empty (Set.singleton) (eventByQName g s n b)
eventsFor g s n b = persection gset . persection sset $ nset
where gset = fromMaybe Set.empty $ (flip eventsByGroup) b <$> g
sset = fromMaybe Set.empty $ (flip eventsBySource) b <$> s
nset = fromMaybe Set.empty $ (flip eventsByName) b <$> n
persection a b | a == Set.empty = b
| b == Set.empty = a
| otherwise = Set.intersection a b
filteredEventsFor (Left g) (Right sfilter) (Right nfilter) b = filter nfilter . filter sfilter . Set.toList $ eventsByGroup g b
filteredEventsFor (Right gfilter) (Left s) (Right nfilter) b = filter gfilter . filter nfilter . Set.toList $ eventsBySource s b
filteredEventsFor (Right gfilter) (Right sfilter) (Left n) b = filter gfilter . filter sfilter . Set.toList $ eventsByName n b
filteredEventsFor (Left g) (Left s) (Left n) b = maybe [] (\a -> [a]) (eventByQName g s n b)
filteredEventsFor (Right gfilter) (Right sfilter) (Right nfilter) b = filter gfilter . filter sfilter . filter nfilter . map snd . Map.toList . fullyQualifiedMap $ b
filteredEventsFor (Right gfilter) (Left s) (Left n) b = filter gfilter . Set.toList$ eventsFor Nothing (Just s) (Just n) b
filteredEventsFor (Left g) (Right sfilter) (Left n) b = filter sfilter . Set.toList $ eventsFor (Just g) Nothing (Just n) b
filteredEventsFor (Left g) (Left s) (Right nfilter) b = filter nfilter . Set.toList $ eventsFor (Just g) (Just s) Nothing b
topEvent = head . Set.toList
instance Monoid (Bus a) where
mempty = emptyBus
mappend (Bus n0 s0 g0 f0 cpc h) (Bus n1 s1 g1 f1 _ _) = Bus (Map.union n0 n1) (Map.union s0 s1) (Map.union g0 g1) (Map.union f0 f1) cpc h
-- | The empty bus
emptyBus :: Bus a
emptyBus = Bus Map.empty Map.empty Map.empty Map.empty Nothing $! (unsafePerformIO $ openFile "buster.evtprof" WriteMode)
-- | Add an event to time within the bus
addEvent :: Event a -> Bus a -> Bus a
addEvent edata b = b{ nameMap = Map.insertWith (Set.union) (ename edata) (singleton edata) (nameMap b)
, srcMap = Map.insertWith (Set.union) (src edata) (singleton edata) (srcMap b)
, groupMap = Map.insertWith (Set.union) (group edata) (singleton edata) (groupMap b)
, fullyQualifiedMap = Map.insert (group edata, src edata, ename edata) edata (fullyQualifiedMap b) }
-- | The type of widgets.
-- A widget is an input-only way to assign Events to time. A mouse is a widget. A keyboard is a
-- widget. A webcam is a widget, and so on.
type Widget a = MVar (Bus a) -> IO ()
-- | The type of future events..
-- A behaviour doesn't know about the time that it assigns events, only that they exist
-- at some point after the time that the Behaviour sampled.
type Future a = IO (Bus a, MVar [Diff a])
-- | An IO action sometime in the future.
future :: Bus a -> IO [Diff a] -> Future a
future b thunk = do
ref <- newEmptyMVar
forkIO $ thunk >>= putMVar ref
return (b,ref)
-- | Obtain the final value of a Future. Blocks until the value is available
immediate = takeMVar
-- | The type of a Behaviour. A behaviour maps the bus to a list of differences to apply to the bus
-- before the next Behaviour's sample of time.
type Behaviour a = Bus a -> Future a
instance Monoid (Behaviour a) where
mempty = passthrough
mappend = (>~>) -- x behind y
-- | The null Behaviour. Samples the bus and adds and deletes nothing.
passthrough :: Behaviour a
passthrough a = future a (return [])
-- | the in front of behaviour combinator. behaviour 1 is in front of behaviour 0, so behavour 0 will see the bus filtered through behaviour 1
(<~<) :: Behaviour a -> Behaviour a -> Behaviour a
behaviour1 <~< behaviour0 = \m -> behaviour0 m >>= applyDiff >>= behaviour1
-- | the behind behaviour combinator. behaviour 0 is behind behaviour 1, so behaviour 0 will see the bus filtered through behaviour 1
(>~>) :: Behaviour a -> Behaviour a -> Behaviour a
behaviour0 >~> behaviour1 = \m -> behaviour0 m >>= applyDiff >>= behaviour1
-- | the beside behaviour combinator. All behaviours that are side-by-side see the same bus.
(|~|) :: Behaviour a -> Behaviour a -> Behaviour a
behaviour0 |~| behaviour1 = \m -> future m $ do
(_,mv0) <- behaviour0 m
(_,mv1) <- behaviour1 m
value0 <- takeMVar mv0 -- :: IO [Diff a]
value1 <- takeMVar mv1 -- :: IO [Diff a]
return $ value0 ++ value1
behind = (>~>)
beside = (|~|)
infrontof = (<~<)
applyDiff (m,ds) = do
ds' <- immediate ds
now <- formatTime defaultTimeLocale "%H:%M:%S%Q" <$> getCurrentTime
(foldM (busDiff now) m $ ds') >>= \b -> return b{ currentProducerConsumer = Nothing }
where busDiff now b (Insertion ev) = do maybe (return ()) (\cpc -> hPutStr (debugout b) (show $ Inserted cpc (group ev) (src ev) (ename ev) now )) (currentProducerConsumer b)
return b{ nameMap = Map.insertWith (union') (ename ev) (singleton ev) (nameMap b)
, srcMap = Map.insertWith (union') (src ev) (singleton ev) (srcMap b)
, groupMap = Map.insertWith (union') (group ev) (singleton ev) (groupMap b)
, fullyQualifiedMap = Map.insert (group ev, src ev, ename ev) ev (fullyQualifiedMap b) }
busDiff now b (Deletion ev) = do maybe (return ()) (\cpc -> hPutStr (debugout b) (show $ Deleted cpc (group ev) (src ev) (ename ev) now)) (currentProducerConsumer b)
return b { nameMap = deleteOneFrom ev (ename ev) (nameMap b)
, srcMap = deleteOneFrom ev (src ev) (srcMap b)
, groupMap = deleteOneFrom ev (group ev) (groupMap b)
, fullyQualifiedMap = Map.delete (group ev, src ev, ename ev) (fullyQualifiedMap b) }
busDiff now b (InstrumentedBehaviour bname) = return b{ currentProducerConsumer = Just bname }
deleteOneFrom ev key mp = case Map.lookup key mp of
Just eset -> let eset' = Set.delete ev eset in if eset' == Set.empty then Map.delete key mp else Map.insert key eset' mp
Nothing -> mp
union' v st = Set.union (Set.difference st v) v
instrument bname behave bus = behave <~< (return . future bus . return $ [InstrumentedBehaviour bname] )
-- | An infinite loop of behaviours and widgets over time, sampled forward.
bus :: [Widget a] -> IO b -> Behaviour a -> IO ()
bus widgets widgetThunk behaviour = do
evBus <- newMVar emptyBus
forM_ widgets ($evBus)
let loop = do
widgetThunk
busIteration evBus behaviour
loop
loop
-- | Sample time and apply the behaviour to that sample.
busIteration :: MVar (Bus a) -> Behaviour a -> IO ()
busIteration b behaviour = do
v <- tryTakeMVar b
case v of
Nothing -> return ()
Just m -> do diffs <- behaviour m
bus' <- applyDiff diffs
bus'' <- expire <$> decrementTimeSpan bus'
putMVar b bus''
hPutStr (debugout bus'') . show $ Click
-- | Assign an event to time given some event data and a TimeSpan.
--
-- @produce group source nm timetolive edata@
produce :: String -> String -> String -> TimeSpan -> a -> IO (Diff a)
produce group source nm timetolive edata =
(return . Insertion . Event nm group timetolive edata source) =<< getCurrentTime
-- | Assign an event to time from a widget.
--
-- @produce' group source nm timetolive edata bus@
produce' :: String -> String -> String -> TimeSpan -> a -> MVar (Bus a) -> IO ()
produce' group source nm timetolive edata b = getCurrentTime >>= \t -> modifyMVar_ b (return . addEvent (Event nm group timetolive edata source t))
-- | Sample all events with a given name at the current time and output their deletions as Diffs as
-- well as any additional Diffs returned by the behaviour.
consumeNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
consumeNamedEventsCollectivelyWith em nm f =
maybe (future em . return $ [])
(\ev -> future em $ (map Deletion (Set.toList ev) ++) <$> f ev)
(Map.lookup nm (nameMap em))
consumeNamedEvents :: String -> Behaviour a
consumeNamedEvents nm b =
maybe (future b . return $ [])
(\ev -> future b . return $ Deletion <$> Set.toList ev)
(Map.lookup nm . nameMap $ b)
consumeEventGroup :: String -> Behaviour a
consumeEventGroup g b =
maybe (future b . return $ [])
(\ev -> future b . return $ Deletion <$> Set.toList ev)
(Map.lookup g . groupMap $ b)
consumeEventsFromSource :: String -> Behaviour a
consumeEventsFromSource s b =
maybe (future b . return $ [])
(\ev -> future b . return $ Deletion <$> Set.toList ev)
(Map.lookup s . srcMap $ b)
consumeFullyQualifiedEvent :: String -> String -> String -> Behaviour a
consumeFullyQualifiedEvent g s n b =
maybe (future b . return $ [])
(\ev -> future b . return $ [Deletion ev])
(Map.lookup (g, s, n) . fullyQualifiedMap $ b)
modifyEventData :: Event a -> (a -> a) -> [Diff a]
modifyEventData ev f = [Insertion ev{ eventdata = f . eventdata $ ev }]
modifyEvent :: Event a -> (Event a -> Event a) -> [Diff a]
modifyEvent ev f = let ev' = f ev in if ev==ev' then [Insertion ev'] else [Deletion ev, Insertion ev']
consumeNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a
consumeNamedEventsWith b n f =
future b $ concat <$> ((\l -> (map Deletion l :) <$> mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (nameMap b)))
-- | Sample all events with a given group at the current time and output their deletions as Diffs as
-- well as any additional Diffs returned by the behaviour.
consumeEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
consumeEventGroupCollectivelyWith em gp f =
maybe (future em . return $ [])
(\ev -> future em $ (map Deletion (Set.toList ev) ++) <$> f ev)
(Map.lookup gp (groupMap em))
consumeEventGroupWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a
consumeEventGroupWith b n f =
future b $ concat <$> ((\l -> (map Deletion l :) <$> mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (groupMap b)))
-- | Sample all events with a given source at the current time and output their deletions as Diffs as
-- well as any additional Diffs returned by the behaviour.
consumeEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
consumeEventsFromSourceCollectivelyWith em source f =
maybe (future em . return $ [])
(\ev -> future em $ (map Deletion (Set.toList ev) ++) <$> f ev)
(Map.lookup source (srcMap em))
consumeEventsFromSourceWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a
consumeEventsFromSourceWith b n f =
future b $ concat <$> ((\l -> (map Deletion l :) <$> mapM f l) . Set.toList $ fromMaybe Set.empty (Map.lookup n (srcMap b)))
-- | Sample a single fully qualified event at the current time and output their deletions as Diffs as
-- well as any additional Diffs returned by the behaviour. Parameter order is bus, group, source, name
consumeFullyQualifiedEventWith :: Bus a -> String -> String -> String -> (Event a -> IO [Diff a]) -> Future a
consumeFullyQualifiedEventWith em group source name f =
maybe (future em . return $ [])
(\ev -> future em $ (Deletion ev :) <$> f ev)
(Map.lookup (group,source,name) (fullyQualifiedMap em))
-- | Sample all events with a given name and apply a Behaviour
pollNamedEventsCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
pollNamedEventsCollectivelyWith b nm f = maybe (future b . return $[]) (future b . f) (Map.lookup nm (nameMap b))
-- | Sample all events with a given name and apply a Behaviour to each
pollNamedEventsWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a
pollNamedEventsWith b nm f = future b $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (nameMap b)))
-- | Sample all events with a given group and apply a Behaviour
pollEventGroupCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
pollEventGroupCollectivelyWith b nm f = maybe (future b . return $[]) (future b . f) (Map.lookup nm (groupMap b))
-- | Sample all events with a gien group and apply a Behaviour to each.
pollEventGroupWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a
pollEventGroupWith b nm f = future b $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (groupMap b)))
-- | Sample all events with a given source and apply a Behaviour
pollEventsFromSourceCollectivelyWith :: Bus a -> String -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
pollEventsFromSourceCollectivelyWith b nm f = maybe (future b . return $[]) (future b . f) (Map.lookup nm (srcMap b))
-- | Sample all events with a given source and apply a Behaviour to each.
pollEventsFromSourceWith :: Bus a -> String -> (Event a -> IO [Diff a]) -> Future a
pollEventsFromSourceWith b nm f = future b $ concat <$> (mapM f . Set.toList $ fromMaybe Set.empty (Map.lookup nm (srcMap b)))
-- | Sample a single fully qualified event and output some Diffs.
-- Parameter order is bus, group, source, name.
pollFullyQualifiedEventWith :: Bus a -> String -> String -> String -> (Event a -> IO [Diff a]) -> Future a
pollFullyQualifiedEventWith b gp source nm f = maybe (future b . return $ []) (future b . f) (Map.lookup (gp,source,nm) (fullyQualifiedMap b))
-- | Apply a behaviour to all events in the bus, one event at a time.
pollAllEventsWith :: Bus a -> (Event a -> IO [Diff a]) -> Future a
pollAllEventsWith b f = future b $ concat <$> (mapM f . Map.elems . fullyQualifiedMap $ b)
-- | Apply a behaviour to the collection of all events on the bus at once
pollAllEventsCollectivelyWith :: Bus a -> (Set.Set (Event a) -> IO [Diff a]) -> Future a
pollAllEventsCollectivelyWith b f = future b $ f . Set.fromList . Map.elems . fullyQualifiedMap $ b
singleton a = Set.fromList [a]
decrementTimeSpan b = return $ b{ nameMap = Map.map decrements (nameMap b)
, srcMap = Map.map decrements (srcMap b)
, groupMap = Map.map decrements (groupMap b)
, fullyQualifiedMap = Map.map decrement (fullyQualifiedMap b) }
where decrement e = e{ timespan = decTimeSpan e (timespan e) }
decrements = Set.map (\e -> e{timespan = decTimeSpan e (timespan e)} )
decTimeSpan _ Persistent = Persistent
decTimeSpan e (Time x) = Time . realToFrac $ diffUTCTime (addUTCTime (realToFrac x) (time e)) (unsafePerformIO getCurrentTime)
decTimeSpan _ (Iterations x) = (Iterations (x-1))
expire b = b'
where current (Time x) = x > 0
current Persistent = True
current (Iterations x) = x > 0
b' = Bus (Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . nameMap $ b)
(Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . srcMap $ b)
(Map.filter (/=Set.empty) . Map.map (Set.filter (current . timespan)) . groupMap $ b)
(Map.filter (current . timespan) . fullyQualifiedMap $ b)
Nothing
(debugout b)
listM v = v >>= return . (:[])
{- example usage...
-
- handleDataLoad :: Behaviour
- ...
-
- handleZoom :: Behaviour
- ...
-
- handlePan :: Behaviour
- ...
-
- handleRot :: Behaviour
- ...
-
- handleWriteData :: Behaviour
- ...
-
- main = do
- ui <- getUIFromFile "something.glade"
- mapM_ makeGtkProducers ui
- multitouch <- getMultitouchProducer "localhost" 8080
- bus (multitouch:ui) $ handleDataLoad >~> handleZoom |~| handlePan |~| handleRot >~> handleWriteData
-
-}
{- example of generically wrapping a Gtk widget into a EventBus.Widget
- buttonWidget :: Gtk.Widget -> Bus a -> IO (Behaviour a)
- buttonWidget button em = Gtk.onClick button $ do
- name <- Gtk.getWidgetName button
- value <- EString <$> Gtk.getText button
- produce' "ui" name "Click" once em
-}
Something went wrong with that request. Please try again.