首页 > 解决方案 > 四元数旋转有一个奇怪的行为(Haskell OpenGL)

问题描述

我一直在关注Haskell OpenGL 教程。3D 空间中的旋转引起了我的兴趣,所以我开始学习欧拉角,最后是四元数。

我想使用四元数来实现我自己的函数来执行旋转(在立方体上),我以这两篇论文为基础:主要是 thisthis

当我仅在一个轴上执行旋转时,我的函数工作正常,但是当我在 X 和 Y 上执行此操作时,立方体开始随机前进并在旋转时被“阻挡”。

立方体在 XY 上执行旋转的视频

当我设置三个轴(X、Y、Z)时,它会放大更多(但没有那种奇怪的阻挡物):video

这是我的程序的代码:

这是创建窗口、设置空闲功能并在屏幕上输出角度 A 的旋转结果的主文件,其中 A 在每帧增加 0.05。

module Main (main) where
import Core
import Utils
import Data.IORef
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL

main :: IO ()
main = do
    createAWindow "177013"
    mainLoop

createAWindow :: [Char] -> IO ()
createAWindow windowName = do
    (procName, _args) <- getArgsAndInitialize
    createWindow windowName
    initialDisplayMode $= [DoubleBuffered]
    angle <- newIORef 0.0
    delta <- newIORef 0.05
    displayCallback $= (start angle)
    reshapeCallback $= Just reshape
    keyboardMouseCallback $= Just keyboardMouse
    idleCallback $= Just (idle angle delta)

reshape :: ReshapeCallback
reshape size = do
             viewport $= (Position 0 0, size)
             postRedisplay Nothing


keyboardMouse :: KeyboardMouseCallback
keyboardMouse _ _ _ _ = return ()

idle :: IORef GLfloat -> IORef GLfloat -> IdleCallback
idle angle delta = do
           d <- get delta
           a <- get angle
           angle $~! (+d)
           postRedisplay Nothing
start :: IORef GLfloat -> DisplayCallback
start angle = do
            clear [ColorBuffer]
            loadIdentity
            a <- get angle
            let c = rotate3f (0, 0, 0) [X,Y,Z] a $ cube3f 0.2 -- here I'm rotating on X, Y and Z axis
            draw3f Quads c CCyan
            flush
            swapBuffers
                where

这是定义旋转功能的核心文件(以及其他一些)。我添加了一些评论,因为它可能是一些低质量的 haskell 代码。

module Core (draw3f, vertex3f, rotate3f, translate3f, rotate3d, Colors(..), Axes(..)) where

import Control.Lens
import Graphics.Rendering.OpenGL

data Axes = X | Y | Z
            deriving Eq
data Colors = CRed | CGreen | CBlue | CYellow | CWhite | CMagenta | CCyan | CBlack | CNone | CPreset
              deriving Eq


