1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
module Camera where
import qualified Data.Vector.Generic as G
import Numeric.LinearAlgebra as Math hiding ((<>))
import Matrix
import LambdaCube.GL.HMatrix ()
data Camera = Camera
{ camHeightAngle :: Float
, camTarget :: Vector Float -- 3-vector
, camDirection :: Vector Float -- 3-vector
, camDistance :: Float
, camWidth :: Float
, camHeight :: Float
, camUp :: Vector Float -- 3-vector
, camWorldToScreen :: Maybe (Matrix Float) -- 4×4
, camScreenToWorld :: Maybe (Matrix Float) -- 4×4
}
-- | Compute the height of a pixel at the given 3d point.
pixelDelta :: Camera -> Vector Float -> Float
pixelDelta cam x = realToFrac $ frustumHeight eyeToPoint / realToFrac (camHeight cam)
where
eyeToPoint = norm_2 (x - camPos cam)
frustumHeight d = 2 * d * tan (realToFrac $ camHeightAngle cam / 2)
camPos :: Camera -> Vector Float
camPos c = camTarget c - scale (camDistance c) (camDirection c)
camWorldCoordinates :: Camera -> Double -> Double -> Maybe (Vector Float) -> Vector Float
camWorldCoordinates cam h k mplane = case mplane of
-- Write on the plane.
Just plane -> let n̂ = G.init plane
c = plane!3
a = (c - dot p n̂) / dot d̂ n̂
in p + scale a d̂
-- Write on the camDistance sphere.
Nothing -> p + scale (camDistance cam) d̂
where
q0 = fromList [ 2 * realToFrac h/camWidth cam - 1
, 1 - 2 * realToFrac k/camHeight cam
, 1
, 1
] :: Vector Float
pv = snd $ projectionView cam
q1 = pv #> q0
q2 = scale (1 /(q1!3)) $ G.init q1
p = camPos cam
d = q2 - p
d̂ = unit d
projectionView :: Camera -> (Camera,Matrix Float)
projectionView c
| Just m <- camScreenToWorld c = (c,m)
| Just w <- camWorldToScreen c = projectionView c{ camScreenToWorld = Just $ invFloat w }
| otherwise = projectionView $ fst $ viewProjection c
viewProjection :: Camera -> (Camera,(Matrix Float,Vector Float))
viewProjection c
| Just m <- camWorldToScreen c = (c,(m,pos))
| otherwise = (c { camWorldToScreen = Just m' }, (m',pos))
where
m' = proj <> cam
cam = lookat pos (camTarget c) (camUp c)
pos = camPos c
proj = perspective 0.1 100 (camHeightAngle c) (camWidth c / camHeight c)
invFloat :: Matrix Float -> Matrix Float
invFloat m = realToFracMatrix $ inv (realToFracMatrix m :: Matrix Double)
realToFracMatrix :: (Real a, Fractional t, Element t, Element a) => Matrix a -> Matrix t
realToFracMatrix m = fromLists $ map realToFrac <$> toLists m
unit :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t
unit v = scale (1/realToFrac (norm_2 v)) v
|
