john7rv

ライトの設定は

lighting $= Enabled
light (Light 0) $= Enabled

でできます
ライトの位置は

position (Light 0) $= Vertex4 1 1 1 0

です

materialSpecular Front $= Color4 1 1 1 1
materialShininess Front $= 30  

で発光なども調整します

ライトの中で立方体を回転させるプログラム　light.hs
ソース全文

import Data.IORef 
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU


data State = State { rotation :: IORef GLfloat }
timerInterval = 25

makeState :: IO State
makeState = do
   d <- newIORef (0.0)
   return $ State { rotation = d }
   
plusRotation :: State -> GLfloat -> IO ()
plusRotation state inc = do
   rotation state $~ (+ inc)
   postRedisplay Nothing

       
  
  
keyboard :: State -> KeyboardMouseCallback
keyboard state (Char c) Down _ _ = case c of
   '\27' -> exitWith ExitSuccess
   _     -> return ()
keyboard _ _ _ _ _ = return ()

reshape :: ReshapeCallback
reshape size@(Size width height) = do      
    viewport $= (Position 0 0, size)
    matrixMode $= Projection
    loadIdentity
    perspective 90 (fromIntegral width / fromIntegral height) 1 100
    matrixMode $= Modelview 0
    
timerProc func1 = do
    func1
    addTimerCallback timerInterval $ timerProc func1    
    
  
myInit :: IO ()
myInit = do
   clearColor $= Color4 0 0 0 0
   shadeModel $= Smooth
   depthFunc $= Just Less
   materialSpecular Front $= Color4 1 1 1 1
   materialShininess Front $= 30
   position (Light 0) $= Vertex4 1 1 1 0
   lighting $= Enabled
   light (Light 0) $= Enabled  
    
   
display :: State -> DisplayCallback
display state = do
   plusRotation state (-0.5)
   loadIdentity
   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)
   clear [ ColorBuffer, DepthBuffer ]

   let color3f = color :: Color3 GLfloat -> IO ()
       vertex3f = vertex :: Vertex3 GLfloat -> IO ()

   r <- get (rotation state)
   preservingMatrix $ do
     rotate r (Vector3 0 1 0)
     renderObject Solid (Cube 1)

   swapBuffers
   
main :: IO ()
main = do
    (progName, args) <- getArgsAndInitialize
    initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
    initialWindowSize $= Size 1024 768
    initialWindowPosition $= Position 100 100
    _ <- createWindow "Test5 Haskell GL"
    state <- makeState
    myInit
    displayCallback $= display state
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just (keyboard state)
    addTimerCallback timerInterval $ timerProc (display state)
    mainLoop