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
85
86
87
88
|
{-
Lines.hs (adapted from lines.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
This program demonstrates geometric primitives and their attributes.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
drawOneLine :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()
drawOneLine p1 p2 = renderPrimitive Lines $ do vertex p1; vertex p2
myInit :: IO ()
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Flat
display :: DisplayCallback
display = do
clear [ ColorBuffer ]
-- select white for all lines
color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)
-- in 1st row, 3 lines, each with a different stipple
lineStipple $= Just (1, 0x0101) -- dotted
drawOneLine (Vertex2 50 125) (Vertex2 150 125)
lineStipple $= Just (1, 0x00FF) -- dashed
drawOneLine (Vertex2 150 125) (Vertex2 50 125)
lineStipple $= Just (1, 0x1C47) -- dash/dot/dash
drawOneLine (Vertex2 250 125) (Vertex2 350 125)
-- in 2nd row, 3 wide lines, each with different stipple
lineWidth $= 5.0
lineStipple $= Just (1, 0x0101) -- dotted
drawOneLine (Vertex2 50 100) (Vertex2 150 100)
lineStipple $= Just (1, 0x00FF) -- dashed
drawOneLine (Vertex2 150 100) (Vertex2 250 100)
lineStipple $= Just (1, 0x1C47) -- dash/dot/dash
drawOneLine (Vertex2 250 100) (Vertex2 350 100)
lineWidth $= 1.0
-- in 3rd row, 6 lines, with dash/dot/dash stipple
-- as part of a single connected line strip
lineStipple $= Just (1, 0x1C47) -- dash/dot/dash
renderPrimitive LineStrip $ mapM_ vertex [ Vertex2 (50+(i*50)) (75 :: GLint) | i <- [0..6] ]
-- in 4th row, 6 independent lines with same stipple
sequence_ [ drawOneLine (Vertex2 (50+( i *50)) 50)
(Vertex2 (50+((i+1)*50)) 50) | i <- [0..5] ]
-- in 5th row, 1 line, with dash/dot/dash stipple
-- and a stipple repeat factor of 5
lineStipple $= Just (5, 0x1C47) -- dash/dot/dash
drawOneLine (Vertex2 50 25) (Vertex2 350 25)
lineStipple $= Nothing
flush
reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
ortho2D 0 (fromIntegral w) 0 (fromIntegral h)
-- the following line is not in the original example, but it's good style...
matrixMode $= Modelview 0
keyboard :: KeyboardMouseCallback
keyboard (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
-- Request double buffer display mode.
-- Register mouse input callback functions
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 400 150
initialWindowPosition $= Position 100 100
createWindow progName
myInit
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
mainLoop
|
