Liste de afișare

Cod Sursa Haskell

{-
Torus.hs (adapted from torus.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE

This program demonstrates the creation of a display list.
-}

import Data.Char ( toLower )
import Data.IORef ( IORef, newIORef )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT

data State = State { spinX, spinY :: IORef GLfloat }

makeState :: IO State
makeState = do
x <- newIORef 0
y <- newIORef 0
return $ State { spinX = x, spinY = y }

torus :: Int -> Int -> IO ()
torus numC numT = do
let stepC = 2 * pi / fromIntegral numC :: GLfloat
stepT = 2 * pi / fromIntegral numT
flip mapM_ [ 0 .. numC – 1 ] $ \i ->
renderPrimitive QuadStrip $
flip mapM_ [ 0 .. numT ] $ \j ->
flip mapM_ [ 1, 0 ] $ \k -> do
let s = (fromIntegral ((i + k) `mod` numC) + 0.5) * stepC
t = (fromIntegral ( j `mod` numT) ) * stepT
x = (1 + 0.1 * cos s) * cos t
y = (1 + 0.1 * cos s) * sin t
z = 0.1 * sin s
vertex (Vertex3 x y z)

myInit :: IO DisplayList
myInit = do
theTorus <- defineNewList Compile $
torus 8 25
shadeModel $= Flat
clearColor $= Color4 0 0 0 0
return theTorus

display :: State -> DisplayList -> DisplayCallback
display state theTorus = do
clear [ ColorBuffer ]
loadIdentity
lookAt (Vertex3 0 0 10) (Vertex3 0 0 0) (Vector3 0 1 0)
x <- get (spinX state)
rotate x (Vector3 1 0 0)
y <- get (spinY state)
rotate y (Vector3 0 1 0)
color (Color3 1 1 (1 :: GLfloat))
callList theTorus
flush

reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
perspective 30 (fromIntegral w / fromIntegral h) 1 100
matrixMode $= Modelview 0

incSpin :: IORef GLfloat -> IO ()
incSpin spinRef = do
let wrap n s = if s > n then s – n else s
spinRef $~ (wrap 360 . (+ 30))
postRedisplay Nothing

keyboard :: State -> KeyboardMouseCallback
keyboard state (Char c) Down _ _ = case toLower c of
‘x’ -> incSpin (spinX state)
‘y’ -> incSpin (spinY state)
‘i’ -> do spinX state $= 0; spinY state $= 0; postRedisplay Nothing
‘\27’ -> exitWith ExitSuccess
_ -> return ()
keyboard _ _ _ _ _ = return ()

main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 200 200
_ <- createWindow progName
state <- makeState
theTorus <- myInit
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboard state)
displayCallback $= display state theTorus
mainLoop

---

Cod Sursa Haskell

{-
DList.hs (adapted from list.c which is (c) Silicon Graphics, Inc)
Copyright (c) Sven Panne 2002-2005 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE

This program demonstrates how to make and execute a
display list. Note that attributes, such as current
color and matrix, are changed.
-}

import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT

myInit :: IO DisplayList
myInit = do
listName <- genObjectName
— resolve overloading, not needed in “real” programs
let color3f = color :: Color3 GLfloat -> IO ()
vertex2f = vertex :: Vertex2 GLfloat -> IO ()
translatef = translate :: Vector3 GLfloat -> IO ()
defineList listName Compile $ do
color3f (Color3 1 0 0) — current color red
renderPrimitive Triangles $ do
vertex2f (Vertex2 0 0)
vertex2f (Vertex2 1 0)
vertex2f (Vertex2 0 1)
translatef (Vector3 1.5 0.0 0.0) — move position
shadeModel $= Flat
return listName

drawLine :: IO ()
drawLine = do
— resolve overloading, not needed in “real” programs
let vertex2f = vertex :: Vertex2 GLfloat -> IO ()
renderPrimitive Lines $ do
vertex2f (Vertex2 0.0 0.5)
vertex2f (Vertex2 15.0 0.5)

display :: DisplayList -> DisplayCallback
display listName = do
— NOTE: The following ‘loadIdentity’ is missing in the original
— example, but without it the translatef calls accumulate and
— the graphics wander out of the window after a few redraws…
loadIdentity

clear [ ColorBuffer ]
— resolve overloading, not needed in “real” programs
let color3f = color :: Color3 GLfloat -> IO ()
color3f (Color3 0 1 0) — current color green
sequence_ (replicate 10 (callList listName)) — draw 10 triangles
drawLine — is this line green? NO!
— where is the line drawn?
flush

reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
let wf = fromIntegral w
hf = fromIntegral h
if w <= h
then ortho2D 0.0 2.0 (-0.5*hf/wf) (1.5*hf/wf)
else ortho2D 0.0 (2.0*wf/hf) (-0.5) 1.5
matrixMode $= Modelview 0
loadIdentity

keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()

— Open window with initial window size, title bar,
— RGBA display mode, and handle input events.
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 650 50
_ <- createWindow progName
listName <- myInit
reshapeCallback $= Just reshape
displayCallback $= display listName
keyboardMouseCallback $= Just keyboard
mainLoop

---

Cod Sursa Haskell

{-
Stroke.hs (adapted from stroke.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2006 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE

This program demonstrates some characters of a stroke (vector) font. The
characters are represented by display lists, which are given numbers which
correspond to the ASCII values of the characters. Use of callLists is
demonstrated.
-}

import Data.List ( genericLength )
import Foreign.C.String ( castCharToCChar )
import Foreign.Marshal.Array ( withArray )
import Graphics.UI.GLUT
import System.Exit ( exitWith, ExitCode(ExitSuccess) )

aData, eData, pData, rData, sData :: [[Vertex2 GLfloat]]
aData = [
[ Vertex2 0 0, Vertex2 0 9, Vertex2 1 10, Vertex2 4 10, Vertex2 5 9,
Vertex2 5 0 ],
[ Vertex2 0 5, Vertex2 5 5 ] ]

eData = [
[ Vertex2 5 0, Vertex2 0 0, Vertex2 0 10, Vertex2 5 10 ],
[ Vertex2 0 5, Vertex2 4 5 ] ]

pData = [
[ Vertex2 0 0, Vertex2 0 10, Vertex2 4 10, Vertex2 5 9, Vertex2 5 6,
Vertex2 4 5, Vertex2 0 5 ] ]

rData = [
[ Vertex2 0 0, Vertex2 0 10, Vertex2 4 10, Vertex2 5 9, Vertex2 5 6,
Vertex2 4 5, Vertex2 0 5 ],
[ Vertex2 3 5, Vertex2 5 0 ] ]

sData = [
[ Vertex2 0 1, Vertex2 1 0, Vertex2 4 0, Vertex2 5 1, Vertex2 5 4,
Vertex2 4 5, Vertex2 1 5, Vertex2 0 6, Vertex2 0 9, Vertex2 1 10,
Vertex2 4 10, Vertex2 5 9 ] ]

advance :: IO ()
advance = translate (Vector3 8 0 (0 :: GLfloat))

— drawLetter renders a letter with line segments given by the list of line
— strips.
drawLetter :: [[Vertex2 GLfloat]] -> IO ()
drawLetter lineStrips = do
mapM_ (renderPrimitive LineStrip . mapM_ vertex) lineStrips
advance

charToGLubyte :: Char -> GLubyte
charToGLubyte = fromIntegral . castCharToCChar

myInit :: IO ()
myInit = do
shadeModel $= Flat

(base@(DisplayList b):_) <- genObjectNames 128
listBase $= base
let charToDisplayList c = DisplayList (b + fromIntegral (charToGLubyte c))
mapM_ (\(c, d) -> defineList (charToDisplayList c) Compile d)
[ (‘A’, drawLetter aData),
(‘E’, drawLetter eData),
(‘P’, drawLetter pData),
(‘R’, drawLetter rData),
(‘S’, drawLetter sData),
(‘ ‘, advance) ]

test1, test2 :: String
test1 = “A SPARE SERAPE APPEARS AS”
test2 = “APES PREPARE RARE PEPPERS”

printStrokedString :: String -> IO ()
printStrokedString s =
withArray (map charToGLubyte s) $
callLists (genericLength s) UnsignedByte

display :: DisplayCallback
display = do
clear [ ColorBuffer ]

— resolve overloading, not needed in “real” programs
let color3f = color :: Color3 GLfloat -> IO ()
scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()
translatef = translate :: Vector3 GLfloat -> IO ()

color3f (Color3 1 1 1)
preservingMatrix $ do
scalef 2 2 2
translatef (Vector3 10 30 0)
printStrokedString test1
preservingMatrix $ do
scalef 2 2 2
translatef (Vector3 10 13 0)
printStrokedString test2
flush

reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
ortho2D 0 (fromIntegral w) 0 (fromIntegral h)
matrixMode $= Modelview 0

keyboard :: KeyboardMouseCallback
keyboard (Char c) Down _ _ = case c of
‘ ‘ -> postRedisplay Nothing
‘\27’ -> exitWith ExitSuccess
_ -> return ()
keyboard _ _ _ _ = return ()

— Main Loop: Open window with initial window size, title bar, RGBA display
— mode, and handle input events.
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 440 120
_ <- createWindow progName
myInit
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
displayCallback $= display
mainLoop