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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module TwinkleBear.Lesson04 (main) where
import Prelude hiding (init)
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)
data RenderPos = Centered | At (Point V2 CInt)
loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture
loadTexture renderer path = do
bmp <- SDL.loadBMP path
SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp
renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO ()
renderTexture renderer tex pos = do
ti <- SDL.queryTexture tex
let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti)
pos' = case pos of
At p -> p
Centered -> let cntr a b = (a - b) `div` 2
in P $ V2 (cntr screenWidth w) (cntr screenHeight h)
extent = V2 w h
SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent)
main :: IO ()
main = do
SDL.initialize [ SDL.InitVideo ]
let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight }
window <- SDL.createWindow "Lesson 4" winConfig
renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
image <- getDataFileName "examples/twinklebear/event-driven.bmp" >>= loadTexture renderer
let loop = do
renderTexture renderer image Centered
SDL.present renderer
quit <- fmap (\ev -> case SDL.eventPayload ev of
SDL.QuitEvent -> True
SDL.KeyboardEvent e -> SDL.keyboardEventKeyMotion e == SDL.Pressed
SDL.MouseButtonEvent e -> SDL.mouseButtonEventMotion e == SDL.Pressed
_ -> False) SDL.waitEvent
unless quit loop
loop
SDL.destroyTexture image
SDL.destroyRenderer renderer
SDL.destroyWindow window
SDL.quit
|
