0 | {- Tian Z (ecburx@burx.vip) -}
  1 |
  2 | ||| Play a game in a window.
  3 | module IdrisGL.Play
  4 |
  5 | import Control.Monad.State
  6 |
  7 | import IdrisGL.Picture
  8 | import IdrisGL.DataType
  9 | import IdrisGL.Color
 10 | import IdrisGL.SDL.SDL_event
 11 | import IdrisGL.SDL.SDL_video
 12 | import IdrisGL.SDL.SDL_render
 13 | import IdrisGL.SDL.SDL_surface
 14 | import IdrisGL.SDL.SDL_timer
 15 |
 16 | ||| Play a game in a window. Like simulate, but you manage your own input events.
 17 | |||
 18 | ||| @ window  Display mode.
 19 | ||| @ bgColor Background color.
 20 | ||| @ tpf     Time per frame. Providing frames per seconds control. (FPS) = 1/<value> (0: unlimited FPS)
 21 | ||| @ w       The initial world.
 22 | ||| @ w2p     A function to convert the world to a picture.
 23 | ||| @ ew2w    A function to handle input events.
 24 | ||| @ tw2w    A function to step the world one iteration. It passes the amount of time (seconds) since the window creation.
 25 | export
 26 | play 
 27 |   :  (window  : Display)
 28 |   -> (bgColor : Color)
 29 |   -> (tpf     : Double)
 30 |   -> (world   : a)
 31 |   -> (w2p     : a      -> Picture)
 32 |   -> (ew2w    : Eve    -> a -> a)
 33 |   -> (tw2w    : Double -> a -> a)
 34 |   -> IO ()
 35 | play window bgColor tpf w w2p ew2w tw2w = do
 36 |     win                   <- createWin window
 37 |     ren                   <- createRenderer win
 38 |     e                     <- newEve
 39 |     loop                     ren win e w 0
 40 |     closeWin                 win
 41 |     freeEve                  e
 42 |     freeRender               ren
 43 | where 
 44 |   mutual
 45 |       loop : Renderer -> Win -> Event -> a -> Double -> IO ()
 46 |       loop ren win e world lastTime =
 47 |         if   !getSecondsTicks - lastTime < tpf
 48 |         then loop'           ren win e world lastTime
 49 |         else do
 50 |           setRenderDrawColor ren bgColor
 51 |           renderClear        ren
 52 |           loadPicture        (w2p world) ren win
 53 |           renderPresent      ren
 54 |           currT           <- getSecondsTicks
 55 |           let newW        =  tw2w currT world
 56 |           loop'              ren win e newW currT
 57 |
 58 |       loop' : Renderer -> Win -> Event -> a -> Double -> IO ()
 59 |       loop'   ren win e w lastTime with (eveType e)
 60 |         loop' _   _   _ _ _        | E_QUIT = pure ()
 61 |         loop' ren win e w lastTime | other  = loop ren win e (ew2w other w) lastTime
 62 |
 63 |
 64 | ||| Play a game with mutable state in a window. 
 65 | ||| Like simulate, but you manage your own input events.
 66 | |||
 67 | ||| @ window    Display mode.
 68 | ||| @ bgColor   Background color.
 69 | ||| @ tpf       Time per frame. Providing frames per seconds control. (FPS) = 1/<value> (0: unlimited FPS)
 70 | ||| @ stateType The initial world.
 71 | ||| @ w2p       Describes how to produce pictures to show.
 72 | ||| @ e2w       A stateful function that handles input events.
 73 | ||| @ t2w       A stateful function that handles the amount of time (seconds) since the window creation.
 74 | export
 75 | playStateT
 76 |   :  (window    : Display)
 77 |   -> (bgColor   : Color)
 78 |   -> (tpf       : Double)
 79 |   -> (stateType : a)
 80 |   -> (w2p       : StateT a IO Picture)
 81 |   -> (e2w       : Eve    -> StateT a IO ())
 82 |   -> (t2w       : Double -> StateT a IO ())
 83 |   -> IO ()
 84 | playStateT window bgColor tpf state w2p e2w t2w = do
 85 |     win                   <- createWin window
 86 |     ren                   <- createRenderer win
 87 |     e                     <- newEve
 88 |     loop                     state ren win e 0
 89 |     closeWin                 win
 90 |     freeEve                  e
 91 |     freeRender               ren
 92 | where 
 93 |   mutual
 94 |       loop : a -> Renderer -> Win -> Event -> Double -> IO ()
 95 |       loop st ren win e lastTime =
 96 |         if   !getSecondsTicks - lastTime < tpf
 97 |         then loop'           st ren win e lastTime
 98 |         else do
 99 |           setRenderDrawColor ren bgColor
100 |           renderClear        ren
101 |           (st, pics)      <- runStateT st w2p
102 |           loadPicture        pics ren win
103 |           renderPresent      ren
104 |           currT           <- getSecondsTicks
105 |           st              <- execStateT st (t2w currT)
106 |           loop'              st ren win e currT
107 |
108 |       loop' : a -> Renderer -> Win -> Event -> Double -> IO ()
109 |       loop'   st ren win e lastTime with (eveType e)
110 |         loop' _  _   _   _ _        | E_QUIT = pure ()
111 |         loop' st ren win e lastTime | other  = do
112 |           st              <- execStateT st (e2w other)
113 |           loop               st ren win e lastTime