LoginSignup
3

More than 3 years have passed since last update.

not-glossでお手軽3Dグラフィック描画

Last updated at Posted at 2020-01-26

こんにちは、趣味でHaskellを勉強している者です。

はじめに

Haskellで超絶手軽にグラフィック描画ができるgloss、いいですよね。
glossについては、超絶わかりやく解説されている記事があるので、そちらを!glossではじめるグラフィック描画 :: Haskell入門の次に読む記事
glossは超絶使いやすい神ライブラリなのですが、二次元波動方程式のシミュレーションをしようとして、僕はふと思ってしまったんです。
「glossじゃ3D描画無理くない?」
それで、Hackageで色々探しているとnot-glossというパッケージがありまして...
このnot-gloss、glossをそのまま3D描画に対応させたって感じで使いやすかったんですよね。中身はgolssとほぼ同じ使い方ができるOpenGLのラッパーです。
そして、なぜか日本語で解説されてる記事がなかったので、頑張って書きました。

not-glossをインストールしよう

適当にプロジェクトを作って、次のコマンドを打つだけです。

$ stack install not-gloss
$ stack build

ちょっと時間がかかるかもしれません、辛抱しましょう。
終わったら、package.yamlに依存関係としてnot-glosslinearを追加しておきましょう。linearは三次元座標を扱うのに用います。
こんな感じです。

dependencies:
- base >= 4.7 && < 5
- not-gloss
- linear

立方体を表示する

せっかくなので、何か表示しましょう。Main.hsで次のように記述して、

module Main where

import Vis
import Linear.V3

main :: IO ()
main = display defaultOpts (Cube 0.5 Solid blue)

stack runするだけでOK

Screenshot from 2020-01-19 23-28-51.png
いい感じに立方体君が表示されましたね。めでたしめでたし。

not-glossの基本

not-glossにはdisplay,animate,simulate,playという描画の目的別に関数が用意されています。ここでは、これらの関数の簡単な使い方をご紹介します。

display

display関数は、動かないオブジェクトを描画するだけの単純明快な関数です。

display :: Real b 
        => Options     -- ^ 設定
        -> VisObject b -- ^ オブジェクト
        -> IO ()

glossと違うポイントは、Options型にウィンドウサイズや背景色、初期カメラ位置などの情報が格納されている点です。Real b => VisObject bは、描画されるオブジェクトのことであり、立方体や球、3Dテキストなど色々ありますが、後述します。
Options型には、defaultOptsというデフォルト設定があらかじめ用意されています。Options型はレコードになっているので、次のようにすることで部分的に変更することができます。

main :: IO ()
main = display myOpts (Cube 0.5 Solid blue)

myOpts = defaultOpts { optBackgroundColor = Just white }

このように、部分的にoptBackgroundColorの値を変更することで、背景の色を変えることができます!

Screenshot from 2020-01-19 23-45-03.png
こんな感じ。真っ白だぜ。

OptionsVisObjectについては記事後半を参照してください!

animate

animate関数はオブジェクトの時間変化によるシンプルな描画を行う関数です。

animate :: Real b
        => Options                -- ^ オプション
        -> (Float -> VisObject b) -- ^ 時刻を受け取って、オブジェクトを生成する関数
        -> IO ()

試しに、立方体をどんどん大きくする描画をしてみましょう。

main :: IO ()
main = animate defaultOpts (\t -> Cube t Solid white)

animateの第二引数に時刻tを受け取ってVisObjectを返す関数を渡してあげます。これを実行すると、次のようになります。simplescreenrecorder-2020-01-26_15.02.47.gif

簡単に3Dアニメーションの描画ができます。

simulate

simulate関数は初期状態状態を引数にしてオブジェクトを描画する関数状態を更新する関数から状態の時間発展を描画する関数です。ここで登場する状態は既存の型でもいいですし、自作の代数的データ型でもなんでもOKです。

simulate :: Real b
         => Options
         -> Double                    -- ^ サンプルレート
         -> world                     -- ^ 初期状態
         -> (world -> VisObject b)    -- ^ 状態を描画する関数
         -> (Float -> world -> world) -- ^ 前ステップからの経過時間、前の状態から次の状態を作る関数
         -> IO ()

シミュレーションの例としてN体運動もどきを作ってみます。
状態を、質量・位置・速度を持つデータ型の集まりとします。

import qualified Data.Vector as V

data Body = Body 
    {
        position :: V3 Float -- 位置
    ,   velocity :: V3 Float -- 速度
    } deriving Show

type Bodies = V.Vector Body -- データ型の集まり

ここで、初期状態を用意しておきましょう。

