git.iko.soy/streamly
on bcf4b0e help sign in
streamly/src/Streamly/Examples/CirclingSquare.hs
90 lines 2.7 kB history raw
1-- Adapted from the Yampa package.
2-- Displays a square moving in a circle. To move the position drag the mouse.
3--
4-- Requires the SDL package, assuming streamly has already been built, you can
5-- compile it like this:
6-- stack ghc --package SDL circle-mouse.hs
8module Streamly.Examples.CirclingSquare where
10import Data.IORef
11import Graphics.UI.SDL as SDL
12import Streamly
13import Streamly.Time
15------------------------------------------------------------------------------
16-- SDL Graphics Init
17------------------------------------------------------------------------------
19sdlInit :: IO ()
20sdlInit = do
21 SDL.init [InitVideo]
23 let width = 640
24 height = 480
25 _ <- SDL.setVideoMode width height 16 [SWSurface]
26 SDL.setCaption "Test" ""
28------------------------------------------------------------------------------
29-- Display a box at a given coordinates
30------------------------------------------------------------------------------
32display :: (Double, Double) -> IO ()
33display (playerX, playerY) = do
34 screen <- getVideoSurface
36 -- Paint screen green
37 let format = surfaceGetPixelFormat screen
38 bgColor <- mapRGB format 55 60 64
39 _ <- fillRect screen Nothing bgColor
41 -- Paint small red square, at an angle 'angle' with respect to the center
42 foreC <- mapRGB format 212 108 73
43 let side = 10
44 x = round playerX
45 y = round playerY
46 _ <- fillRect screen (Just (Rect x y side side)) foreC
48 -- Double buffering
49 SDL.flip screen
51------------------------------------------------------------------------------
52-- Wait and update Controller Position if it changes
53------------------------------------------------------------------------------
55refreshRate :: Int
56refreshRate = 40
58updateController :: IORef (Double, Double) -> IO ()
59updateController ref = periodic refreshRate $ do
60 e <- pollEvent
61 case e of
62 MouseMotion x y _ _ -> do
63 writeIORef ref (fromIntegral x, fromIntegral y)
64 _ -> return ()
66------------------------------------------------------------------------------
67-- Periodically refresh the output display
68------------------------------------------------------------------------------
70updateDisplay :: IORef (Double, Double) -> IO ()
71updateDisplay cref = withClock clock refreshRate displaySquare
73 where
75 clock = do
76 t <- SDL.getTicks
77 return ((fromIntegral t) * 1000)
79 speed = 8
80 radius = 30
81 displaySquare time = do
82 (x, y) <- readIORef cref
83 let t = (fromIntegral time) * speed / 1000000
84 in display (x + cos t * radius, y + sin t * radius)
86circlingSquare :: IO ()
87circlingSquare = do
88 sdlInit
89 cref <- newIORef (0,0)
90 runStreamT $ liftIO (updateController cref) <|> liftIO (updateDisplay cref)