haskell - Haskell Opengl 的光泽度

标签 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 以在低分辨率下更清楚地看到差异。

反光度参数会影响镜面反射光的锐度,因此您需要通过为 Material 赋予镜面反射颜色来为它们打开这种类型的照明。 (默认情况下,镜面反射颜色为黑色,因此不可见反光度参数的效果。)您还需要降低此场景的反光度值,因为它太高以至于不太明显。

尝试:

materialSpecular Front $= white
materialShininess Front $= 1.0

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

请注意,大多数 Material 的镜面反射颜色被认为是白色的“倍数”(即,介于完美暗淡 Material 的黑色和场景中最 Shiny Material 的白色之间)。唯一具有着色镜面反射颜色的 Material 是有色金属,如金或青铜。

一些补充说明:

  • 您使用的是旧式 OpenGL 2.1 着色,而不是“现代 OpenGL”,因此您不必太担心 @user2297560 所说的“着色器”。 OpenGL 2.1 带有内置着色器来进行基本着色;使用现代 OpenGL,您必须从头开始构建所有内容。
  • 正如@luqui 所提到的,如果您正在寻找能够真正反射(reflect)场景其他部分的 Material ,这种光泽对您没有帮助。

区别就在这里。左边是你的原始代码,右边是上面的设置,在你的“compoundfivetetrahedra”例子中。如果增加窗口的大小,它看起来会更好。

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

关于haskell - Haskell Opengl 的光泽度,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/49159030/

相关文章:

opengl - GLSL:对着色器存储缓冲区的写入是否会被稍后的丢弃语句丢弃(或撤消)?

c - 在 openGL 中寻找聚光灯 vector

opengl - CL/GL-Interop 的 OpenGL 纹理格式类型错误?

string - Haskell中String和Data.Text之间的自动转换

haskell - 在 Data.Array.Unboxed 中使用 newtype 和 ghc 7.10

c++ - Qt 使用哪种图形技术来呈现其自定义 UI?

c - 安装 OpenGL/GLUT 并运行 C 程序?

haskell - cabal-在 Windows 上安装 Hopenssl

haskell - 我可以编译这个类型不明确的函数吗?

haskell - 计算后代具有至少一个显性等位基因的概率