Ticket #28: reactive-glut.patch

File reactive-glut.patch, 4.6 kB (added by Baughn, 5 years ago)
  • reactive-glut.cabal

    Only in reactive-glut-0.2.0/: dist
    diff -ur reactive-glut-0.1.6/reactive-glut.cabal reactive-glut-0.2.0/reactive-glut.cabal
    old new  
    11Name:                reactive-glut 
    2 Version:             0.1.6 
     2Version:             0.2.0 
    33Cabal-Version:       >= 1.2 
    44Synopsis:            Connects Reactive and GLUT 
    55Category:            FRP, graphics 
     
    2626Library 
    2727  hs-Source-Dirs:      src 
    2828  Extensions: 
    29   Build-Depends:       base, old-time, OpenGL, GLUT, vector-space, reactive >= 0.10.5 
     29  Build-Depends:       base, containers, old-time, OpenGL, GLUT, vector-space, reactive >= 0.10.5 
    3030  Exposed-Modules:      
    3131                       FRP.Reactive.GLUT.Adapter 
    3232  Other-Modules: 
  • src/FRP/Reactive/GLUT/Adapter.hs

    diff -ur reactive-glut-0.1.6/src/FRP/Reactive/GLUT/Adapter.hs reactive-glut-0.2.0/src/FRP/Reactive/GLUT/Adapter.hs
    old new  
    2222 
    2323import qualified Graphics.UI.GLUT as G 
    2424 
    25 import FRP.Reactive (Behavior,stepper) 
     25import FRP.Reactive (Behavior,stepper,flipFlop,accumB) 
    2626import FRP.Reactive.LegacyAdapters 
    2727 
    2828import FRP.Reactive.GLUT.UI 
    2929import FRP.Reactive.GLUT.SimpleGL 
    3030 
     31import qualified Data.Set as Set 
     32 
    3133-- | Adapter to connect @FRP.Reactive@ with @GLUT@.  Uses given window 
    3234-- title and a simple canned initialization.  Or do your own 
    3335-- initialization and then invoke 'adapt'. 
     
    4244     let mkE = makeEvent clock 
    4345     (mousePosSink , mousePosE ) <- mkE 
    4446     (leftDownSink , leftDown  ) <- mkE 
     47     (leftUpSink   , leftUp    ) <- mkE 
    4548     (rightDownSink, rightDown ) <- mkE 
     49     (rightUpSink  , rightUp   ) <- mkE 
    4650     (keyActionSink, keyActions) <- mkE 
    4751     (tickSink     , tick      ) <- mkE 
     52      
    4853     -- TODO: let the initial mouse position be its actual position 
    4954     let windowPoint' p = do -- putStrLn $ "window point " ++ show p 
    5055                             windowPoint p 
     
    6065     G.keyboardMouseCallback G.$= Just (\k ks _ _ -> 
    6166       case (k,ks) of 
    6267         (G.MouseButton G.LeftButton ,G.Down) -> leftDownSink  () 
     68         (G.MouseButton G.LeftButton ,G.Up)   -> leftUpSink    () 
    6369         (G.MouseButton G.RightButton,G.Down) -> rightDownSink () 
     70         (G.MouseButton G.RightButton,G.Up)   -> rightUpSink   () 
    6471         (G.Char c      ,G.Down) -> keyActionSink (Down, Char c) 
    6572         (G.SpecialKey s,G.Down) -> keyActionSink (Down, SpecialKey s) 
    6673         (G.Char c      ,G.Up)   -> keyActionSink (Up  , Char c) 
    6774         (G.SpecialKey s,G.Up)   -> keyActionSink (Up  , SpecialKey s) 
    6875         _ -> return () 
    6976      ) 
     77     -- Convenient summary behaviors 
     78     let leftButtonB  = flipFlop leftDown  leftUp 
     79         rightButtonB = flipFlop rightDown rightUp 
     80         keyboardB    = accumB Set.empty (uncurry setAction <$> keyActions) 
     81             where 
     82               setAction Down = Set.insert 
     83               setAction Up   = Set.delete 
     84     --  
    7085     updater <- mkUpdater 
    7186                 (cGetTime clock) 
    72                  (glwrap <$> f (UI mousePos leftDown rightDown keyActions tick)) 
     87                 (glwrap <$> f (UI mousePos leftDown leftUp leftButtonB rightDown rightUp rightButtonB keyActions keyboardB tick)) 
    7388     schedule (updater >> tickSink ()) 
    7489     -- putStrLn "mainLoop" 
    7590     G.mainLoop 
  • src/FRP/Reactive/GLUT/UI.hs

    diff -ur reactive-glut-0.1.6/src/FRP/Reactive/GLUT/UI.hs reactive-glut-0.2.0/src/FRP/Reactive/GLUT/UI.hs
    old new  
    2323 
    2424import Control.Applicative (liftA2) 
    2525import qualified Graphics.UI.GLUT as G 
     26import Data.Map(Map) 
     27import Data.Set(Set) 
    2628 
    2729import Data.VectorSpace 
    2830import FRP.Reactive 
    2931 
    3032-- | Simple UI type. 
    3133data UI = UI { 
    32   mousePosition      :: Behavior (Double,Double), 
    33   leftButtonPressed  :: Event (), 
    34   rightButtonPressed :: Event (), 
    35   keyAction          :: Event (KeyState, Key), 
    36   framePass          :: Event () 
     34  mousePosition       :: Behavior (Double,Double), 
     35  leftButtonPressed   :: Event (), 
     36  leftButtonReleased  :: Event (), 
     37  leftButton          :: Behavior Bool, 
     38  rightButtonPressed  :: Event (), 
     39  rightButtonReleased :: Event (), 
     40  rightButton         :: Behavior Bool, 
     41  keyAction           :: Event (KeyState, Key), 
     42  keyboard            :: Behavior (Set Key), 
     43  framePass           :: Event () 
    3744} 
    3845 
    3946-- TODO: make button and key interfaces alike