反应香蕉是一个非常类似于的成熟库reactive。我们不会尝试重新发明一个 frp 库；相反，我们将探索如何将reactive-banana集成到我们自己的项目中。
大局观
为了使用函数式反应式编程库（如带有 OpenGL 的reactive-banana），我们将工作分为 4 部分，其中 2 部分已经存在。我们将使用现有的 GLUT 库与 OpenGL 交互，并使用现有的reactive-banana 库来实现函数式反应式编程。我们将提供我们自己的 2 部分。我们将提供的第一部分是将 GLUT 连接到reactive-banana 的框架。我们将提供的第二部分是根据 frp 实现（reactive-banana）和框架以及 GLUT 类型编写的程序。
我们提供的两个部分都将根据reactive-banana frp 库编写。图书馆有两个伟大的想法，Event t a and Behavior t a. Event t a表示携带类型数据的事件a发生在不同的时间点。Behavior t a表示类型的随时间变化的值a这是在所有时间点定义的。这t类型系统要求我们保留类型参数，否则会忽略。
大部分接口为Event and Behavior隐藏在它们的实例中。Event is a Functor- 我们可以fmap or <$>任意值的函数Event.
fmap :: (a -> b) -> Event t a -> Event t b
Behavior既是Applicative and a Functor。我们可以fmap or <$>所有值 a 的函数Behavior承担，可以提供新的恒定不变的值pure，并计算新的Behaviors with <*>.
fmap :: (a -> b) -> Behavior t a -> Behavior t b
pure :: a -> Behavior t a
<*> :: Behavior t (a -> b) -> Behavior t a -> Behavior t b
有几个反应式香蕉提供的其他功能提供无法用基类型类表示的功能。这些引入了状态性，结合了Events在一起，并在之间进行转换Events and Behaviors.
状态是由accumE它需要一个初始值和一个Event从先前值到新值的变化并产生Event的新价值观。accumB产生一个Behavior instead
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 to a Behavior如果我们提供一个初始值以便在所有时间点都定义它，则保留最新值。apply or <@>可以转换一个Behavior进入一个Event如果我们提供一系列Events轮询当前值Behavior.
stepper :: a -> Event t a -> Behavior t a
<@> :: Behavior t (a -> b) -> Event t a -> Event t b
实例为Event and Behavior以及 19 个函数Reactive.Banana.Combinators构成函数反应式编程的整个接口。
总的来说，我们需要 GLUT 库和我们正在实现的 OpenGL 示例使用的库、reactive-banana 库、用于制作框架的reactive-banana 导出和 RankNTypes 扩展、用于线程间通信的几种机制以及读取的能力系统时钟。
{-# 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
框架接口
我们的框架将映射IO从过剩到反应式香蕉的事件Events and Behaviors。该示例使用了四个 GLUT 事件 -reshapeCallback, keyboardMouseCallback, idleCallback, and displayCallback。我们将把这些映射到Events and Behaviors.
reshapeCallback当用户调整窗口大小时运行。作为回调，它需要某种类型的东西type ReshapeCallback = Size -> IO ()。我们将其表示为Event t Size.
keyboardMouseCallback当用户提供键盘输入、移动鼠标或单击鼠标按钮时运行。作为回调，它需要某种类型的东西type KeyboardMouseCallback = Key -> KeyState -> Modifiers -> Position -> IO ()。我们将其表示为类型的输入Event t KeyboardMouse, where 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
}
displayCallback与其他回调不同；它不是用于程序的输入，而是用于输出需要显示的内容。由于 GLUT 可以随时运行它来尝试在屏幕上显示某些内容，因此在所有时间点定义它都是有意义的。我们将用一个表示这个输出Behavior t DisplayCallback.
我们还需要另外一个输出 - 为了响应事件，示例程序偶尔会产生其他 IO 操作。我们将允许程序引发事件以执行任意 IOEvent t (IO ()).
将两个输出捆绑在一起我们得到
data Outputs t = Outputs {
display :: Behavior t DisplayCallback,
whenIdle :: Event t (IO ())
}
我们的框架将通过向其传递一个具有以下类型的程序来调用forall t. Inputs t -> Outputs t。我们将定义program and reactiveGLUT在接下来的两节中。
main :: IO ()
main = do
(progname,_) <- getArgsAndInitialize
initialDisplayMode $= [DoubleBuffered]
createWindow "Hello World"
reactiveGLUT program
该程序
该程序将使用reactive-banana来映射Inputs to the Outputs。要开始移植教程代码，我们将删除IORefs from cubes并重命名reshape to 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 and 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 and angle，并在每次出现时轮询angleF事件。我们将轮询函数转换为Behavior with 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 maps Inputs to Outputs。它说的是行为的目的display is 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。这些功能使我们能够提高Events from IO并运行IO响应行动Events。我们可以做Behaviors from Event和民意调查Behaviors when Events 使用以下函数发生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当我们需要在displayCallback.
我们有一个棘手的问题需要克服 - OpenGL 要求所有 UI 交互都在特定线程中发生，但我们不确定绑定到反应式香蕉事件的操作将在哪个线程中发生。我们将使用几个变量跨线程共享以确保Output IO在OpenGL线程中运行。为了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
我们的整个网络由以下部分组成。首先我们创建Events（使用fromAddHandler) or Behaviors（使用fromChanges）对于每个Inputs and an Event用于轮询输出display。我们执行少量处理来简化时钟。我们应用program to the inputs我们准备获得该计划的Outputs. Using <@，我们轮询display每当我们的显示事件发生时。最后，reactimate告诉reactive-banana运行setDisplay or addWhenIdle每当对应的Event发生。一旦我们描述了网络，我们compile and actuate it.
-- 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
对于我们感兴趣的每个 GLUT 回调，我们都会引发相应的reactive-bananaEvent。对于空闲回调，我们还运行任何排队的事件。对于显示回调，我们运行轮询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
示例的其余部分
教程代码的其余部分可以逐字重复
vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()
vertex3f (x, y, z) = vertex $ Vertex3 x y z
points :: Int -> [(GLfloat,GLfloat,GLfloat)]
points n = [ (sin (2*pi*k/n'), cos (2*pi*k/n'), 0) | k <- [1..n'] ]
where n' = fromIntegral n
cube :: GLfloat -> IO ()
cube w = renderPrimitive Quads $ mapM_ vertex3f
[ ( w, w, w), ( w, w,-w), ( w,-w,-w), ( w,-w, w),
( w, w, w), ( w, w,-w), (-w, w,-w), (-w, w, w),
( w, w, w), ( w,-w, w), (-w,-w, w), (-w, w, w),
(-w, w, w), (-w, w,-w), (-w,-w,-w), (-w,-w, w),
( w,-w, w), ( w,-w,-w), (-w,-w,-w), (-w,-w, w),
( w, w,-w), ( w,-w,-w), (-w,-w,-w), (-w, w,-w) ]