initBodies :: Bodies
initBodies = V.fromList
    [
        Body (V3 (-1) 0 0) (V3 0 0 0)
    ,   Body (V3    0 0 1) (V3 0 0 0)
    ,   Body (V3    0 0 0) (V3 0 0 0)
    ,   Body (V3    0 1 0) (V3 0 0 0)
    ]

次に、この状態を描画する関数を作ります。

drawBodies :: Bodies -> VisObject Float
drawBodies bodies =
    let
        drawBody body = Trans (position body) $ Sphere 0.1 Solid white
    in
        VisObjects $ V.toList $ V.map drawBody bodies

ここで、TransLinear.V3型の位置とオブジェクトを引数に、オブジェクトをその位置に移動させる関数です。glossのtranslateと同じです。
位置を参照してその場所に球体を表示させているだけです!

そして、最後に状態を更新する関数を用意。

nextBodies :: Float -> Bodies -> Bodies
nextBodies dt bodies = (`V.imap` bodies) $ \i _ ->
    let
        _G = 6.67408E-11            -- 万有引力定数
        ε = 0.15                    -- ソフトニングパラメータ
        scalar x = V3 x x x         -- スカラー値をベクトルにする関数

        x = position (bodies V.! i) -- i番目の質点の位置
        v = velocity (bodies V.! i) -- i番目の質点の速度

        exceptme = V.ifilter (\j _ -> j /= i) bodies

        v' = v + scalar (dt * _G) * V.sum ( V.map (\body -> (position body - x) / scalar ( (norm (position body - x)^2 + ε^2)**1.5 ) ) $ exceptme )
        x' = x + scalar dt * v'
    in
        Body m x' v'

あとはできあがったパーツをはめるだけ。

main :: IO ()
main = simulate defaultOpts (1/60) initBodies drawBodies nextBodies

実行結果はこんな感じ
simplescreenrecorder-2020-01-27_18.46.18.gif

simulate関数を使えば手軽に3次元シミュレーションができます。

play

キーボードやマウスによって発生するイベントで描画をコントロールできる関数です。

play :: Real b   
     => Options                                                            -- ^ オプション
     -> Double                                                             -- ^ サンプル時間
     -> world                                                              -- ^ 初期状態
     -> (world -> (VisObject b, Maybe Cursor))                             -- ^ 状態の描画
     -> (Float -> world -> world)                                          -- ^ 状態の更新
     -> (world -> IO ())                                               -- ^ カメラのセット
     -> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world) -- ^ キーボード/マウスのボタンのコールバック
     -> Maybe (world -> Position -> world)                                 -- ^ マウスドラッグのコールバック
     -> Maybe (world -> Position -> world)                                 -- ^ マウスを動かしたときのコールバック
     -> IO ()

not-gloss開発者のexampleを載せておきます。

