与Haskell Opengl的光彩

时间:2018-03-07 18:36:29

标签: haskell opengl

我用Haskell OpenGL做了很多图形。他们在我的回购中:opengl-examples(画廊并非详尽无遗)。但是我有一个问题:当我使用materialShininess时没有任何反应。为了获得光泽,有什么东西能够实现吗?

这是我的一个编程的例子。它还没有完成,但我希望它能够确定问题。

module CompoundFiveTetrahedra2
  where
import           CompoundFiveTetrahedra.Data
import           Control.Monad                     (when)
import qualified Data.ByteString                   as B
import           Data.IORef
import           Graphics.Rendering.OpenGL.Capture (capturePPM)
import           Graphics.Rendering.OpenGL.GL
import           Graphics.UI.GLUT
import           Text.Printf
import           Utils.ConvertPPM
import           Utils.OpenGL                      (negateNormal)
import           Utils.Prism

blue,red,green,yellow,purple,white,black :: Color4 GLfloat
blue   = Color4 0   0   1   1
red    = Color4 1   0   0   1
green  = Color4 0   1   0   1
yellow = Color4 1   1   0   1
white  = Color4 1   1   1   1
black  = Color4 0   0   0   1
purple = Color4 0.5 0   0.5 1

display :: IORef GLfloat -> IORef GLfloat -> IORef GLfloat -> IORef GLdouble
        -> IORef GLint -> IORef GLfloat -> DisplayCallback
display rot1 rot2 rot3 zoom capture angle = do
  clear [ColorBuffer, DepthBuffer]
  r1 <- get rot1
  r2 <- get rot2
  r3 <- get rot3
  z <- get zoom
  a <- get angle
  i <- get capture
  loadIdentity
  (_, size) <- get viewport
  resize z size
  rotate a $ Vector3 1 1 1
  rotate r1 $ Vector3 1 0 0
  rotate r2 $ Vector3 0 1 0
  rotate r3 $ Vector3 0 0 1
  mapM_ (drawEdge blue)   (edges!!0)
  mapM_ (drawEdge red)    (edges!!1)
  mapM_ (drawEdge green)  (edges!!2)
  mapM_ (drawEdge yellow) (edges!!3)
  mapM_ (drawEdge purple) (edges!!4)
  mapM_ (drawVertex blue)   vertices1
  mapM_ (drawVertex red)    vertices2
  mapM_ (drawVertex green)  vertices3
  mapM_ (drawVertex yellow) vertices4
  mapM_ (drawVertex purple) vertices5
  when (i > 0) $ do
    let ppm = printf "tetrahedra%04d.ppm" i
        png = printf "tetrahedra%04d.png" i
    (>>=) capturePPM (B.writeFile ppm)
    convert ppm png True
    capture $~! (+1)
  swapBuffers

drawVertex :: Color4 GLfloat -> Vertex3 GLfloat -> IO ()
drawVertex col v =
  preservingMatrix $ do
    translate $ toVector v
    materialDiffuse Front $= col
    renderObject Solid $ Sphere' 0.03 30 30
  where
    toVector (Vertex3 x y z) = Vector3 x y z

drawEdge :: Color4 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawEdge col (v1,v2) = do
  let cylinder = prism v1 v2 30 0.03
  renderPrimitive Quads $ do
    materialDiffuse Front $= col
    mapM_ drawQuad cylinder
  where
    drawQuad ((w1,w2,w3,w4),n) = do
      normal $ negateNormal n
      vertex w1
      vertex w2
      vertex w3
      vertex w4

resize :: Double -> Size -> IO ()
resize zoom s@(Size w h) = do
  viewport $= (Position 0 0, s)
  matrixMode $= Projection
  loadIdentity
  perspective 45.0 (w'/h') 1.0 100.0
  lookAt (Vertex3 0 0 (-3 + zoom)) (Vertex3 0 0 0) (Vector3 0 1 0)
  matrixMode $= Modelview 0
  where
    w' = realToFrac w
    h' = realToFrac h

keyboard :: IORef GLfloat -> IORef GLfloat -> IORef GLfloat -> IORef GLint
         -> KeyboardCallback
