我正在学习Haskell，并尝试编写一些事件驱动的程序。
以下代码来自教程：http://www.haskell.org/haskellwiki/OpenGLTutorial2
main = do
(progname,_) <- getArgsAndInitialize
initialDisplayMode $= [DoubleBuffered]
createWindow "Hello World"
reshapeCallback $= Just reshape
angle <- newIORef (0.0::GLfloat) -- 1
delta <- newIORef (0.1::GLfloat) -- 2
position <- newIORef (0.0::GLfloat, 0.0) -- 3
keyboardMouseCallback $= Just (keyboardMouse delta position)
idleCallback $= Just (idle angle delta)
displayCallback $= (display angle position)
mainLoop
状态存储在IORef s中，这使得它看起来就像命令式语言。
我听说除Graphics.UI.GLUT之外还有其他API（例如Reactive），但它看起来很复杂。
我的方法是lib提供一个函数runEventHandler，用户编写一个handler，接受Event的列表并将它们转换为IO ()。
handler :: [Event] -> IO ()
runEventHandler :: ( [Event] -> IO () ) -> IO ()
main函数应如下所示：
main = runEventHandler handler
有这样的库吗？
我目前正在使用多线程实现一个，但我担心它的性能可能会很差......
答案 0 :(得分：11)
reactive-banana是一个非常类似于reactive的成熟图书馆。我们不会尝试重新发明一个frp库;相反，我们将探索如何将反应性香蕉整合到我们自己的项目中。
要使用功能性反应式编程库，如反应性香蕉和OpenGL，我们将工作分为4个部分，其中2个部分已经存在。我们将使用现有的GLUT库与OpenGL进行交互，并使用现有的reactive-banana库来实现功能性反应式编程。我们将提供我们自己的两个部分。我们将提供的第一部分是将GLUT连接到反应性香蕉的框架。我们将提供的第二部分是将根据frp实现（reactive-banana）和框架以及GLUT类型编写的程序。
我们提供的两个部分都将根据反应性香蕉frp库进行编写。该库有两个重要的想法，Event t a和Behavior t a。 Event t a表示在不同时间点发生的携带a类型数据的事件。 Behavior t a表示在所有时间点定义的类型a的时变值。类型系统要求t类型参数保留，否则忽略。
Event和Behavior的大多数界面都隐藏在其实例中。 Event是Functor - 我们可以fmap或<$>对任何Event的值进行处理。
fmap :: (a -> b) -> Event t a -> Event t b
Behavior同时为Applicative和Functor。我们可以fmap或<$>对Behavior所采用的所有值执行函数，可以使用pure提供新的常量不变值，并计算新的Behavior s与<*>。
fmap :: (a -> b) -> Behavior t a -> Behavior t b
pure :: a -> Behavior t a
<*> :: Behavior t (a -> b) -> Behavior t a -> Behavior t b
有一些other functions provided by reactive-banana提供的功能无法用基类型类来表示。这些引入了状态，将Event组合在一起，并在Event和Behavior之间进行转换。
状态由accumE引入，它将前一个值的初始值和Event变为新值，并生成Event个新值。 accumB生成Behavior而不是
accumE :: a -> Event t (a -> a) -> Event t a
accumB :: a -> Event t (a -> a) -> Behavior t a
union将两个事件流组合在一起
union :: Event t a -> Event t a -> Event t a
stepper可以将Event转换为保留最新值的Behavior，以便在所有时间点定义它。如果我们提供一系列apply来轮询{{1}的当前值，<@>或Behavior可以将Event转换为Events }。
Behavior stepper :: a -> Event t a -> Behavior t a
<@> :: Behavior t (a -> b) -> Event t a -> Event t b
和Event的实例以及Reactive.Banana.Combinators中的19个函数构成了功能反应式编程的整个界面。
总的来说，我们需要我们正在实现的OpenGL示例使用的GLUT库和库，反应香蕉库，用于制作框架的反应性香蕉出口和RankNTypes扩展，一些用于线程间通信的机制，以及能够读取系统时钟。
Behavior我们的框架会将{-# LANGUAGE RankNTypes #-}
import Graphics.UI.GLUT
import Control.Monad
import Reactive.Banana
import Reactive.Banana.Frameworks
import Data.IORef
import Control.Concurrent.MVar
import Data.Time
事件从GLUT映射到反应性香蕉IO和Event。示例使用了四个GLUT事件 - Behavior，reshapeCallback，keyboardMouseCallback和idleCallback。我们会将这些映射到displayCallback和Event s。
Behavior。作为回调，它需要reshapeCallback类型的东西。我们将此表示为type ReshapeCallback = Size -> IO ()。
Event t Size。作为回调，它需要keyboardMouseCallback类型的东西。我们将此表示为类型为type KeyboardMouseCallback = Key -> KeyState -> Modifiers -> Position -> IO ()的输入，其中Event t KeyboardMouse将传递给回调的所有参数捆绑在一起。
KeyboardMouse data KeyboardMouse = KeyboardMouse {
key :: Key,
keyState :: KeyState,
modifiers :: Modifiers,
pos :: Position
}
在时间过去后运行。我们将此表示为跟踪已经过去的时间量idleCallback的行为。因为它是Behavior t DiffTime而不是Behavior，我们的程序无法直接观察时间的流逝。如果不需要，我们可以使用Event代替。
将所有输入捆绑在一起
Event data Inputs t = Inputs {
keyboardMouse :: Event t KeyboardMouse,
time :: Behavior t DiffTime,
reshape :: Event t Size
}
与其他回调不同;它不是程序的输入，而是输出需要显示的内容。由于GLUT可以在任何时候运行它以尝试在屏幕上显示某些内容，因此在所有时间点定义它是有意义的。我们将使用displayCallback来表示此输出。
我们还需要一个输出 - 响应事件，示例程序偶尔会产生其他IO操作。我们将允许程序引发事件以使用Behavior t DisplayCallback执行任意IO。
将两个输出捆绑在一起我们得到
Event t (IO ())我们的框架将通过传递类型为data Outputs t = Outputs {
display :: Behavior t DisplayCallback,
whenIdle :: Event t (IO ())
}
的程序来调用。我们将在接下来的两个部分中定义forall t. Inputs t -> Outputs t和program。
reactiveGLUT该程序将使用反应性香蕉将main :: IO ()
main = do
(progname,_) <- getArgsAndInitialize
initialDisplayMode $= [DoubleBuffered]
createWindow "Hello World"
reactiveGLUT program
映射到Inputs。要开始移植教程代码，我们会从Outputs中删除IORef并将cubes重命名为reshape，因为它与我们的框架界面中的名称冲突
onReshape cubes :: GLfloat -> (GLfloat, GLfloat) -> DisplayCallback
cubes a (x',y') = do
clear [ColorBuffer]
loadIdentity
translate $ Vector3 x' y' 0
preservingMatrix $ do
rotate a $ Vector3 0 0 1
scale 0.7 0.7 (0.7::GLfloat)
forM_ (points 7) $ \(x,y,z) -> preservingMatrix $ do
color $ Color3 ((x+1)/2) ((y+1)/2) ((z+1)/2)
translate $ Vector3 x y z
cube 0.1
swapBuffers
onReshape :: ReshapeCallback
onReshape size = do
viewport $= (Position 0 0, size)
将完全由keyboardMouse和positionChange取代。这些将angleSpeedChange事件转换为更改，以生成多维数据集旋转的位置或速度。如果事件无需更改，则会返回KeyboardMouse。
Nothing计算位置相当容易，我们会累积键盘输入的变化。 positionChange :: Fractional a => KeyboardMouse -> Maybe ((a, a) -> (a, a))
positionChange (KeyboardMouse (SpecialKey k) Down _ _) = case k of
KeyLeft -> Just $ \(x,y) -> (x-0.1,y)
KeyRight -> Just $ \(x,y) -> (x+0.1,y)
KeyUp -> Just $ \(x,y) -> (x,y+0.1)
KeyDown -> Just $ \(x,y) -> (x,y-0.1)
_ -> Nothing
positionChange _ = Nothing
angleSpeedChange :: Num a => KeyboardMouse -> Maybe (a -> a)
angleSpeedChange (KeyboardMouse (Char c) Down _ _) = case c of
' ' -> Just negate
'+' -> Just (+1)
'-' -> Just (subtract 1)
_ -> Nothing
angleSpeedChange _ = Nothing
抛出了我们不感兴趣的事件。
filterJust :: Event t (Maybe a) -> Event t a我们计算旋转立方体的角度有点不同。我们将记住速度变化时的时间和角度，应用一个函数来计算角度与时间差的差异，并将其添加到初始角度。
positionB :: Fractional a => Inputs t -> Behavior t (a, a)
positionB = accumB (0.0, 0.0) . filterJust . fmap positionChange . keyboardMouse
计算angleCalculation :: (Num a, Num b) => a -> b -> (a -> b) -> a -> b
angleCalculation a0 b0 f a1 = f (a1 - a0) + b0
有点困难。首先，我们计算一个事件angle，从一个时间差到角度差之间保存一个函数。我们将angleF :: Event t (DiffTime -> GLfloat)提升并应用到当前angleCalculation和time，并在每次angle事件发生时进行轮询。我们将轮询的函数转换为angleF Behavior并将其应用于当前stepper。
time整个angleB :: Fractional a => Inputs t -> Behavior t a
angleB inputs = angle
where
initialSpeed = 2
angleSpeed = accumE initialSpeed . filterJust . fmap angleSpeedChange . keyboardMouse $ inputs
scaleSpeed x y = 10 * x * realToFrac y
angleF = scaleSpeed <$> angleSpeed
angleSteps = (angleCalculation <$> time inputs <*> angle) <@> angleF
angle = stepper (scaleSpeed initialSpeed) angleSteps <*> time inputs
地图program到Inputs。它表示Outputs的行为display的行为被抬起并应用于角度和位置。每次cubes事件发生时，其他Event副作用的IO为onReshape。
reshape我们的框架接受类型为program :: Inputs t -> Outputs t
program inputs = outputs
where
outputs = Outputs {
display = cubes <$> angleB inputs <*> positionB inputs,
whenIdle = onReshape <$> reshape inputs
}
的程序并运行它。为了实现框架，我们使用forall t. Inputs t -> Outputs t中的函数。这些功能允许我们从Reactive.Banana.Frameworks引发Event并运行IO行动以响应IO。我们可以使用Event中的函数从Behavior生成Event并在Behavior出现Event时进行投票。
Reactive.Banana.Combinators reactiveGLUT :: (forall t. Inputs t -> Outputs t) -> IO ()
reactiveGLUT program = do
-- Initial values
initialTime <- getCurrentTime
-- Events
(addKeyboardMouse, raiseKeyboardMouse) <- newAddHandler
(addTime, raiseTime) <- newAddHandler
(addReshape, raiseReshape) <- newAddHandler
(addDisplay, raiseDisplay) <- newAddHandler
创建一个句柄，用于讨论newAddHandler，以及一个用于引发Event t a类型事件的函数。我们为键盘和鼠标输入，空闲时间传递和窗口形状改变做了明显的事件。当我们需要在a -> IO ()中运行时，我们还会制作一个用于轮询display Behavior的活动。
我们有一个棘手的问题需要克服--OpenGL要求所有的UI交互都发生在特定的线程中，但是我们不确定我们绑定到reactive-banana事件的行为会发生在什么线程中。我们＆＃39 ; ll使用跨线程共享的几个变量来确保displayCallback Output在OpenGL线程中运行。对于IO输出，我们会使用display来存储轮询的MVar操作。对于display中排队的IO次操作，我们会将其累积在whenIdle中，
IORef我们的整个网络由以下部分组成。首先，我们为每个 -- output variables and how to write to them
displayVar <- newEmptyMVar
whenIdleRef <- newIORef (return ())
let
setDisplay = putMVar displayVar
runDisplay = takeMVar displayVar >>= id
addWhenIdle y = atomicModifyIORef' whenIdleRef (\x -> (x >> y, ()))
runWhenIdle = atomicModifyIORef' whenIdleRef (\x -> (return (), x)) >>= id
和Event创建fromAddHandler s（使用Behavior）或fromChanges s（使用Inputs）进行投票输出Event。我们执行少量处理以简化时钟。我们将display应用于我们准备的program以获得该计划的inputs。使用Outputs，只要我们的显示事件发生，我们就会轮询<@。最后，只要发生相应的display，reactimate就会告诉反应香蕉运行setDisplay或addWhenIdle。在我们描述了网络后，我们Event和compile。
actuate对于我们感兴趣的每个GLUT回调，我们都会引发相应的反应性香蕉 -- Reactive network for GLUT programs
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
keyboardMouseEvent <- fromAddHandler addKeyboardMouse
clock <- fromChanges initialTime addTime
reshapeEvent <- fromAddHandler addReshape
displayEvent <- fromAddHandler addDisplay
let
diffTime = realToFrac . (flip diffUTCTime) initialTime <$> clock
inputs = Inputs keyboardMouseEvent diffTime reshapeEvent
outputs = program inputs
displayPoll = display outputs <@ displayEvent
reactimate $ fmap setDisplay displayPoll
reactimate $ fmap addWhenIdle (whenIdle outputs)
network <- compile networkDescription
actuate network
。对于空闲回调，我们还运行任何排队事件。对于显示回调，我们运行轮询的Event。
DisplayCallback本教程代码的其余部分可以逐字重复
-- Handle GLUT events
keyboardMouseCallback $= Just (\k ks m p -> raiseKeyboardMouse (KeyboardMouse k ks m p))
idleCallback $= Just (do
getCurrentTime >>= raiseTime
runWhenIdle
postRedisplay Nothing)
reshapeCallback $= Just raiseReshape
displayCallback $= do
raiseDisplay ()
runDisplay
mainLoop