dunai-examples: Upgrade example to use SDL2. Refs ivanperez-keera#446

SDL 1 is deprecated, and no longer maintained. To keep the example working with more modern versions of packages in the Haskell ecosystem, this commit ports bouncingball to use SDL2.
mchav · Nov 4, 2024 · f92988f · f92988f
1 parent a7ed00e
commit f92988f
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 19 deletions.
diff --git a/dunai-examples/bouncingball/BouncingBall.hs b/dunai-examples/bouncingball/BouncingBall.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE Arrows #-}
-{-# LANGUAGE CPP    #-}
+{-# LANGUAGE Arrows            #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE OverloadedStrings #-}
 -- |
 -- Copyright  : (c) Ivan Perez and Manuel Baerenz, 2016
 -- License    : BSD3
@@ -15,20 +16,29 @@ import FRP.Yampa     as Yampa
 #endif
 
 import Control.Concurrent
-import Graphics.UI.SDL            as SDL
-import Graphics.UI.SDL.Primitives as SDL
+import Foreign.C.Types
+import qualified SDL
+import qualified SDL.Primitive as SDL
 
+screenWidth, screenHeight :: CInt
+(screenWidth, screenHeight) = (800, 600)
+
+main :: IO ()
 main = do
-   SDL.init [InitEverything]
-   SDL.setVideoMode 800 600 32 [SWSurface]
+   SDL.initialize [SDL.InitVideo]
+   window <- SDL.createWindow
+             "Bouncing ball"
+             SDL.defaultWindow { SDL.windowInitialSize = SDL.V2 screenWidth screenHeight }
+   SDL.showWindow window
+   renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
+
    reactimate (return ())
-              (\_ -> return (0.01, Just ()))
-              (\_ e -> render e >> return False)
+              (\_ -> return (0.005, Just ()))
+              (\_ e -> render e renderer >> return False)
               sf
 
 sf = bouncingBall (100.0 :: Float) 0.0
 
-
 bouncingBall p0 v0 =
   switch (proc (_) -> do
             (p,v)  <- fallingBall p0 v0  -< ()
@@ -55,15 +65,18 @@ fallingBall p0 v0 = proc () -> do
 -- whenS :: (a -> Bool) -> SF a (Yampa.Event a)
 -- whenS p = (((arr p >>> edge) &&& arr id) >>> (arr (uncurry tag)))
 
-render (p,_) = do
-  screen <- SDL.getVideoSurface
+render :: RealFrac a => (a, b) -> SDL.Renderer -> IO ()
+render (p,_) renderer = do
+  let white = SDL.V4 maxBound maxBound maxBound maxBound
+  SDL.rendererDrawColor renderer SDL.$= white
+  SDL.clear renderer
 
-  white <- SDL.mapRGB (SDL.surfaceGetPixelFormat screen) 0xFF 0xFF 0xFF
-  SDL.fillRect screen Nothing white
+  let red = SDL.V4 maxBound 0 0 maxBound
+  SDL.rendererDrawColor renderer SDL.$= red
 
-  SDL.filledCircle screen 100 (600 - 100 - round p) 30 (Pixel 0xFF0000FF)
+  SDL.fillCircle renderer (SDL.V2 100 (600 - 100 - round p)) 30 red
 
-  SDL.flip screen
+  SDL.present renderer
 
   threadDelay 1000
 

diff --git a/dunai-examples/bouncingball/bearriver-examples-bouncingball.cabal b/dunai-examples/bouncingball/bearriver-examples-bouncingball.cabal
@@ -18,8 +18,8 @@ executable dunai-examples-bearriver-bouncingball
   ghc-options:       -Wall -fno-warn-unused-do-bind
   cpp-options:       -DBEARRIVER
   build-depends:     base >=4.6 && < 5,
-                     SDL,
-                     SDL-gfx,
+                     sdl2,
+                     sdl2-gfx,
                      bearriver
 
                      -- transformers, mtl,
@@ -29,8 +29,8 @@ executable dunai-examples-bearriver-bouncingball-yampa
   default-language:  Haskell2010
   ghc-options:       -Wall -fno-warn-unused-do-bind
   build-depends:     base >=4.6 && < 5,
-                     SDL,
-                     SDL-gfx,
+                     sdl2,
+                     sdl2-gfx,
                      Yampa
 
 source-repository head