taketoncheir.log

Like the Decatoncheir by Poseidon Industrial, This blog is Yet Another Storage for My Long Term Memories.

HaskellでOpenGL触ってみた

そろそろHaskellで動くものを作ってみたいと思い、Monadiusこちらの記事に触発されて、GUIの門を叩くことにしました。

そもそもOpenGLも触ったことがないので、まずはOpenGLに慣れるところから。
ということで、昔研究室で作っていた視覚刺激"Ullman Cylinder"を作ってみることに。

お題:Ullman Cylinder

2D移動するドット群から3Dテクスチャを知覚するタイプの刺激です。
ドットの移動速度が円筒表面をなぞるように変化するので、奥行きを知覚します。
例はこちら(Visiome)

本当は各ドットを平面上で動かしたかったのですが、
今回は実際に3Dで動かしてそれを平面上に射影させました。
ドット自身の傾きでサイズが変わるので、それが奥行知覚に影響するかもですが、、
まぁ習作ということで(;^ω^)

詰まった点

helloworld

MacではOpenGLTutorialのHelloWorldがそのまま実行できない。wikiにあるように、ghciからではなくghcでコンパイルすること、displayCallbackを呼んでやること、が必須になります。

数値型の変換

数値計算を真面目にやったことがなかったので、Int同士の割り算もエラーになることを初めて知りました。。fromIntegralやrealToFracでNumやFractionalに変換してから計算する必要があると

そもそもIntで定義したのがいけなかったかもしれません。
また、FloatをGLfloatに変換するのも悩んだのですが、realToFracをかまして推論させました。

シリンダーの回転

OpenGLでは視界(カメラ)の変換とモデリング(物体)の変換の二つを意識する必要があります。
最初これが分かっておらず、シリンダーを回転させようとすると、物体とシリンダーが両方回転してしまっていました。
まずtranslateで物体の位置を決定した後に、

 matrixMode $= Projection

で視界変換に切り替えます。その後rotateでy軸を中心にカメラを回し、loadIdentityでひとつのドットの描画を終了します。

アニメの仕組み

まだあまりわかっていないのですが、main逐次処理のなかで呼ばれるidleCallback
が処理の合間に呼ばれるらしい。
そこで破壊的代入を受け付けるIORef型で定義したangleを積算してやり、Cylinder描画に渡してやります。
しかし、このidleCallbackはcpuの余力によって単位時間あたりの呼び出し回数が変わるので、環境によって描画スピードが変化してしまい、実験には到底使えません。
調べてみると、timerfuncを使うべきだったかもしれません。

乱数のseed

描画するたびにドットの位置を変えなくては、知覚の慣れが起きてしまい実験に使うことができません。
ドットの位置を変えるには実行ごとに乱数発生のseedを変えることです。
今回後からseedをSystem.timeから取ってこようとしたところ、ドット位置計算部分をすべてIO側に持ってくるように修正が必要になったので今回は対応しませんでした。

コード

全体はgithubを参照ください。
実行する際は、

ghc -o MainUllman MainUllman.hs
./MainUllman

どっち向きに回転してますか?
右回りに見えた方は右脳型、左回りの方は左脳型です!!(嘘)

MainUllman.hs
import Graphics.UI.GLUT
import Bindings
import Cylinder
import Data.IORef

data WindowInfo 
     = WindowInfo {
         wwid :: Int,
         whei :: Int,
         wpos_x :: Int,
         wpos_y :: Int
         }

window1 :: WindowInfo
window1 = WindowInfo {
  wwid = 600, whei = 400, wpos_x = 100, wpos_y = 100
  }
  
cylinder1 :: CylinderInfo
cylinder1 = 
  CylinderInfo { 
    wid = 500, hei = 600, delta = 0.5, num_dots = 150, dot_size = 5.0, dot_color = Color3 0.2 0.1 0.9
    }
  
main :: IO()
main =
  do getArgsAndInitialize
     -- windowの初期設定
     initialWindowSize $= Size (fromIntegral $ wwid window1) (fromIntegral $ whei window1)
     initialWindowPosition $= Position (fromIntegral $ wpos_x window1) (fromIntegral $ wpos_y window1)
     initialDisplayMode $= [DoubleBuffered, RGBMode]
     
     createWindow "UllmanCylinder"
     reshapeCallback $= Just reshapeWindow -- omissible
     
     angle <- newIORef (0.0::GLfloat)
     delta <- newIORef (realToFrac $ delta cylinder1)
     -- angleの更新
     idleCallback $= Just (idle angle delta)
     -- cylinder描画
     displayCallback $= draw cylinder1 angle
     
     mainLoop
  
