File: Lesson05.hs

package info (click to toggle)
haskell-sdl2 2.5.5.0-2
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 17,348 kB
  • sloc: haskell: 10,160; ansic: 102; makefile: 5
file content (48 lines) | stat: -rw-r--r-- 1,299 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Lazyfoo.Lesson05 (main) where

import Control.Monad
import Foreign.C.Types
import SDL.Vect
import qualified SDL

import Paths_sdl2 (getDataFileName)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

screenWidth, screenHeight :: CInt
(screenWidth, screenHeight) = (640, 480)

loadSurface :: SDL.Surface -> FilePath -> IO SDL.Surface
loadSurface screenSurface path = do
  loadedSurface <- getDataFileName path >>= SDL.loadBMP
  desiredFormat <- SDL.surfaceFormat screenSurface
  SDL.convertSurface loadedSurface desiredFormat <* SDL.freeSurface loadedSurface

main :: IO ()
main = do
  SDL.initialize [SDL.InitVideo]
  window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight }
  SDL.showWindow window
  screenSurface <- SDL.getWindowSurface window

  stretchedSurface <- loadSurface screenSurface "examples/lazyfoo/stretch.bmp"

  let
    loop = do
      events <- SDL.pollEvents
      let quit = elem SDL.QuitEvent $ map SDL.eventPayload events

      SDL.surfaceBlitScaled stretchedSurface Nothing screenSurface Nothing
      SDL.updateWindowSurface window

      unless quit loop

  loop

  SDL.freeSurface stretchedSurface
  SDL.destroyWindow window
  SDL.quit