keyboard rot1 rot2 rot3 capture c _ =
  case c of
    'r' -> rot1 $~! subtract 1
    't' -> rot1 $~! (+1)
    'f' -> rot2 $~! subtract 1
    'g' -> rot2 $~! (+1)
    'v' -> rot3 $~! subtract 1
    'b' -> rot3 $~! (+1)
    'c' -> capture $~! (+1)
    'q' -> leaveMainLoop
    _   -> return ()

mouse :: IORef GLdouble -> MouseCallback
mouse zoom button keyState _ =
  case (button, keyState) of
    (LeftButton, Down)  -> zoom $~! (+0.1)
    (RightButton, Down) -> zoom $~! subtract 0.1
    _                   -> return ()

idle :: IORef GLfloat -> IdleCallback
idle angle = do
  angle $~! (+ 2)
  postRedisplay Nothing

main :: IO ()
main = do
  _ <- getArgsAndInitialize
  _ <- createWindow "Five tetrahedra"
  initialDisplayMode $= [RGBAMode, DoubleBuffered, WithDepthBuffer]
  clearColor $= black
  materialAmbient Front $= black
  materialShininess Front $= 80 -- THIS DOES NOT WORK
  lighting $= Enabled
  light (Light 0) $= Enabled
  position (Light 0) $= Vertex4 0 0 (-100) 1
  ambient (Light 0) $= white
  diffuse (Light 0) $= white
  specular (Light 0) $= white
  depthFunc $= Just Lequal
  depthMask $= Enabled
  shadeModel $= Smooth
  rot1 <- newIORef 0.0
  rot2 <- newIORef 0.0
  rot3 <- newIORef 0.0
  zoom <- newIORef 0.0
  capture <- newIORef 0
  angle <- newIORef 0.0
  displayCallback $= display rot1 rot2 rot3 zoom capture angle
  reshapeCallback $= Just (resize 0)
  keyboardCallback $= Just (keyboard rot1 rot2 rot3 capture)
  mouseCallback $= Just (mouse zoom)
  idleCallback $= Just (idle angle)
  mainLoop

我是否想念一些能够实现光泽的东西?

修改

以下是R包rgl的示例,它也是OpenGL的包装器。看看球体上的白色部分。我无法用Haskell实现这一点。

enter image description here

1 个答案:

答案 0 :(得分:3)

更新:尝试使用1.0的光泽,以便在低分辨率下更清晰地看到差异。

光泽度参数会影响高光照明的清晰度,因此您需要通过为材质提供镜面反射颜色来打开此类照明。 (默认情况下,镜面反射颜色为黑色,因此不会显示光泽参数的效果。)您还希望减少此场景的光泽值,因为它太高而不能很好可见。

尝试:

materialSpecular Front $= white
materialShininess Front $= 1.0

并且您将开始看到白色高光,特别是沿着您的形状的弯曲边缘。平面也会反射一些白光,但只有当它们几乎垂直于观察者和光源之间的中间角线时 - 它才有点复杂。

请注意,大多数材料的镜面反射颜色都是一些&#34;倍数&#34;白色(即,对于场景中最闪亮的材料,在黑色之间用于完全暗淡的材料到白色)。唯一具有着色镜面颜色的材料是有色金属,如金或青铜。

一些补充说明:

  • 您使用旧式的OpenGL 2.1着色,而不是现代的OpenGL&#34;,因此您不必过多担心着色器&#34;&#34;着色器&#34;那个@ user2297560正在谈论。 OpenGL 2.1附带内置着色器来进行基本着色;使用现代OpenGL,您必须从头开始构建所有内容。
  • 正如@luqui所提到的,如果您正在寻找实际反映其他部分场景的材料,那么这种光泽不会对您有所帮助。

这是区别。左边的原始代码,右边的设置,&#34; compoundfivetetrahedra&#34;例。如果你增加窗口的大小,它看起来会更好。

Original code (left) and with specular=white and shininess=1.0 on right.

请注意,它在曲面上效果更好。这是您的圆柱示例,使用:

materialShininess Front $= 5
materialSpecular Front $= white

你可以在更近的球体上看到光泽。

Cylinder example, showing shininess on one end