reshapeWindow :: Size -> IO ()
reshapeWindow size@(Size w h) = do
    viewport $= (Position 0 0, size)
    matrixMode $= Projection
    loadIdentity
    -- ortho2D left right top bottom -- near::-1 far::1
    lookAt (Vertex3 0.0 0.0 (-1.0)) -- 視点がどこか
           (Vertex3 0.0 0.0 1.0) -- どこを見るか
           (Vector3 0.0 1.0 0.0) -- どちらが上か
    -- translate $ Vector3 0.0 0.0 (-2.0::GLfloat) 
    matrixMode $= Modelview 0
      where
         left   = (-(fromIntegral w)/640):: GLdouble
         right  = ( (fromIntegral w)/640):: GLdouble
         top    = (-(fromIntegral h)/480):: GLdouble
         bottom = ( (fromIntegral h)/480):: GLdouble
Cylinder.hs
module Cylinder where

import Graphics.UI.GLUT
import Points
import Cube

data CylinderInfo =
  CylinderInfo {
    wid :: Int,
    hei :: Int,
    delta :: Float,
    num_dots :: Int,
    dot_size :: Float,
    dot_color :: Color3 GLfloat
  }

draw info angle = do 
  clear [ColorBuffer]
  loadIdentity
  -- 描画倍率の指定
  scale 0.001 0.001 (0.001::GLfloat)
  mapM_ (\(x,y,z) -> preservingMatrix $ do 
            matrixMode $= Modelview 0
            translate $ Vector3 x y z
            color $ dot_color info
            
            -- rotate the world
            matrixMode $= Projection
            a <- get angle
            rotate a $ Vector3 0.0 (1.0::GLfloat) 0.0
            
            cube ((realToFrac $ dot_size info)::GLfloat)
            loadIdentity -- necessary to calc each cube
        ) $ cylpoints (wid info) (hei info) (num_dots info)
  swapBuffers
     
idle angle delta = do 
  a <- get angle
  d <- get delta
  angle $=! (a+d)
  postRedisplay Nothing
  
Points.hs
module Points where

import Graphics.Rendering.OpenGL
import System.Random
import Data.Time

-- default example
points :: Int -> [(GLfloat, GLfloat, GLfloat)]
points n' = let n = fromIntegral n' in map (\k -> let t = 2*pi*k/n in (sin(t), cos(t), 0.0)) [1..n]

-- the width means radius
cylpoints :: Int -> Int -> Int -> [(GLfloat, GLfloat, GLfloat)]
cylpoints width height n' = 
  let n = fromIntegral n'
      -- how to decide seed???
      xs = toRandPosNeg 10 $ randNArray width n 0 
      ys = toRandPosNeg 20 $ randNArray height n 100
  in zip3 (convert xs) (convert ys) (convert (toRandPosNeg 30 $ map (\k -> calcZ k width) xs))
  
convert :: [Float] -> [GLfloat]
convert xs = map intToGLfloat xs 
  where
    intToGLfloat :: Float -> GLfloat
    intToGLfloat x = realToFrac x

randomSeq :: Int -> Int -> [Int]
randomSeq r seed = randomRs (0,r) (mkStdGen seed)

randomPNSeq :: Int -> [Int]
randomPNSeq seed = map posneg (randomSeq 10000 seed)
  where
    posneg :: Int -> Int
    -- it may not be a good implementation...
    posneg x | x >= 5000 = 1
             | x < 5000 = -1
             | otherwise = error "seed"

randNArray :: Int -> Int -> Int -> [Float]
randNArray r n seed = take n $ map fromIntegral (randomSeq r seed)

calcZ :: Float -> Int -> Float
-- incaseof failure???
calcZ x width' =  (sqrt (1 - (x^2) / (width^2))) * width
  where
    width = fromIntegral width'
    
toRandPosNeg :: Int -> [Float] -> [Float]
toRandPosNeg seed xs = [x* (fromIntegral y) | (x, y) <- zip xs (randomPNSeq seed)]

-- implemented for seed, but it is not used
getCTime = do 
  x <- getCurrentTime       
  return (mkStdGen $ truncate $ todSec $ timeToTimeOfDay $ utctDayTime x)