Obiecte Geometrice

Cod Sursa Haskell

{-
Lines.hs (adapted from lines.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 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 250 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

---

Cod Sursa Haskell

{-
Polys.hs (adapted from polys.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 polygon stippling.
-}

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

fly :: IO GLpolygonstipple
fly = newPolygonStipple [
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x03, 0x80, 0x01, 0xC0, 0x06, 0xC0, 0x03, 0x60,
0x04, 0x60, 0x06, 0x20, 0x04, 0x30, 0x0C, 0x20,
0x04, 0x18, 0x18, 0x20, 0x04, 0x0C, 0x30, 0x20,
0x04, 0x06, 0x60, 0x20, 0x44, 0x03, 0xC0, 0x22,
0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,
0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,
0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,
0x66, 0x01, 0x80, 0x66, 0x33, 0x01, 0x80, 0xCC,
0x19, 0x81, 0x81, 0x98, 0x0C, 0xC1, 0x83, 0x30,
0x07, 0xe1, 0x87, 0xe0, 0x03, 0x3f, 0xfc, 0xc0,
0x03, 0x31, 0x8c, 0xc0, 0x03, 0x33, 0xcc, 0xc0,
0x06, 0x64, 0x26, 0x60, 0x0c, 0xcc, 0x33, 0x30,
0x18, 0xcc, 0x33, 0x18, 0x10, 0xc4, 0x23, 0x08,
0x10, 0x63, 0xC6, 0x08, 0x10, 0x30, 0x0c, 0x08,
0x10, 0x18, 0x18, 0x08, 0x10, 0x00, 0x00, 0x08]

halftone :: IO GLpolygonstipple
halftone = newPolygonStipple . take 128 . cycle $ [
0xAA, 0xAA, 0xAA, 0xAA, 0x55, 0x55, 0x55, 0x55]

display :: (GLpolygonstipple, GLpolygonstipple) -> DisplayCallback
display (flyStipple, halftoneStipple) = do
clear [ ColorBuffer ]
— resolve overloading, not needed in “real” programs
let color3f = color :: Color3 GLfloat -> IO ()
rectf = rect :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()
color3f (Color3 1 1 1)

— draw one solid, unstippled rectangle,
— then two stippled rectangles
rectf (Vertex2 25 25) (Vertex2 125 125)
polygonStipple $= Just flyStipple
rectf (Vertex2 125 25) (Vertex2 225 125)
polygonStipple $= Just halftoneStipple
rectf (Vertex2 225 25) (Vertex2 325 125)
polygonStipple $= (Nothing :: Maybe GLpolygonstipple)

flush

myInit :: IO (GLpolygonstipple, GLpolygonstipple)
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Flat
flyStipple <- fly
halftoneStipple <- halftone
return (flyStipple, halftoneStipple)

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

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

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

---

Cod Sursa Haskell

{-
VArray.hs (adapted from varray.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 vertex arrays.
-}

import Control.Monad ( when )
import Data.IORef ( IORef, newIORef )
import Foreign ( Ptr, newArray )
import System.Exit ( exitFailure, exitWith, ExitCode(..) )
import Graphics.UI.GLUT

data SetupMethod = Pointer | Interleaved
deriving ( Eq, Bounded, Enum )

data DerefMethod = DrawArray | ArrayElement | DrawElements
deriving ( Eq, Bounded, Enum )

makeVertices :: IO (Ptr (Vertex2 GLint))
makeVertices = newArray [
Vertex2 25 25,
Vertex2 100 325,
Vertex2 175 25,
Vertex2 175 325,
Vertex2 250 25,
Vertex2 325 325 ]

makeColors :: IO (Ptr (Color3 GLfloat))
makeColors = newArray [
Color3 1.0 0.2 0.2,
Color3 0.2 0.2 1.0,
Color3 0.8 1.0 0.2,
Color3 0.75 0.75 0.75,
Color3 0.35 0.35 0.35,
Color3 0.5 0.5 0.5 ]

makeIntertwined :: IO (Ptr GLfloat)
makeIntertwined = newArray [
1.0, 0.2, 1.0, 100.0, 100.0, 0.0,
1.0, 0.2, 0.2, 0.0, 200.0, 0.0,
1.0, 1.0, 0.2, 100.0, 300.0, 0.0,
0.2, 1.0, 0.2, 200.0, 300.0, 0.0,
0.2, 1.0, 1.0, 300.0, 200.0, 0.0,
0.2, 0.2, 1.0, 200.0, 100.0, 0.0 ]

makeIndices :: IO (Ptr GLuint)
makeIndices = newArray [ 0, 1, 3, 4 ]

data State = State {
vertices :: Ptr (Vertex2 GLint),
colors :: Ptr (Color3 GLfloat),
intertwined :: Ptr GLfloat,
indices :: Ptr GLuint,
setupMethod :: IORef SetupMethod,
derefMethod :: IORef DerefMethod }

makeState :: IO State
makeState = do
v <- makeVertices
c <- makeColors
i <- makeIntertwined
n <- makeIndices
s <- newIORef Pointer
d <- newIORef DrawArray
return $ State { vertices = v, colors = c, intertwined = i,
indices = n, setupMethod = s, derefMethod = d }

setup :: State -> IO ()
setup state = do
s <- get (setupMethod state)
case s of
Pointer -> do
clientState VertexArray $= Enabled
clientState ColorArray $= Enabled
arrayPointer VertexArray $= VertexArrayDescriptor 2 Int 0 (vertices state)
arrayPointer ColorArray $= VertexArrayDescriptor 3 Float 0 (colors state)
Interleaved ->
interleavedArrays C3fV3f 0 (intertwined state)

myInit :: State -> IO ()
myInit state = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
setup state

display :: State -> DisplayCallback
display state = do
clear [ ColorBuffer ]
d <- get (derefMethod state)
case d of
DrawArray -> drawArrays Triangles 0 6
ArrayElement -> renderPrimitive Triangles $ mapM_ arrayElement [ 2, 3, 5 ]
DrawElements -> drawElements Polygon 4 UnsignedInt (indices state)
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

keyboardMouse :: State -> KeyboardMouseCallback
keyboardMouse state (MouseButton LeftButton) Down _ _ = do
setupMethod state $~ nextValue
setup state
postRedisplay Nothing
keyboardMouse state (MouseButton _) Down _ _ = do
derefMethod state $~ nextValue
postRedisplay Nothing
keyboardMouse _ (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ _ = return ()

nextValue :: (Eq a, Bounded a, Enum a) => a -> a
nextValue x = if x == maxBound then minBound else succ x

main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 350 350
initialWindowPosition $= Position 100 100
_ <- createWindow progName
— we have to do this *after* createWindow, otherwise we have no OpenGL context
version <- get (majorMinor glVersion)
when (version == (1,0)) $ do
putStrLn “This program demonstrates a feature which is not in OpenGL Version 1.0.”
putStrLn “If your implementation of OpenGL Version 1.0 has the right extensions,”
putStrLn “you may be able to modify this program to make it run.”
exitFailure
state <- makeState
myInit state
displayCallback $= display state
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboardMouse state)
mainLoop

---

Cod Sursa Haskell

{-
MVArray.hs (adapted from mvarray.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 multiple vertex arrays, specifically the OpenGL
routine multiDrawElements.
-}

import Control.Monad ( unless )
import Data.List ( genericLength )
import Foreign ( Storable, Ptr, newArray )
import System.Exit ( exitFailure, exitWith, ExitCode(..) )
import Graphics.UI.GLUT

data MultiDrawInfo a = MultiDrawInfo (Ptr GLsizei) (Ptr (Ptr a)) GLsizei

makeMultiDrawInfo :: Storable a => [[a]] -> IO (MultiDrawInfo a)
makeMultiDrawInfo indicesLists = do
count <- newArray $ map genericLength indicesLists
indices <- newArray =<< mapM newArray indicesLists
return $ MultiDrawInfo count indices (genericLength indicesLists)

setupPointer :: IO ()
setupPointer = do
clientState VertexArray $= Enabled
vertices <- newArray ([
Vertex2 25 25,
Vertex2 75 75,
Vertex2 100 125,
Vertex2 150 75,
Vertex2 200 175,
Vertex2 250 150,
Vertex2 300 125,
Vertex2 100 200,
Vertex2 150 250,
Vertex2 200 225,
Vertex2 250 300,
Vertex2 300 250 ] :: [Vertex2 GLint])
arrayPointer VertexArray $= VertexArrayDescriptor 2 Int 0 vertices

myInit :: IO (MultiDrawInfo GLubyte)
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
setupPointer
makeMultiDrawInfo [ [ 0, 1, 2, 3, 4, 5, 6 ],
[ 1, 7, 8, 9, 10, 11 ] ]

display :: MultiDrawInfo GLubyte -> DisplayCallback
display (MultiDrawInfo count indices primCount) = do
clear [ ColorBuffer ]
color (Color3 1 1 1 :: Color3 GLfloat)
multiDrawElements LineStrip count UnsignedByte indices primCount
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 ()

main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 350 350
initialWindowPosition $= Position 100 100
_ <- createWindow progName
— we have to do this *after* createWindow, otherwise we have no OpenGL context
exts <- get glExtensions
unless (“GL_EXT_multi_draw_arrays” `elem` exts) $ do
putStrLn “Sorry, this demo requires the GL_EXT_multi_draw_arrays extension.”
exitFailure
multiDrawInfo <- myInit
displayCallback $= display multiDrawInfo
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
mainLoop