haskell - Reactive的替代库更简单？ ( haskell )

Question

我正在学习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中，这使其看起来像命令式语言。

我听说除了Graphics.UI.GLUT(例如Reactive)之外，还有其他API，但是看起来很复杂。

我的方法是lib提供一个函数runEventHandler，用户编写一个handler，它接受Event的列表并将其转换为IO ()。

handler :: [Event] -> IO ()
runEventHandler :: ( [Event] -> IO () ) -> IO ()

并且main函数应如下所示:

main = runEventHandler handler

有这样的库吗？

我目前正在使用多线程实现一个，但是我担心它的性能可能会很差...

Answer 1

reactive-banana是与reactive非常相似的成熟库。我们不会尝试重塑frp库。取而代之的是，我们将探索如何将反应性香蕉集成到自己的项目中。

大图

要在OpenGL中使用功能性反应式编程库(例如react-banana)，我们会将工作分为4个部分，其中两个已经存在。我们将使用现有的GLUT库与OpenGL进行交互，并使用现有的反应香蕉库来实现功能性反应式编程。我们将提供我们自己的2部分。我们将提供的第一部分是将GLUT连接到反应香蕉的框架。我们将提供的第二部分是将根据frp实现(反应性香蕉)以及框架和GLUT类型编写的程序。

我们提供的两个部分都将根据反应香蕉frp库编写。该库有两个大想法，Event t a和Behavior t a。 Event t a表示携带a类型数据的事件，这些事件发生在不同的时间点。 Behavior t a表示在所有时间点定义的a类型的时变值。类型系统需要使用t类型参数来保留，但忽略它。
Event和Behavior的大多数接口(interface)都隐藏在其实例中。 Event是Functor-我们可以对任何fmap的值进行<$>或Event一个函数。

fmap :: (a -> b) -> Event t a -> Event t b

Behavior既是Applicative又是Functor。我们可以对fmap接受的所有值使用<$>或Behavior函数，可以使用pure提供新的不变的不变值，并使用Behavior计算新的<*>。

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来轮询<@>的当前值，则Behavior或Event可以将Events转换为Behavior。

stepper :: a -> Event t a -> Behavior t a
<@> :: Behavior t (a -> b) -> Event t a -> Event t b

Event和Behavior的实例以及Reactive.Banana.Combinators中的19个功能构成了功能性反应式编程的整个接口(interface)。

总体而言，我们将需要我们正在实现的OpenGL示例所使用的GLUT库和库，反应式香蕉库，用于制作框架的反应式香蕉导出和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

框架界面

我们的框架会将GLUT中的IO事件映射到react-banana Event和Behavior。该示例使用了四个GLUT事件-reshapeCallback，keyboardMouseCallback，idleCallback和displayCallback。我们将它们映射到Event和Behavior。

当用户调整窗口大小时，将运行reshapeCallback。作为回调，它需要类型type ReshapeCallback = Size -> IO ()。我们将其表示为Event t Size。

当用户提供键盘输入，移动鼠标或单击鼠标按钮时，将运行keyboardMouseCallback。作为回调，它需要类型type KeyboardMouseCallback = Key -> KeyState -> Modifiers -> Position -> IO ()。我们将其表示为Event t KeyboardMouse类型的输入，其中KeyboardMouse将传递给回调的所有参数 bundle 在一起。

data KeyboardMouse = KeyboardMouse {
    key :: Key,
    keyState :: KeyState,
    modifiers :: Modifiers,
    pos :: Position
}

随着时间的流逝，idleCallback运行。我们将其表示为一种行为，它跟踪经过的时间Behavior t DiffTime。因为它是Behavior而不是Event，所以我们的程序将无法直接观察时间的流逝。如果不希望这样，我们可以改用Event。

将所有输入 bundle 在一起，我们得到

data Inputs t = Inputs {
    keyboardMouse :: Event t KeyboardMouse,    
    time :: Behavior t DiffTime,
    reshape :: Event t Size
}

displayCallback与其他回调不同；它不是用于输入程序，而是用于输出需要显示的内容。由于GLUT可以随时运行此命令以尝试在屏幕上显示某些内容，因此在所有时间点定义它都是有意义的。我们将使用Behavior t DisplayCallback表示此输出。

我们还需要一个输出-响应事件，示例程序偶尔会产生其他IO操作。我们将允许程序引发事件以使用Event t (IO ())执行任意IO。

将两个输出 bundle 在一起，我们得到

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 displayCallback。

我们要解决一个棘手的问题-OpenGL要求所有UI交互都在特定线程中发生，但是我们不确定绑定(bind)到反应性香蕉事件的动作将在哪个线程中发生。我们将使用几个变量跨线程共享，以确保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

我们的整个网络由以下部分组成。首先，我们为每个Event创建fromAddHandler(使用Behavior)或fromChanges(使用Inputs)和一个Event，用于轮询输出display。我们执行少量处理以简化时钟。我们将program应用于准备获取程序的inputs的Outputs。使用<@，只要发生显示事件，我们都会轮询display。最后，reactimate告诉反应性香蕉在相应的setDisplay出现时运行addWhenIdle或Event。一旦描述了网络，我们就对其进行compile和actuate编码。

    -- 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回调，我们都会提高相应的react-banana 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

其余示例

教程代码的其余部分可以逐字重复

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) ]