{-
Light.hs (adapted from light.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
Light.hs (adapted from light.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 the use of the OpenGL lighting model. A sphere
is drawn using a grey material characteristic. A single light source
illuminates the object.
-}
is drawn using a grey material characteristic. A single light source
illuminates the object.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import Graphics.UI.GLUT
myInit :: IO ()
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 50
position (Light 0) $= Vertex4 1 1 1 0
materialShininess Front $= 50
position (Light 0) $= Vertex4 1 1 1 0
lighting $= Enabled
light (Light 0) $= Enabled
depthFunc $= Just Less
light (Light 0) $= Enabled
depthFunc $= Just Less
display :: DisplayCallback
display = do
clear [ ColorBuffer, DepthBuffer ]
renderObject Solid (Sphere’ 1 20 16)
flush
display = do
clear [ ColorBuffer, DepthBuffer ]
renderObject Solid (Sphere’ 1 20 16)
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 ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10
else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10
matrixMode $= Modelview 0
loadIdentity
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 ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10
else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10
matrixMode $= Modelview 0
loadIdentity
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
myInit
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
mainLoop
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
myInit
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboard
mainLoop
{-
MoveLight.hs (adapted from movelight.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
MoveLight.hs (adapted from movelight.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 when to issue lighting and transformation
commands to render a model with a light which is moved by a
modeling transformation (rotate or translate). The light position
is reset after the modeling transformation is called. The eye
position does not change.
commands to render a model with a light which is moved by a
modeling transformation (rotate or translate). The light position
is reset after the modeling transformation is called. The eye
position does not change.
A sphere is drawn using a grey material characteristic. A single
light source illuminates the object.
light source illuminates the object.
Interaction: pressing the left mouse button alters the modeling
transformation (x rotation) by 30 degrees. The scene is then
redrawn with the light in a new position.
-}
transformation (x rotation) by 30 degrees. The scene is then
redrawn with the light in a new position.
-}
import Data.IORef ( IORef, newIORef )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
data State = State { spin :: IORef Int }
makeState :: IO State
makeState = do
s <- newIORef 0
return $ State { spin = s }
makeState = do
s <- newIORef 0
return $ State { spin = s }
myInit :: IO ()
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
lighting $= Enabled
light (Light 0) $= Enabled
depthFunc $= Just Less
myInit = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
lighting $= Enabled
light (Light 0) $= Enabled
depthFunc $= Just Less
display :: State -> DisplayCallback
display state = do
clear [ ColorBuffer, DepthBuffer ]
preservingMatrix $ do
lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)
preservingMatrix $ do
s <- get (spin state)
rotate (fromIntegral s :: GLdouble) (Vector3 1 0 0)
position (Light 0) $= Vertex4 0 0 1.5 1
translate (Vector3 0 0 1.5 :: Vector3 GLdouble)
lighting $= Disabled
color (Color3 0 1 1 :: Color3 GLfloat)
renderObject Wireframe (Cube 0.1)
lighting $= Enabled
renderObject Solid (Torus 0.275 0.85 8 15)
flush
display state = do
clear [ ColorBuffer, DepthBuffer ]
preservingMatrix $ do
lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)
preservingMatrix $ do
s <- get (spin state)
rotate (fromIntegral s :: GLdouble) (Vector3 1 0 0)
position (Light 0) $= Vertex4 0 0 1.5 1
translate (Vector3 0 0 1.5 :: Vector3 GLdouble)
lighting $= Disabled
color (Color3 0 1 1 :: Color3 GLfloat)
renderObject Wireframe (Cube 0.1)
lighting $= Enabled
renderObject Solid (Torus 0.275 0.85 8 15)
flush
reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
perspective 40 (fromIntegral w / fromIntegral h) 1 20
matrixMode $= Modelview 0
loadIdentity
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
perspective 40 (fromIntegral w / fromIntegral h) 1 20
matrixMode $= Modelview 0
loadIdentity
keyboardMouse :: State -> KeyboardMouseCallback
keyboardMouse state (MouseButton LeftButton) Down _ _ = do
spin state $~ ((`mod` 360) . (+ 30))
postRedisplay Nothing
keyboardMouse _ (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ _ = return ()
keyboardMouse state (MouseButton LeftButton) Down _ _ = do
spin state $~ ((`mod` 360) . (+ 30))
postRedisplay Nothing
keyboardMouse _ (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ _ = return ()
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
state <- makeState
myInit
displayCallback $= display state
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboardMouse state)
mainLoop
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
state <- makeState
myInit
displayCallback $= display state
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboardMouse state)
mainLoop
{-
Material.hs (adapted from material.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
Material.hs (adapted from material.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 the use of the GL lighting model. Several
objects are drawn using different material characteristics. A single
light source illuminates the objects.
-}
objects are drawn using different material characteristics. A single
light source illuminates the objects.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import Graphics.UI.GLUT
— Initialize z-buffer, projection matrix, light source, and lighting model.
— Do not specify a material property here.
— Do not specify a material property here.
myInit :: IO ()
myInit = do
clearColor $= Color4 0 0.1 0.1 0
depthFunc $= Just Less
shadeModel $= Smooth
myInit = do
clearColor $= Color4 0 0.1 0.1 0
depthFunc $= Just Less
shadeModel $= Smooth
ambient (Light 0) $= Color4 0 0 0 1
diffuse (Light 0) $= Color4 1 1 1 1
position (Light 0) $= Vertex4 0 3 2 0
lightModelAmbient $= Color4 0.4 0.4 0.4 1
lightModelLocalViewer $= Disabled
diffuse (Light 0) $= Color4 1 1 1 1
position (Light 0) $= Vertex4 0 3 2 0
lightModelAmbient $= Color4 0.4 0.4 0.4 1
lightModelLocalViewer $= Disabled
lighting $= Enabled
light (Light 0) $= Enabled
light (Light 0) $= Enabled
— Draw twelve spheres in 3 rows with 4 columns.
— The spheres in the first row have materials with no ambient reflection.
— The second row has materials with significant ambient reflection.
— The third row has materials with colored ambient reflection.
—
— The first column has materials with blue, diffuse reflection only.
— The second column has blue diffuse reflection, as well as specular
— reflection with a low shininess exponent.
— The third column has blue diffuse reflection, as well as specular
— reflection with a high shininess exponent (a more concentrated highlight).
— The fourth column has materials which also include an emissive component.
—
— translate is used to move spheres to their appropriate locations.
— The spheres in the first row have materials with no ambient reflection.
— The second row has materials with significant ambient reflection.
— The third row has materials with colored ambient reflection.
—
— The first column has materials with blue, diffuse reflection only.
— The second column has blue diffuse reflection, as well as specular
— reflection with a low shininess exponent.
— The third column has blue diffuse reflection, as well as specular
— reflection with a high shininess exponent (a more concentrated highlight).
— The fourth column has materials which also include an emissive component.
—
— translate is used to move spheres to their appropriate locations.
display :: DisplayCallback
display = do
clear [ ColorBuffer, DepthBuffer ]
display = do
clear [ ColorBuffer, DepthBuffer ]
let draw :: GLfloat -> GLfloat -> Color4 GLfloat -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> Color4 GLfloat -> IO ()
draw row column amb dif spc shi emi =
preservingMatrix $ do
translate (Vector3 (2.5 * (column – 2.5)) (3 * (2 – row)) 0)
materialAmbient Front $= amb
materialDiffuse Front $= dif
materialSpecular Front $= spc
materialShininess Front $= shi
materialEmission Front $= emi
renderObject Solid (Sphere’ 1 16 16)
draw row column amb dif spc shi emi =
preservingMatrix $ do
translate (Vector3 (2.5 * (column – 2.5)) (3 * (2 – row)) 0)
materialAmbient Front $= amb
materialDiffuse Front $= dif
materialSpecular Front $= spc
materialShininess Front $= shi
materialEmission Front $= emi
renderObject Solid (Sphere’ 1 16 16)
noMat = Color4 0 0 0 1
matAmbient = Color4 0.7 0.7 0.7 1
matAmbientColor = Color4 0.8 0.8 0.2 1
matDiffuse = Color4 0.1 0.5 0.8 1
matSpecular = Color4 1 1 1 1
noShininess = 0
lowShininess = 5
highShininess = 100
matEmission = Color4 0.3 0.2 0.2 0
matAmbient = Color4 0.7 0.7 0.7 1
matAmbientColor = Color4 0.8 0.8 0.2 1
matDiffuse = Color4 0.1 0.5 0.8 1
matSpecular = Color4 1 1 1 1
noShininess = 0
lowShininess = 5
highShininess = 100
matEmission = Color4 0.3 0.2 0.2 0
— draw sphere in first row, first column
— diffuse reflection only; no ambient or specular
draw 1 1 noMat matDiffuse noMat noShininess noMat
— diffuse reflection only; no ambient or specular
draw 1 1 noMat matDiffuse noMat noShininess noMat
— draw sphere in first row, second column
— diffuse and specular reflection; low shininess; no ambient
draw 1 2 noMat matDiffuse matSpecular lowShininess noMat
— diffuse and specular reflection; low shininess; no ambient
draw 1 2 noMat matDiffuse matSpecular lowShininess noMat
— draw sphere in first row, third column
— diffuse and specular reflection; high shininess; no ambient
draw 1 3 noMat matDiffuse matSpecular highShininess noMat
— diffuse and specular reflection; high shininess; no ambient
draw 1 3 noMat matDiffuse matSpecular highShininess noMat
— draw sphere in first row, fourth column
— diffuse reflection; emission; no ambient or specular reflection
draw 1 4 noMat matDiffuse noMat noShininess matEmission
— diffuse reflection; emission; no ambient or specular reflection
draw 1 4 noMat matDiffuse noMat noShininess matEmission
— draw sphere in second row, first column
— ambient and diffuse reflection; no specular
draw 2 1 matAmbient matDiffuse noMat noShininess noMat
— ambient and diffuse reflection; no specular
draw 2 1 matAmbient matDiffuse noMat noShininess noMat
— draw sphere in second row, second column
— ambient, diffuse and specular reflection; low shininess
draw 2 2 matAmbient matDiffuse matSpecular lowShininess noMat
— ambient, diffuse and specular reflection; low shininess
draw 2 2 matAmbient matDiffuse matSpecular lowShininess noMat
— draw sphere in second row, third column
— ambient, diffuse and specular reflection; high shininess
draw 2 3 matAmbient matDiffuse matSpecular highShininess noMat
— ambient, diffuse and specular reflection; high shininess
draw 2 3 matAmbient matDiffuse matSpecular highShininess noMat
— draw sphere in second row, fourth column
— ambient and diffuse reflection; emission; no specular
draw 2 4 matAmbient matDiffuse noMat noShininess matEmission
— ambient and diffuse reflection; emission; no specular
draw 2 4 matAmbient matDiffuse noMat noShininess matEmission
— draw sphere in third row, first column
— colored ambient and diffuse reflection; no specular
draw 3 1 matAmbientColor matDiffuse noMat noShininess noMat
— colored ambient and diffuse reflection; no specular
draw 3 1 matAmbientColor matDiffuse noMat noShininess noMat
— draw sphere in third row, second column
— colored ambient, diffuse and specular reflection; low shininess
draw 3 2 matAmbientColor matDiffuse matSpecular lowShininess noMat
— colored ambient, diffuse and specular reflection; low shininess
draw 3 2 matAmbientColor matDiffuse matSpecular lowShininess noMat
— draw sphere in third row, third column
— colored ambient, diffuse and specular reflection; high shininess
draw 3 3 matAmbientColor matDiffuse matSpecular highShininess noMat
— colored ambient, diffuse and specular reflection; high shininess
draw 3 3 matAmbientColor matDiffuse matSpecular highShininess noMat
— draw sphere in third row, fourth column
— colored ambient and diffuse reflection; emission; no specular
draw 3 4 matAmbientColor matDiffuse noMat noShininess matEmission
— colored ambient and diffuse reflection; emission; no specular
draw 3 4 matAmbientColor matDiffuse noMat noShininess matEmission
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 * 2
then ortho (-6) 6 (-3 * (hf * 2) / wf) (3 * (hf * 2) / wf) (-10) 10
else ortho (-6 * wf / (hf * 2)) (6 * wf / (hf * 2)) (-3) 3 (-10) 10
matrixMode $= Modelview 0
loadIdentity
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
let wf = fromIntegral w
hf = fromIntegral h
if w <= h * 2
then ortho (-6) 6 (-3 * (hf * 2) / wf) (3 * (hf * 2) / wf) (-10) 10
else ortho (-6 * wf / (hf * 2)) (6 * wf / (hf * 2)) (-3) 3 (-10) 10
matrixMode $= Modelview 0
loadIdentity
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 600 450
_ <- createWindow progName
myInit
reshapeCallback $= Just reshape
displayCallback $= display
keyboardMouseCallback $= Just keyboard
mainLoop
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 600 450
_ <- createWindow progName
myInit
reshapeCallback $= Just reshape
displayCallback $= display
keyboardMouseCallback $= Just keyboard
mainLoop
{-
Light.hs (adapted from light.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
Light.hs (adapted from light.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
After initialization, the program will be in ColorMaterial mode.
Interaction: pressing the mouse buttons will change the diffuse
reflection values.
-}
Interaction: pressing the mouse buttons will change the diffuse
reflection values.
-}
import Data.IORef ( IORef, newIORef )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
data State = State { r, g, b :: IORef GLfloat }
diffuseMaterial :: State -> IO (Color4 GLfloat)
diffuseMaterial state = do
r’ <- get (r state)
g’ <- get (g state)
b’ <- get (b state)
return $ Color4 r’ g’ b’ 1
diffuseMaterial state = do
r’ <- get (r state)
g’ <- get (g state)
b’ <- get (b state)
return $ Color4 r’ g’ b’ 1
makeState :: IO State
makeState = do
r’ <- newIORef 0.5
g’ <- newIORef 0.5
b’ <- newIORef 0.5
return $ State { r = r’, g = g’, b = b’ }
makeState = do
r’ <- newIORef 0.5
g’ <- newIORef 0.5
b’ <- newIORef 0.5
return $ State { r = r’, g = g’, b = b’ }
— Initialize material property, light source, lighting model,
— and depth buffer.
myInit :: State -> IO ()
myInit state = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
depthFunc $= Just Less
dm <- diffuseMaterial state
materialDiffuse Front $= dm
materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 25
position (Light 0) $= Vertex4 1 1 1 0
lighting $= Enabled
light (Light 0) $= Enabled
colorMaterial $= Just (Front, Diffuse)
— and depth buffer.
myInit :: State -> IO ()
myInit state = do
clearColor $= Color4 0 0 0 0
shadeModel $= Smooth
depthFunc $= Just Less
dm <- diffuseMaterial state
materialDiffuse Front $= dm
materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 25
position (Light 0) $= Vertex4 1 1 1 0
lighting $= Enabled
light (Light 0) $= Enabled
colorMaterial $= Just (Front, Diffuse)
display :: DisplayCallback
display = do
clear [ ColorBuffer, DepthBuffer ]
renderObject Solid (Sphere’ 1 20 16)
flush
display = do
clear [ ColorBuffer, DepthBuffer ]
renderObject Solid (Sphere’ 1 20 16)
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 ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10
else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10
matrixMode $= Modelview 0
loadIdentity
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 ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10
else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10
matrixMode $= Modelview 0
loadIdentity
keyboardMouse :: State -> KeyboardMouseCallback
keyboardMouse state (MouseButton button) Down _ _ = case button of
LeftButton -> update r
MiddleButton -> update g
RightButton -> update b
_ -> return ()
where update component = do
component state $~ inc
dm <- diffuseMaterial state
color dm
postRedisplay Nothing
inc x = let s = x + 0.1 in if s > 1 then 0 else s
keyboardMouse _ (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ _ = return ()
keyboardMouse state (MouseButton button) Down _ _ = case button of
LeftButton -> update r
MiddleButton -> update g
RightButton -> update b
_ -> return ()
where update component = do
component state $~ inc
dm <- diffuseMaterial state
color dm
postRedisplay Nothing
inc x = let s = x + 0.1 in if s > 1 then 0 else s
keyboardMouse _ (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ _ = return ()
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
state <- makeState
myInit state
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboardMouse state)
mainLoop
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
state <- makeState
myInit state
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just (keyboardMouse state)
mainLoop
{-
Scene.hs (adapted from scene.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
Scene.hs (adapted from scene.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 the use of the GL lighting model. Objects are
drawn using a grey material characteristic. A single light source
illuminates the objects.
-}
drawn using a grey material characteristic. A single light source
illuminates the objects.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import Graphics.UI.GLUT
— Initialize material property and light source.
myInit :: IO ()
myInit = do
ambient (Light 0) $= Color4 0 0 0 1
diffuse (Light 0) $= Color4 1 1 1 1
specular (Light 0) $= Color4 1 1 1 1
— light position is NOT default value
position (Light 0) $= Vertex4 1 1 1 0
myInit :: IO ()
myInit = do
ambient (Light 0) $= Color4 0 0 0 1
diffuse (Light 0) $= Color4 1 1 1 1
specular (Light 0) $= Color4 1 1 1 1
— light position is NOT default value
position (Light 0) $= Vertex4 1 1 1 0
lighting $= Enabled
light (Light 0) $= Enabled
depthFunc $= Just Less
light (Light 0) $= Enabled
depthFunc $= Just Less
display :: DisplayCallback
display = do
clear [ ColorBuffer, DepthBuffer ]
preservingMatrix $ do
rotate (20 :: GLfloat) (Vector3 1 0 0)
preservingMatrix $ do
translate (Vector3 (-0.75) 0.5 (0 :: GLfloat))
rotate (90 :: GLfloat) (Vector3 1 0 0)
renderObject Solid (Torus 0.275 0.85 15 15)
preservingMatrix $ do
translate (Vector3 (-0.75) (-0.5) (0 :: GLfloat))
rotate (270 :: GLfloat) (Vector3 1 0 0)
renderObject Solid (Cone 1 2 15 15)
preservingMatrix $ do
translate (Vector3 0.75 0 (-1 :: GLfloat))
renderObject Solid (Sphere’ 1 15 15)
flush
display = do
clear [ ColorBuffer, DepthBuffer ]
preservingMatrix $ do
rotate (20 :: GLfloat) (Vector3 1 0 0)
preservingMatrix $ do
translate (Vector3 (-0.75) 0.5 (0 :: GLfloat))
rotate (90 :: GLfloat) (Vector3 1 0 0)
renderObject Solid (Torus 0.275 0.85 15 15)
preservingMatrix $ do
translate (Vector3 (-0.75) (-0.5) (0 :: GLfloat))
rotate (270 :: GLfloat) (Vector3 1 0 0)
renderObject Solid (Cone 1 2 15 15)
preservingMatrix $ do
translate (Vector3 0.75 0 (-1 :: GLfloat))
renderObject Solid (Sphere’ 1 15 15)
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 ortho (-2.5) 2.5 (-2.5 * hf/wf) (2.5 * hf/wf) (-10) 10
else ortho (-2.5 * wf/hf) (2.5 * wf/hf) (-2.5) 2.5 (-10) 10
matrixMode $= Modelview 0
loadIdentity
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 ortho (-2.5) 2.5 (-2.5 * hf/wf) (2.5 * hf/wf) (-10) 10
else ortho (-2.5 * wf/hf) (2.5 * wf/hf) (-2.5) 2.5 (-10) 10
matrixMode $= Modelview 0
loadIdentity
keyboard :: KeyboardMouseCallback
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
keyboard (Char ‘\27’) Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
_ <- createWindow progName
myInit
reshapeCallback $= Just reshape
displayCallback $= display
keyboardMouseCallback $= Just keyboard
mainLoop
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 500 500
_ <- createWindow progName
myInit
reshapeCallback $= Just reshape
displayCallback $= display
keyboardMouseCallback $= Just keyboard
mainLoop
InfoCad Blog 