{-# OPTIONS_GHC -Wall #-}

module Main ( main
            ) where

import Linear ( V3(..), (*^) )
import qualified Data.Set as Set
import Graphics.X11 ( initThreads )
import Graphics.UI.GLUT ( Cursor(..), Key(..), KeyState(..), Modifiers(..), Position(..)
                        , Size(..), Vector3(..), Vertex3(..)
                        , GLint
                        , ($=)
                        )
import qualified Graphics.UI.GLUT as GLUT

import SpatialMath ( Euler(..), rotateXyzAboutZ, rotVecByEulerB2A )
import Vis

import Control.Monad ( when )

ts :: Double
ts = 0.01

faceHeight :: Double
faceHeight = 1.5

data PlayerState = Running (V3 Double) (V3 Double) (Euler Double)

data GameState = GameState { playerState :: PlayerState
                           , keySet :: Set.Set Key
                           , lastMousePos :: Maybe (GLint,GLint)
                           }

toVertex :: (Real a, Fractional b) => V3 a -> Vertex3 b
toVertex xyz = (\(V3 x y z) -> Vertex3 x y z) $ fmap realToFrac xyz

setCamera :: PlayerState -> IO ()
setCamera (Running (V3 x y z) _ euler) =
  GLUT.lookAt (toVertex xyz0) (toVertex target) (Vector3 0 0 (-1))
  where
    xyz0 = V3 x y (z-faceHeight)
    target = xyz0 + rotVecByEulerB2A euler (V3 1 0 0)

simfun :: Float -> GameState -> IO GameState
simfun _ (GameState (Running pos _ euler0@(Euler yaw _ _)) keys lmp) = do
  Size x y <- GLUT.get GLUT.windowSize
  let x' = (fromIntegral x) `div` 2
      y' = (fromIntegral y) `div` 2

  when (Just (x',y') /= lmp) (GLUT.pointerPosition $= (Position x' y'))
  return $ GameState (Running (pos + (ts *^ v)) v euler0) keys (Just (x',y'))
  where
    v = rotateXyzAboutZ (V3 (w-s) (d-a) 0) yaw
      where
        w = if Set.member (Char 'w') keys then 3 else 0
        a = if Set.member (Char 'a') keys then 3 else 0
        s = if Set.member (Char 's') keys then 3 else 0
        d = if Set.member (Char 'd') keys then 3 else 0

keyMouseCallback :: GameState -> Key -> KeyState -> Modifiers -> Position -> GameState
keyMouseCallback state0 key keystate _ _
  | keystate == Down = state0 {keySet = Set.insert key (keySet state0)}
  | keystate == Up   = state0 {keySet = Set.delete key (keySet state0)}
  | otherwise        = state0

motionCallback :: Bool -> GameState -> Position -> GameState
motionCallback _ state0@(GameState (Running pos v (Euler yaw0 pitch0 _)) _ lmp) (Position x y) =
  state0 {playerState = newPlayerState, lastMousePos = Just (x,y)}
  where
    (x0,y0) = case lmp of Nothing -> (x,y)
                          Just (x0',y0') -> (x0',y0')
    newPlayerState = Running pos v (Euler yaw pitch 0)
    dx = 0.002*realToFrac (x - x0)
    dy = 0.002*realToFrac (y - y0)
    yaw = yaw0 + dx
    pitch = bound (-89) 89 (pitch0 - dy)
    bound min' max' val
      | val < min' = min'
      | val > max' = max'
      | otherwise  = val


drawfun :: GameState -> VisObject Double
drawfun (GameState (Running _ _ _) _ _) =
  VisObjects $ [axes,box,ellipsoid,sphere] ++ (map text [-5..5]) ++ [boxText, plane] 
  where
    x' = -1
    axes = Axes (0.5, 15)
    sphere = Trans (V3 0 x' (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)
    ellipsoid = Trans (V3 x' 0 (-1)) $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)
    box = Trans (V3 0 0 x') $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)
    plane = Plane (V3 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)
    text k = Text2d "OLOLOLOLOLO" (100,500 - k*100*x') TimesRoman24 (makeColor 0 (0.5 + x''/2) (0.5 - x''/2) 1)
      where
        x'' = realToFrac $ (x' + 1)/0.4*k/5
    boxText = Text3d "trololololo" (V3 0 0 (x'-0.2)) TimesRoman24 (makeColor 1 0 0 1)

main :: IO ()
main = do
  let state0 = GameState (Running (V3 (-2) 0 0) 0 (Euler 0 0 0)) (Set.empty) Nothing
      setCam (GameState x _ _) = setCamera x
      drawfun' x = return (drawfun x, Just None)
  _ <- initThreads
  playIO (defaultOpts {optWindowName = "play test"}) ts state0 drawfun' simfun setCam
    (Just keyMouseCallback) (Just (motionCallback True)) (Just (motionCallback False))


Screenshot from 2020-01-26 18-53-03.png
wasdで移動、マウスで視点移動という簡単な一人称視点を描画するプログラムです。

playを使えば簡単にインタラクティブな描画を実現できます。

Options

Options型は次のように定義されています。

Options = Options
    {
        optBackgroundColor :: Maybe Color      -- ^ 背景色
    ,   optWindowSize      :: Maybe (Int, Int) -- ^ ウィンドウサイズ, Just (横のピクセル, 縦のピクセル) で指定
    ,   optWindowPosition  :: Maybe (Int, Int) -- ^ ウィンドウを表示する位置, Just (横のピクセル, 縦のピクセル) で指定
    ,   optWindowName      :: String           -- ^ ウィンドウ名, 文字列を与えて指定
    ,   optInitialCamera   :: Maybe Camera0    -- ^ カメラの初期位置, Camera0型の値を与えて指定
    ,   optAnitialiasing   :: Antialiasing     -- ^ アンチエイリアスをどうするか, Anitialiasing型の値で指定
    }

なぜ、Maybeで包まれてるかはよくわからないのですが、とりあえずJustでくるんで渡せば大丈夫です。(Nothingはデフォルト値を返すっぽい?)

Camera0

Camera0は描画のスタートにおけるカメラの向きの情報を持ちます。

data Camera0 =
    {
        phi0   :: GLDouble
    ,   theta0 :: GLDouble
    ,   rho0   :: GLDouble
    }

ここで、GLDoubleDoubleのエイリアスなので、そのまま数値を指定すれば大丈夫です。

3つの角度$\phi,\theta,\rho$をそれぞれ指定してあげることで、初期のカメラ向きを決定できます。

main = display myOpts (Cube 0.5 Solid white)
    where
        myOpts = defaultOpts { optInitialCamera = Camera0 { phi0 = pi/2 } }

Antialiasing

アンチエイリアスをどうするかを決定できるパラメータです。(アンチエイリアスは、デジタルで描画する時に発生するジャギジャギをなめらかにすることで、違和感を抑える処理だと思ってください。)

data Antialiasing = Aliased          -- ^ エイリアスを除かない
                  | Smoothed         -- ^ スムージングする
                  | Multisampled Int -- ^ マルチサンプリングする

こんな感じで指定します。

main = display myOpts (Cube 0.5 Solid white)
    where
        myOpts = defaultOpts { optAnitialiasing = Smoothed }

VisObject

VisObjectは描画できるオブジェクトと、オブジェクトへの作用からなり、様々なものが用意されています。

data VisObject a =
    -- 作用系
    VisObjects [VisObject a]               -- ^ 複数のオブジェクトをひとつにする
    Trans (V3 a) (VisObject a)             -- ^ オブジェクトを移動させる
    RotQuot (Quaternion a ) (VisObject a)  -- ^ クォータニオンによる回転作用
    RotDcm (M33 a) (VisObject a )          -- ^ 回転行列による回転作用
    RotEulerDeg (Euler a) (VisObject a)    -- ^ オイラー角による回転作用 (度)
    RotEulerRad (Euler a) (VisObject a)    -- ^ オイラー角による回転作用 (ラジアン)
    Scale (a, a, a) (VisObject a)          -- ^ オブジェクトを拡大

    -- オブジェクト
    Cylinder (a, a) Color                  -- ^ 円筒
    Box (a, a, a) Flavour Color            -- ^ 直方体
    Cube a Flavour Color                   -- ^ 立方体
    Sphere a Flavour Color                 -- ^ 球
    Ellipsoid (a, a, a) Flavour Color      -- ^ 楕円体
    Line Maybe a [V3 a] Color              -- ^ 線
    Line' Maybe a [(V3 a, Color)]          -- ^ 線
    Arrow (a, a) (V3 a) Color              -- ^ 矢印
    Axes (a, a)                            -- ^ 軸
    Plane (V3 a) Color Color               -- ^ 平面
    Triangle (V3 a) (V3 a) (V3 a) Color    -- ^ 三角形
    Quad (V3 a) (V3 a) (V3 a) (V3 a) Color -- ^ 四角形
    Text2d String (a, a) BitmapFont Color  -- ^ 2dテキスト
    Text3d String (V3 a) BitmapFont Color  -- ^ 3dテキスト
    Points [V3 a] (Maybe GLfloat) Color      -- ^ 点群

オブジェクトのFlavourには描画方法(メッシュor塗りつぶし)を指定、Colorには色を指定します。
GLfloatfloatのエイリアスです。

Flavour

Flavourは2値からなる型で、オブジェクトをどのように描画するか指定します。

Flavour = Solid     -- ^ 塗りつぶし
        | Wireframe -- ^ メッシュ

違いはこんな感じ
Screenshot from 2020-01-26 17-49-05.png
上がWireframeで下がSolidです。お好みな方を使いましょう。

Color

色を作る関数が用意されています。

makeColor :: Float -- ^ R 
          -> Float -- ^ G
          -> Float -- ^ B
          -> Float -- ^ α
          -> Color

R,G,B,αの値は[0..1]の範囲で指定します。

makeColor8関数を使えば[0..255]Int値でも指定できます。
また、定義済みの色は次の通り。


基本

black, white

主要な色

red, green, blue

二次的な色

yellow, cyan, magenta

より複合的な色

rose, violet, azure, aquamarine, chartreuse, orange

また、mixColors関数を使えば色を混ぜることができます。

mixColors :: Float -- ^ 1つ目の色の比率
          -> Float -- ^ 2つ目の色の比率
          -> Color -- ^ 1つ目の色
          -> Color -- ^ 2つ目の色
          -> Color

light関数やdark関数を使うことで色を明るくしたり暗くしたりすることも可能です。詳しくはココを参考にしてください。

BitmapFont

Text2DText3Dを描画する際に、フォントを指定することができます。

data BitmapFont = Fixed8By13
                | Fixed9By15
                | TimesRoman10
                | TimesRoman24
                | Helvetica10
                | Helvetica12
                | Helvetica18

後ろの数字はポイントサイズです。僕はTimesRomanが好きです。

main = display defaultOpts (Text3D "Hello, Haskeller!" (V3 1 1 1) TimesRoman10 rose)

おわりに

not-glossを使えば、OpenGLを使いこなせるように修行せずとも簡単に3Dグラフィック描画が可能です。
「頭使わずに可視化したいな...」、「ちょっとした3Dゲームを作ってみたいな...」という願望がある方はすぐに試してみましょう!

ここまで見てくださった方、ありがとうございました〜

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
What you can do with signing up
3