雑記帳
Haskell でレイトレーシングのチュートリアルを追いかける その1 - 球面の描画
今までOpenGLを使ったポリゴンベースのコンピュータグラフィックの描画は行ったことはあるものの、よりリアリティの高いといわれるレイトレーシングによる描画というものには挑戦したことがなかった。そんな中、こんなサイトを偶然見つけてしまい、流し読みしてみたところ、キャッチーな出力画像に魅せられてまんまと興味をそそられ、この度そのチュートリアルに則ってレイトレーシングによる画像の生成に挑戦してみることを決意。
まずは球体を描画するところまで。
感想としては、「ベクトル」ってやっぱり便利。
球面の方程式や直線の方程式がこんなところでも役立つとは。
球面の方程式や直線の方程式がこんなところでも役立つとは。
コードの実行結果
リンク先の結果と一緒なのでそちらを是非見てほしい
ソースコード
-- https://raytracing.github.io/books/RayTracingInOneWeekend.html section 5 with Haskell --
import Data.Char
import Data.Functor
import Control.Monad
import Control.Lens
import Linear.Vector
import Linear.Metric
import Linear.V3
import Linear.Quaternion
main = do
let
-- Image
aspect_ratio = 16.0 / 9
image_width = 256
image_height = round $ fromInteger image_width / aspect_ratio
-- Camera
viewport_height = 2.0
viewport_width = aspect_ratio * viewport_height
focal_length = 1.0
origin = zero
horizontal = viewport_width *^ unit _x
vertical = viewport_height *^ unit _y
lower_left_corner = origin - horizontal ^/2 - vertical ^/2 - focal_length *^ unit _z
-- Render
img_data <- return $ "P3\n" ++ show image_width ++ " " ++ show image_height ++ "\n255\n"
putStr $ img_data
foldr (>>) (return ()) $ (fmap $ ($) $ \(j, i) ->
let
u = fromInteger i / (fromInteger image_width - 1.0)
v = fromInteger j / (fromInteger image_height - 1.0)
r = Ray {orig = origin, dir = lower_left_corner + u *^ horizontal + v *^ vertical - origin}
pixcel_color = ray_color $ r
in
write_color $ pixcel_color) $
(,) <$> [image_height - 1, image_height - 2 .. 0] <*> [0, 1 .. image_width - 1]
---------------------
-- A Ray Data Type --
---------------------
data Ray = Ray {
orig :: V3 Double, -- Origin of this ray (As a position in 3D Euclidean space)
dir :: V3 Double -- Direction of this ray (As a direction vector in 3D Euclidean space)
} deriving (Show)
at :: Ray -> Double -> V3 Double
at r t = (orig r) + t *^ (dir r)
---------------
-- Utilities --
---------------
write_color :: RealFrac a => V3 a -> IO ()
write_color v =
let
f = show.floor.(255.999*)
in
do
tmp <- return $ f(v ^._x) ++ " " ++ f(v ^._y) ++ " " ++ f(v ^._z) ++ "\n"
putStr $ tmp
ray_color :: Ray -> V3 Double
ray_color r =
if hit_sphere (V3 0 0 (-1)) 0.5 r then
V3 1 0 0
else
let
unit_direction = normalize $ (dir r)
t = 0.5 * (unit_direction ^._y + 1.0)
in
lerp t (V3 0.5 0.7 1.0) (V3 1.0 1.0 1.0)
hit_sphere :: V3 Double -> Double -> Ray -> Bool
hit_sphere center radius r =
let
oc = orig r - center
a = quadrance (dir r)
b = 2 * (oc `dot` dir r)
c = quadrance oc - radius ^ 2
discriminant = b ^ 2 - 4*a*c
in
(discriminant > 0)タグ一覧: