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 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 
84 

import System.Exit
import Graphics.UI.SDL as SDL
import Graphics.Rendering.OpenGL as GL

main = do
    initSDL width height
    initGL width height
    drawScene
    inputLoop
    where
        width = 640
        height = 480

initSDL width height = do
    SDL.init [SDL.InitVideo]
    s <- SDL.setVideoMode width height 32 [SDL.OpenGL]
    return ()

initGL :: Int -> Int -> IO ()
initGL width height = do
    SDL.glSetAttribute glDoubleBuffer 1
    SDL.glSetAttribute glDepthSize 16
    SDL.glSetAttribute glRedSize 8
    SDL.glSetAttribute glGreenSize 8
    SDL.glSetAttribute glBlueSize 8
    SDL.glSetAttribute glAlphaSize 8

    GL.viewport $= ((Position 0 0), (Size (fromIntegral width) (fromIntegral height)))
    GL.clearColor $= (Color4 0.0 0.0 0.0 0.0)
    GL.clearDepth $= 1.0
    GL.depthFunc $= (Just Less)
    -- GL.enable -- TODO: where is the enable function?
    GL.shadeModel $= Smooth
    GL.matrixMode $= Projection
    GL.loadIdentity
    GL.perspective 45.0 (dwidth/dheight) 0.1 100.0
    GL.matrixMode $= Modelview 0
    return ()
    where
        dwidth = (fromIntegral width) :: GLdouble
        dheight = (fromIntegral height) :: GLdouble

inputLoop = do
    e <- SDL.waitEvent
    case e of
        SDL.KeyDown k -> keyDown k
        SDL.Quit -> exitWith ExitSuccess
        _ -> return ()
    inputLoop

keyDown :: SDL.Keysym -> IO ()
keyDown (Keysym key _ _) = do
    case key of
        SDLK_f -> do
            s <- SDL.getVideoSurface
            SDL.toggleFullscreen s
            drawScene
        SDLK_q -> exitWith ExitSuccess
        _ -> return ()
    return ()

drawScene = do
    GL.clear [ColorBuffer, DepthBuffer]
    GL.loadIdentity
    GL.translate (Vector3 (-1.5) 0.0 6.0 :: Vector3 Float)

    GL.renderPrimitive Triangles $ do
        vertex $ (Vertex3   0.0   1.0   0.0 :: Vertex3 Float)
        vertex $ (Vertex3 (-1.0) (-1.0) 0.0 :: Vertex3 Float)
        vertex $ (Vertex3   1.0  (-1.0) 0.0 :: Vertex3 Float)
        return ()

    GL.translate (Vector3 3.0 0.0 0.0 :: Vector3 Float)

    GL.renderPrimitive Quads $ do
        vertex $ (Vertex3 (-1.0)   1.0  0.0 :: Vertex3 Float)
        vertex $ (Vertex3   1.0    1.0  0.0 :: Vertex3 Float)
        vertex $ (Vertex3   1.0  (-1.0) 0.0 :: Vertex3 Float)
        vertex $ (Vertex3 (-1.0) (-1.0) 0.0 :: Vertex3 Float)
        return ()

    SDL.glSwapBuffers
    return ()