rotate3f :: (GLfloat, GLfloat, GLfloat) -> [Axes] -> GLfloat -> [(GLfloat, GLfloat, GLfloat)] -> [(GLfloat, GLfloat, GLfloat)]
rotate3f _ _ _ [] = []
rotate3f _ [] _ _ = []
rotate3f o axes a p = let p' = translate3f p u -- translation if I don't want to rotate it by the origin
                          q = cos a' : ((\x -> if x `elem` axes then sin a' else 0) <$> [X,Y,Z]) -- if the axe is set then its related component is equal to sin theta/2, otherwise it will be 0
                          q' = q !! 0 : (negate <$> (tail q)) -- quaternion inversion
                      in translate3f ((rotate q q') <$> p') [(0,0,0),o] -- rotate and translate again to put the object where it belongs
                          where
                              a' = (a * (pi / 180)) / 2 -- convert to radians and divide by 2 as all q components takes theta/2
                              u :: [(GLfloat, GLfloat, GLfloat)]
                              u = [o,(0,0,0)]
                              rotate :: [GLfloat] -> [GLfloat] -> (GLfloat, GLfloat, GLfloat) -> (GLfloat, GLfloat, GLfloat)
                              rotate q q' (x,y,z) = let p = [0,x,y,z]
                                                        qmul q1 q2 = [(q1 !! 0) * (q2 !! 0) - (q1 !! 1) * (q2 !! 1) - (q1 !! 2) * (q2 !! 2) - (q1 !! 3) * (q2 !! 3),
                                                                      (q1 !! 0) * (q2 !! 1) + (q1 !! 1) * (q2 !! 0) + (q1 !! 2) * (q2 !! 3) - (q1 !! 3) * (q2 !! 2),
                                                                      (q1 !! 0) * (q2 !! 2) - (q1 !! 1) * (q2 !! 3) + (q1 !! 2) * (q2 !! 0) + (q1 !! 3) * (q2 !! 1),
                                                                      (q1 !! 0) * (q2 !! 3) + (q1 !! 1) * (q2 !! 2) - (q1 !! 2) * (q2 !! 1) + (q1 !! 3) * (q2 !! 0)]
                                                        p' = qmul (qmul q p) q'
                                                    in (p' !! 1, p' !! 2, p' !! 3)


                    
translate3f :: [(GLfloat, GLfloat, GLfloat)] -> [(GLfloat, GLfloat, GLfloat)] -> [(GLfloat, GLfloat, GLfloat)]
translate3f p [(ax,ay,az),(bx,by,bz)] = map (\(x,y,z) -> (x + (bx - ax), y + (by - ay), z + (bz - az))) p



draw3f :: PrimitiveMode -> [(GLfloat, GLfloat, GLfloat)] -> Colors -> IO()
draw3f shape points color = renderPrimitive shape $ mapM_ (\(x,y,z) -> vertex3f x y z color) points

vertex3f :: GLfloat -> GLfloat -> GLfloat -> Colors -> IO()
vertex3f x y z c = do
                 if c /= CPreset
                    then color $ Color3 (c' ^. _1) (c' ^. _2) ((c' ^. _3) :: GLfloat)
                 else return ()
                 vertex $ Vertex3 x y z
                     where
                         c' :: (GLfloat, GLfloat, GLfloat)
                         c' = case c of CRed -> (1,0,0)
                                        CGreen -> (0,1,0)
                                        CBlue -> (0,0,1)
                                        CYellow -> (1,1,0)
                                        CMagenta -> (1,0,1)
                                        CCyan -> (0,1,1)
                                        CBlack -> (0,0,0)
                                        _ -> (1,1,1)

这是 utils 文件,其中只有立方体的定义,来自 Haskell OpenGL 教程

module Utils (cube3f) where

import Core
import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL

cube3f :: GLfloat -> [(GLfloat, GLfloat, GLfloat)]
cube3f w = [( w, w, w), ( w, w,-w), ( w,-w,-w), ( w,-w, w),
            ( w, w, w), ( w, w,-w), (-w, w,-w), (-w, w, w),
            ( w, w, w), ( w,-w, w), (-w,-w, w), (-w, w, w),
            (-w, w, w), (-w, w,-w), (-w,-w,-w), (-w,-w, w),
            ( w,-w, w), ( w,-w,-w), (-w,-w,-w), (-w,-w, w),
            ( w, w,-w), ( w,-w,-w), (-w,-w,-w), (-w, w,-w)]

最后,如果它可以帮助人们查看我的算法是否存在问题,这里有一些使用我的函数的旋转示例:

将点 (1, 2, 3) 在 X 轴上围绕点 (0, 0, 0)(原点)旋转 90°,得出:(0.99999994,-3.0,2.0)

相同的旋转但在 X 和 Y 轴上给出:(5.4999995,-0.99999994,-0.49999988)

再次进行相同的旋转,但在 X、Y 和 Z 轴上给出:(5.9999995,1.9999999,3.9999995)

标签: haskellopenglquaternions

解决方案



推荐阅读