diff options
author | Andor Penzes <andor.penzes@gmail.com> | 2016-01-13 15:20:55 +0100 |
---|---|---|
committer | Andor Penzes <andor.penzes@gmail.com> | 2016-01-13 15:20:55 +0100 |
commit | acacc8a5aadfa3040df10c61f2641fd5be2ca34d (patch) | |
tree | c3f8a052d2d456a2b074b13c1ce2e613a5794f3f /lc | |
parent | edb1d07ee70325447ffc20904d333b5b079b18f9 (diff) |
install lambdacube prelude as package data
Diffstat (limited to 'lc')
-rw-r--r-- | lc/Builtins.lc | 572 | ||||
-rw-r--r-- | lc/Internals.lc | 62 | ||||
-rw-r--r-- | lc/Prelude.lc | 362 |
3 files changed, 996 insertions, 0 deletions
diff --git a/lc/Builtins.lc b/lc/Builtins.lc new file mode 100644 index 00000000..674335cb --- /dev/null +++ b/lc/Builtins.lc | |||
@@ -0,0 +1,572 @@ | |||
1 | {-# LANGUAGE NoImplicitPrelude #-} | ||
2 | module Builtins | ||
3 | ( module Internals | ||
4 | , module Builtins | ||
5 | ) where | ||
6 | |||
7 | import Internals | ||
8 | |||
9 | id x = x | ||
10 | |||
11 | --------------------------------------- | ||
12 | |||
13 | data Nat = Zero | Succ Nat | ||
14 | |||
15 | data List a = Nil | Cons a (List a) | ||
16 | |||
17 | type family JoinTupleType t1 t2 where | ||
18 | -- TODO | ||
19 | JoinTupleType () a = a | ||
20 | JoinTupleType a () = a | ||
21 | JoinTupleType (a, b) c = (a, b, c) | ||
22 | JoinTupleType a (b, c) = (a, b, c) | ||
23 | JoinTupleType a (b, c, d) = (a, b, c, d) | ||
24 | JoinTupleType a (b, c, d, e) = (a, b, c, d, e) | ||
25 | JoinTupleType a b = (a, b) | ||
26 | |||
27 | class AttributeTuple a | ||
28 | instance AttributeTuple a -- TODO | ||
29 | class ValidOutput a | ||
30 | instance ValidOutput a -- TODO | ||
31 | class ValidFrameBuffer a | ||
32 | instance ValidFrameBuffer a -- TODO | ||
33 | |||
34 | data VecS (a :: Type) :: Nat -> Type where | ||
35 | V2 :: a -> a -> VecS a 2 | ||
36 | V3 :: a -> a -> a -> VecS a 3 | ||
37 | V4 :: a -> a -> a -> a -> VecS a 4 | ||
38 | |||
39 | type family Vec (n :: Nat) t where Vec n t = VecS t n | ||
40 | |||
41 | type family VecScalar (n :: Nat) a where | ||
42 | VecScalar 1 a = a | ||
43 | VecScalar ('Succ ('Succ n)) a = Vec ('Succ ('Succ n)) a | ||
44 | |||
45 | -- may be a data family? | ||
46 | type family TFVec (n :: Nat) a where | ||
47 | TFVec n a = Vec n a -- TODO: check range: n = 2,3,4; a is Float, Int, Word, Bool | ||
48 | |||
49 | -- todo: use less constructors with more parameters | ||
50 | data Mat :: Nat -> Nat -> Type -> Type where | ||
51 | M22F :: Vec 2 Float -> Vec 2 Float -> Mat 2 2 Float | ||
52 | M32F :: Vec 3 Float -> Vec 3 Float -> Mat 3 2 Float | ||
53 | M42F :: Vec 4 Float -> Vec 4 Float -> Mat 4 2 Float | ||
54 | M23F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 3 Float | ||
55 | M33F :: Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Mat 3 3 Float | ||
56 | M43F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 3 Float | ||
57 | M24F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 4 Float | ||
58 | M34F :: Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Mat 3 4 Float | ||
59 | M44F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 4 Float | ||
60 | |||
61 | type family MatVecElem a where | ||
62 | MatVecElem (VecS a n) = a | ||
63 | MatVecElem (Mat i j a) = a | ||
64 | |||
65 | type family MatVecScalarElem a where | ||
66 | MatVecScalarElem Float = Float | ||
67 | MatVecScalarElem Bool = Bool | ||
68 | MatVecScalarElem Int = Int | ||
69 | MatVecScalarElem (VecS a n) = a | ||
70 | MatVecScalarElem (Mat i j a) = a | ||
71 | |||
72 | -- may be a data family? | ||
73 | type family TFMat i j where | ||
74 | TFMat (VecS a i) (VecS a' j) = T2 (a ~ a') (Mat i j a) | ||
75 | |||
76 | --------------------------------------- swizzling | ||
77 | |||
78 | data Swizz = Sx | Sy | Sz | Sw | ||
79 | |||
80 | -- todo: use pattern matching | ||
81 | mapVec :: forall a b m . (a -> b) -> Vec m a -> Vec m b | ||
82 | mapVec @a @b @m f v = 'VecSCase (\m _ -> 'Vec m b) | ||
83 | (\x y -> V2 (f x) (f y)) | ||
84 | (\x y z -> V3 (f x) (f y) (f z)) | ||
85 | (\x y z w -> V4 (f x) (f y) (f z) (f w)) | ||
86 | @m | ||
87 | v | ||
88 | |||
89 | -- todo: make it more type safe | ||
90 | swizzscalar :: forall n . Vec n a -> Swizz -> a | ||
91 | swizzscalar (V2 x y) Sx = x | ||
92 | swizzscalar (V2 x y) Sy = y | ||
93 | swizzscalar (V3 x y z) Sx = x | ||
94 | swizzscalar (V3 x y z) Sy = y | ||
95 | swizzscalar (V3 x y z) Sz = z | ||
96 | swizzscalar (V4 x y z w) Sx = x | ||
97 | swizzscalar (V4 x y z w) Sy = y | ||
98 | swizzscalar (V4 x y z w) Sz = z | ||
99 | swizzscalar (V4 x y z w) Sw = w | ||
100 | |||
101 | -- used to prevent unfolding of swizzvector on variables (behind GPU lambda) | ||
102 | definedVec :: forall a m . Vec m a -> Bool | ||
103 | definedVec (V2 _ _) = True | ||
104 | definedVec (V3 _ _ _) = True | ||
105 | definedVec (V4 _ _ _ _) = True | ||
106 | |||
107 | swizzvector :: forall n . forall m . Vec n a -> Vec m Swizz -> Vec m a | ||
108 | swizzvector v w | definedVec v = mapVec (swizzscalar v) w | ||
109 | |||
110 | |||
111 | --------------------------------------- type classes | ||
112 | |||
113 | class CNum a | ||
114 | |||
115 | instance CNum Int | ||
116 | instance CNum Float | ||
117 | |||
118 | class Signed a | ||
119 | |||
120 | instance Signed Int | ||
121 | instance Signed Float | ||
122 | |||
123 | class Num a where | ||
124 | fromInt :: Int -> a | ||
125 | compare :: a -> a -> Ordering | ||
126 | negate :: a -> a | ||
127 | |||
128 | instance Num Int where | ||
129 | fromInt = id | ||
130 | compare = primCompareInt | ||
131 | negate = primNegateInt | ||
132 | instance Num Word where | ||
133 | fromInt = primIntToWord | ||
134 | compare = primCompareWord | ||
135 | negate = primNegateWord | ||
136 | instance Num Float where | ||
137 | fromInt = primIntToFloat | ||
138 | compare = primCompareFloat | ||
139 | negate = primNegateFloat | ||
140 | |||
141 | class Component a where | ||
142 | vec2 :: a -> a -> Vec 2 a | ||
143 | vec3 :: a -> a -> a -> Vec 3 a | ||
144 | vec4 :: a -> a -> a -> a -> Vec 4 a | ||
145 | zeroComp :: a | ||
146 | oneComp :: a | ||
147 | -- PrimZero, PrimOne :: {- (Component a) => -- TODO -} a | ||
148 | |||
149 | instance Component Bool where | ||
150 | vec2 = V2 | ||
151 | vec3 = V3 | ||
152 | vec4 = V4 | ||
153 | zeroComp = False | ||
154 | oneComp = True | ||
155 | instance Component Int where | ||
156 | vec2 = V2 | ||
157 | vec3 = V3 | ||
158 | vec4 = V4 | ||
159 | zeroComp = 0 :: Int -- todo | ||
160 | oneComp = 1 :: Int -- todo | ||
161 | |||
162 | instance Component Word where | ||
163 | vec2 = V2 | ||
164 | vec3 = V3 | ||
165 | vec4 = V4 | ||
166 | zeroComp = 0 :: Word | ||
167 | oneComp = 1 :: Word | ||
168 | |||
169 | instance Component Float where | ||
170 | vec2 = V2 | ||
171 | vec3 = V3 | ||
172 | vec4 = V4 | ||
173 | zeroComp = 0.0 -- todo: 0 | ||
174 | oneComp = 1.0 -- todo: 1 | ||
175 | instance Component (VecS Float 2) where | ||
176 | vec2 = V2 | ||
177 | vec3 = V3 | ||
178 | vec4 = V4 | ||
179 | zeroComp = V2 0.0 0.0 | ||
180 | oneComp = V2 1.0 1.0 | ||
181 | instance Component (VecS Float 3) where | ||
182 | vec2 = V2 | ||
183 | vec3 = V3 | ||
184 | vec4 = V4 | ||
185 | zeroComp = V3 0.0 0.0 0.0 | ||
186 | oneComp = V3 1.0 1.0 1.0 | ||
187 | instance Component (VecS Float 4) where | ||
188 | vec2 = V2 | ||
189 | vec3 = V3 | ||
190 | vec4 = V4 | ||
191 | zeroComp = V4 0.0 0.0 0.0 0.0 | ||
192 | oneComp = V4 1.0 1.0 1.0 1.0 | ||
193 | instance Component (VecS Bool 2) {-where-} | ||
194 | instance Component (VecS Bool 3) {-where-} | ||
195 | instance Component (VecS Bool 4) where | ||
196 | vec2 = V2 | ||
197 | vec3 = V3 | ||
198 | vec4 = V4 | ||
199 | zeroComp = V4 False False False False | ||
200 | oneComp = V4 True True True True | ||
201 | |||
202 | class Integral a | ||
203 | |||
204 | instance Integral Int | ||
205 | instance Integral Word | ||
206 | |||
207 | class NumComponent a | ||
208 | |||
209 | instance NumComponent Int | ||
210 | instance NumComponent Word | ||
211 | instance NumComponent Float | ||
212 | instance NumComponent (VecS Float 2) | ||
213 | instance NumComponent (VecS Float 3) | ||
214 | instance NumComponent (VecS Float 4) | ||
215 | |||
216 | class Floating a | ||
217 | |||
218 | instance Floating Float | ||
219 | instance Floating (VecS Float 2) -- todo: use Vec | ||
220 | instance Floating (VecS Float 3) | ||
221 | instance Floating (VecS Float 4) | ||
222 | instance Floating (Mat 2 2 Float) | ||
223 | instance Floating (Mat 2 3 Float) | ||
224 | instance Floating (Mat 2 4 Float) | ||
225 | instance Floating (Mat 3 2 Float) | ||
226 | instance Floating (Mat 3 3 Float) | ||
227 | instance Floating (Mat 3 4 Float) | ||
228 | instance Floating (Mat 4 2 Float) | ||
229 | instance Floating (Mat 4 3 Float) | ||
230 | instance Floating (Mat 4 4 Float) | ||
231 | |||
232 | data BlendingFactor | ||
233 | = Zero' --- FIXME: modified | ||
234 | | One | ||
235 | | SrcColor | ||
236 | | OneMinusSrcColor | ||
237 | | DstColor | ||
238 | | OneMinusDstColor | ||
239 | | SrcAlpha | ||
240 | | OneMinusSrcAlpha | ||
241 | | DstAlpha | ||
242 | | OneMinusDstAlpha | ||
243 | | ConstantColor | ||
244 | | OneMinusConstantColor | ||
245 | | ConstantAlpha | ||
246 | | OneMinusConstantAlpha | ||
247 | | SrcAlphaSaturate | ||
248 | |||
249 | data BlendEquation | ||
250 | = FuncAdd | ||
251 | | FuncSubtract | ||
252 | | FuncReverseSubtract | ||
253 | | Min | ||
254 | | Max | ||
255 | |||
256 | data LogicOperation | ||
257 | = Clear | ||
258 | | And | ||
259 | | AndReverse | ||
260 | | Copy | ||
261 | | AndInverted | ||
262 | | Noop | ||
263 | | Xor | ||
264 | | Or | ||
265 | | Nor | ||
266 | | Equiv | ||
267 | | Invert | ||
268 | | OrReverse | ||
269 | | CopyInverted | ||
270 | | OrInverted | ||
271 | | Nand | ||
272 | | Set | ||
273 | |||
274 | data StencilOperation | ||
275 | = OpZero | ||
276 | | OpKeep | ||
277 | | OpReplace | ||
278 | | OpIncr | ||
279 | | OpIncrWrap | ||
280 | | OpDecr | ||
281 | | OpDecrWrap | ||
282 | | OpInvert | ||
283 | |||
284 | data ComparisonFunction | ||
285 | = Never | ||
286 | | Less | ||
287 | | Equal | ||
288 | | Lequal | ||
289 | | Greater | ||
290 | | Notequal | ||
291 | | Gequal | ||
292 | | Always | ||
293 | |||
294 | data ProvokingVertex | ||
295 | = LastVertex | ||
296 | | FirstVertex | ||
297 | |||
298 | data FrontFace | ||
299 | = CW | ||
300 | | CCW | ||
301 | |||
302 | data CullMode | ||
303 | = CullFront FrontFace | ||
304 | | CullBack FrontFace | ||
305 | | CullNone | ||
306 | |||
307 | data PointSize | ||
308 | = PointSize Float | ||
309 | | ProgramPointSize | ||
310 | |||
311 | data PolygonMode | ||
312 | = PolygonFill | ||
313 | | PolygonPoint PointSize | ||
314 | | PolygonLine Float | ||
315 | |||
316 | data PolygonOffset | ||
317 | = NoOffset | ||
318 | | Offset Float Float | ||
319 | |||
320 | data PointSpriteCoordOrigin | ||
321 | = LowerLeft | ||
322 | | UpperLeft | ||
323 | |||
324 | |||
325 | data Depth a where | ||
326 | data Stencil a where | ||
327 | data Color a where | ||
328 | |||
329 | type family ColorRepr a where | ||
330 | ColorRepr () = () | ||
331 | ColorRepr (a, b) = (Color a, Color b) | ||
332 | ColorRepr (a, b, c) = (Color a, Color b, Color c) | ||
333 | ColorRepr (a, b, c, d) = (Color a, Color b, Color c, Color d) | ||
334 | ColorRepr (a, b, c, d, e) = (Color a, Color b, Color c, Color d, Color e) | ||
335 | ColorRepr a = Color a -- TODO | ||
336 | |||
337 | data PrimitiveType | ||
338 | = Triangle | ||
339 | | Line | ||
340 | | Point | ||
341 | | TriangleAdjacency | ||
342 | | LineAdjacency | ||
343 | |||
344 | -- builtin | ||
345 | primTexture :: () -> Vec 2 Float -> Vec 4 Float | ||
346 | |||
347 | -- builtins | ||
348 | Uniform :: String -> t | ||
349 | Attribute :: String -> t | ||
350 | |||
351 | data FragmentShader :: Type -> Type where | ||
352 | FragmentShader :: (a ~ ColorRepr t) => (b -> t) -> FragmentShader (b -> a) | ||
353 | FragmentShaderDepth :: (x ~ ColorRepr t, a ~ JoinTupleType (Depth Float) x) => (b -> (Float, t)) | ||
354 | -> FragmentShader (b -> a) | ||
355 | FragmentShaderRastDepth :: (x ~ ColorRepr t, a ~ JoinTupleType (Depth Float) x) => (b -> t) | ||
356 | -> FragmentShader (b -> a) | ||
357 | |||
358 | data RasterContext :: PrimitiveType -> Type where | ||
359 | TriangleCtx :: CullMode -> PolygonMode -> PolygonOffset -> ProvokingVertex -> RasterContext Triangle | ||
360 | PointCtx :: PointSize -> Float -> PointSpriteCoordOrigin -> RasterContext Point | ||
361 | LineCtx :: Float -> ProvokingVertex -> RasterContext Line | ||
362 | |||
363 | data Interpolated t where | ||
364 | Smooth, NoPerspective | ||
365 | :: (Floating t) => t -> Interpolated t | ||
366 | Flat :: t -> Interpolated t | ||
367 | |||
368 | type family FTRepr' a where | ||
369 | -- TODO | ||
370 | FTRepr' [a] = a | ||
371 | FTRepr' ([a], [b]) = (a, b) | ||
372 | FTRepr' (Interpolated a) = a | ||
373 | FTRepr' (Interpolated a, Interpolated b) = (a, b) | ||
374 | FTRepr' (Interpolated a, Interpolated b, Interpolated c) = (a, b, c) | ||
375 | |||
376 | data VertexOut a where | ||
377 | VertexOut :: (a ~ FTRepr' x) => Vec 4 Float -> Float -> (){-TODO-} -> x -> VertexOut a | ||
378 | |||
379 | data Blending :: Type -> Type where | ||
380 | NoBlending :: Blending t | ||
381 | BlendLogicOp :: (Integral t) => LogicOperation -> Blending t | ||
382 | Blend :: (BlendEquation, BlendEquation) | ||
383 | -> ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor)) | ||
384 | -> Vec 4 Float -> Blending Float | ||
385 | |||
386 | {- TODO: more precise kinds | ||
387 | FragmentOperation :: Semantic -> * | ||
388 | FragmentOut :: Semantic -> * | ||
389 | VertexOut :: ??? | ||
390 | -} | ||
391 | |||
392 | data StencilTests | ||
393 | data StencilOps | ||
394 | data Int32 | ||
395 | |||
396 | data FragmentOperation :: Type -> Type where | ||
397 | ColorOp :: (mask ~ VecScalar d Bool, color ~ VecScalar d c, Num c) => Blending c -> mask | ||
398 | -> FragmentOperation (Color color) | ||
399 | DepthOp :: ComparisonFunction -> Bool -> FragmentOperation (Depth Float) | ||
400 | StencilOp :: StencilTests -> StencilOps -> StencilOps -> FragmentOperation (Stencil Int32) | ||
401 | |||
402 | type family FragOps a where | ||
403 | FragOps (FragmentOperation t) = t | ||
404 | FragOps (FragmentOperation t1, FragmentOperation t2) = (t1, t2) | ||
405 | FragOps (FragmentOperation t1, FragmentOperation t2, FragmentOperation t3) = (t1, t2, t3) | ||
406 | FragOps (FragmentOperation t1, FragmentOperation t2, FragmentOperation t3, FragmentOperation t4) = (t1, t2, t3, t4) | ||
407 | FragOps (FragmentOperation t1, FragmentOperation t2, FragmentOperation t3, FragmentOperation t4, FragmentOperation t5) = (t1, t2, t3, t4, t5) | ||
408 | |||
409 | data AccumulationContext a where | ||
410 | AccumulationContext :: (a ~ FragOps t) => t -> AccumulationContext a | ||
411 | |||
412 | data FragmentFilter t where | ||
413 | PassAll :: FragmentFilter t | ||
414 | Filter :: (t -> Bool) -> FragmentFilter t | ||
415 | |||
416 | data VertexStream (a :: PrimitiveType) t where | ||
417 | Fetch :: (AttributeTuple t) => String -> t -> VertexStream a t | ||
418 | FetchArrays :: (AttributeTuple t, t ~ FTRepr' t') => t' -> VertexStream a t | ||
419 | |||
420 | fetch s a t = Fetch @a s t | ||
421 | fetchArrays a t = FetchArrays @a t | ||
422 | |||
423 | data PrimitiveStream (p :: PrimitiveType) :: Nat -> Type -> Type where | ||
424 | Transform :: (a -> VertexOut b) -> VertexStream p a -> PrimitiveStream p 1 b | ||
425 | |||
426 | -- Render Operations | ||
427 | data FragmentStream (n :: Nat) a where | ||
428 | Rasterize :: RasterContext x -> PrimitiveStream x n a -> FragmentStream n a | ||
429 | |||
430 | data FilteredFragmentStream (n :: Nat) a where | ||
431 | FilteredFragmentStream | ||
432 | :: FragmentFilter a -> FragmentStream n a -> FilteredFragmentStream n a | ||
433 | |||
434 | data Fragments (n :: Nat) b where | ||
435 | Fragments :: ValidOutput b => FragmentShader (a -> b) -> FilteredFragmentStream n a -> Fragments n b | ||
436 | |||
437 | -- todo: mutually defined with FrameBuffer and Image | ||
438 | type family TFFrameBuffer a {-where | ||
439 | TFFrameBuffer (Image n t) = FrameBuffer n t | ||
440 | TFFrameBuffer (Image n1 t1, Image n2 t2) {- TODO | n1 == n2 -} = FrameBuffer n1 (t1, t2) | ||
441 | TFFrameBuffer (Image n1 t1, Image n2 t2, Image n2 t3) {- TODO | n1 == n2 && n2 == n3 -} = FrameBuffer n1 (t1, t2, t3) | ||
442 | -} | ||
443 | data FrameBuffer (n :: Nat) b where | ||
444 | Accumulate :: AccumulationContext b -> Fragments n b -> FrameBuffer n b -> FrameBuffer n b | ||
445 | FrameBuffer :: (ValidFrameBuffer b, FrameBuffer n b ~ TFFrameBuffer a) => a -> FrameBuffer n b | ||
446 | |||
447 | accumulate ctx ffilt fshader fstr fb = Accumulate ctx (Fragments fshader (FilteredFragmentStream ffilt fstr)) fb | ||
448 | |||
449 | data Image :: Nat -> Type -> Type where | ||
450 | ColorImage :: forall a d t color . (Num t, color ~ VecScalar d t) | ||
451 | => color -> Image a (Color color) | ||
452 | DepthImage :: forall a . Float -> Image a (Depth Float) | ||
453 | StencilImage :: forall a . Int -> Image a (Stencil Int) | ||
454 | |||
455 | -- texture support | ||
456 | PrjImage :: FrameBuffer 1 a -> Image 1 a | ||
457 | PrjImageColor :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float)) -> Image 1 (Color (Vec 4 Float)) | ||
458 | |||
459 | data Output where | ||
460 | ScreenOut :: FrameBuffer a b -> Output | ||
461 | |||
462 | ------------------------------------------------------------------- | ||
463 | -- * Builtin Primitive Functions * | ||
464 | -- Arithmetic Functions (componentwise) | ||
465 | |||
466 | PrimAdd, PrimSub, PrimMul :: Num (MatVecElem a) => a -> a -> a | ||
467 | PrimAddS, PrimSubS, PrimMulS :: (t ~ MatVecScalarElem a, Num t) => a -> t -> a | ||
468 | PrimDiv, PrimMod :: (Num t, a ~ VecScalar d t) => a -> a -> a | ||
469 | PrimDivS, PrimModS :: (Num t, a ~ VecScalar d t) => a -> t -> a | ||
470 | PrimNeg :: Signed (MatVecScalarElem a) => a -> a | ||
471 | -- Bit-wise Functions | ||
472 | PrimBAnd, PrimBOr, PrimBXor :: (Integral t, a ~ VecScalar d t) => a -> a -> a | ||
473 | PrimBAndS, PrimBOrS, PrimBXorS:: (Integral t, a ~ VecScalar d t) => a -> t -> a | ||
474 | PrimBNot :: (Integral t, a ~ VecScalar d t) => a -> a | ||
475 | PrimBShiftL, PrimBShiftR :: (Integral t, a ~ VecScalar d t, b ~ VecScalar d Word) => a -> b -> a | ||
476 | PrimBShiftLS, PrimBShiftRS :: (Integral t, a ~ VecScalar d t) => a -> Word -> a | ||
477 | -- Logic Functions | ||
478 | PrimAnd, PrimOr, PrimXor :: Bool -> Bool -> Bool | ||
479 | PrimNot :: (a ~ VecScalar d Bool) => a -> a | ||
480 | PrimAny, PrimAll :: VecScalar d Bool -> Bool | ||
481 | |||
482 | -- Angle, Trigonometry and Exponential Functions | ||
483 | PrimACos, PrimACosH, PrimASin, PrimASinH, PrimATan, PrimATanH, PrimCos, PrimCosH, PrimDegrees, PrimRadians, PrimSin, PrimSinH, PrimTan, PrimTanH, PrimExp, PrimLog, PrimExp2, PrimLog2, PrimSqrt, PrimInvSqrt | ||
484 | :: (a ~ VecScalar d Float) => a -> a | ||
485 | PrimPow, PrimATan2 :: (a ~ VecScalar d Float) => a -> a -> a | ||
486 | -- Common Functions | ||
487 | PrimFloor, PrimTrunc, PrimRound, PrimRoundEven, PrimCeil, PrimFract | ||
488 | :: (a ~ VecScalar d Float) => a -> a | ||
489 | PrimMin, PrimMax :: (Num t, a ~ VecScalar d t) => a -> a -> a | ||
490 | PrimMinS, PrimMaxS :: (Num t, a ~ VecScalar d t) => a -> t -> a | ||
491 | PrimIsNan, PrimIsInf :: (a ~ VecScalar d Float, b ~ VecScalar d Bool) => a -> b | ||
492 | PrimAbs, PrimSign :: (Signed t, a ~ VecScalar d t) => a -> a | ||
493 | PrimModF :: (a ~ VecScalar d Float) => a -> (a, a) | ||
494 | PrimClamp :: (Num t, a ~ VecScalar d t) => a -> a -> a -> a | ||
495 | PrimClampS :: (Num t, a ~ VecScalar d t) => a -> t -> t -> a | ||
496 | PrimMix :: (a ~ VecScalar d Float) => a -> a -> a -> a | ||
497 | PrimMixS :: (a ~ VecScalar d Float) => a -> a -> Float -> a | ||
498 | PrimMixB :: (a ~ VecScalar d Float, b ~ VecScalar d Bool) => a -> a -> b -> a | ||
499 | PrimStep :: (a ~ TFVec d Float) => a -> a -> a | ||
500 | PrimStepS :: (a ~ VecScalar d Float) => Float -> a -> a | ||
501 | PrimSmoothStep :: (a ~ TFVec d Float) => a -> a -> a -> a | ||
502 | PrimSmoothStepS :: (a ~ VecScalar d Float) => Float -> Float -> a -> a | ||
503 | |||
504 | -- Integer/Floatonversion Functions | ||
505 | PrimFloatBitsToInt :: VecScalar d Float -> VecScalar d Int | ||
506 | PrimFloatBitsToUInt :: VecScalar d Float -> VecScalar d Word | ||
507 | PrimIntBitsToFloat :: VecScalar d Int -> VecScalar d Float | ||
508 | PrimUIntBitsToFloat :: VecScalar d Word -> VecScalar d Float | ||
509 | -- Geometric Functions | ||
510 | PrimLength :: (a ~ VecScalar d Float) => a -> Float | ||
511 | PrimDistance, PrimDot :: (a ~ VecScalar d Float) => a -> a -> Float | ||
512 | PrimCross :: (a ~ VecScalar 3 Float) => a -> a -> a | ||
513 | PrimNormalize :: (a ~ VecScalar d Float) => a -> a | ||
514 | PrimFaceForward, PrimRefract :: (a ~ VecScalar d Float) => a -> a -> a -> a | ||
515 | PrimReflect :: (a ~ VecScalar d Float) => a -> a -> a | ||
516 | -- Matrix Functions | ||
517 | PrimTranspose :: TFMat h w -> TFMat w h | ||
518 | PrimDeterminant :: TFMat s s -> Float | ||
519 | PrimInverse :: TFMat s s -> TFMat s s | ||
520 | PrimOuterProduct :: w -> h -> TFMat h w | ||
521 | PrimMulMatVec :: TFMat h w -> w -> h | ||
522 | PrimMulVecMat :: h -> TFMat h w -> w | ||
523 | PrimMulMatMat :: TFMat i j -> TFMat j k -> TFMat i k | ||
524 | -- Vector and Scalar Relational Functions | ||
525 | PrimLessThan, PrimLessThanEqual, PrimGreaterThan, PrimGreaterThanEqual, PrimEqualV, PrimNotEqualV | ||
526 | :: (Num t, a ~ VecScalar d t, b ~ VecScalar d Bool) => a -> a -> b | ||
527 | PrimEqual, PrimNotEqual :: (t ~ MatVecScalarElem a) => a -> a -> Bool | ||
528 | -- Fragment Processing Functions | ||
529 | PrimDFdx, PrimDFdy, PrimFWidth | ||
530 | :: (a ~ VecScalar d Float) => a -> a | ||
531 | -- Noise Functions | ||
532 | PrimNoise1 :: VecScalar d Float -> Float | ||
533 | PrimNoise2 :: VecScalar d Float -> Vec 2 Float | ||
534 | PrimNoise3 :: VecScalar d Float -> Vec 3 Float | ||
535 | PrimNoise4 :: VecScalar d Float -> Vec 4 Float | ||
536 | |||
537 | {- | ||
538 | -- Vec/Mat (de)construction | ||
539 | PrimTupToV2 :: Component a => PrimFun stage ((a,a) -> V2 a) | ||
540 | PrimTupToV3 :: Component a => PrimFun stage ((a,a,a) -> V3 a) | ||
541 | PrimTupToV4 :: Component a => PrimFun stage ((a,a,a,a) -> V4 a) | ||
542 | PrimV2ToTup :: Component a => PrimFun stage (V2 a -> (a,a)) | ||
543 | PrimV3ToTup :: Component a => PrimFun stage (V3 a -> (a,a,a)) | ||
544 | PrimV4ToTup :: Component a => PrimFun stage (V4 a -> (a,a,a,a)) | ||
545 | -} | ||
546 | |||
547 | -------------------- | ||
548 | -- * Texture support | ||
549 | -- FIXME: currently only Float RGBA 2D texture is supported | ||
550 | |||
551 | data Texture where | ||
552 | Texture2DSlot :: String -- texture slot name | ||
553 | -> Texture | ||
554 | |||
555 | Texture2D :: Vec 2 Int -- FIXME: use Word here | ||
556 | -> Image 1 (Color (Vec 4 Float)) | ||
557 | -> Texture | ||
558 | |||
559 | data Filter | ||
560 | = PointFilter | ||
561 | | LinearFilter | ||
562 | |||
563 | data EdgeMode | ||
564 | = Repeat | ||
565 | | MirroredRepeat | ||
566 | | ClampToEdge | ||
567 | |||
568 | data Sampler = Sampler Filter EdgeMode Texture | ||
569 | |||
570 | -- builtin | ||
571 | texture2D :: Sampler -> Vec 2 Float -> Vec 4 Float | ||
572 | |||
diff --git a/lc/Internals.lc b/lc/Internals.lc new file mode 100644 index 00000000..b64d5a41 --- /dev/null +++ b/lc/Internals.lc | |||
@@ -0,0 +1,62 @@ | |||
1 | {-# LANGUAGE NoImplicitPrelude #-} | ||
2 | -- declarations of builtin functions and data types used by the compiler | ||
3 | module Internals where | ||
4 | |||
5 | undefined :: forall (a :: Type) . a | ||
6 | |||
7 | data Unit = TT | ||
8 | data String | ||
9 | data Empty (a :: String) | ||
10 | |||
11 | -- TODO: generate? | ||
12 | data Tuple0 = Tuple0 | ||
13 | data Tuple1 a = Tuple1 a | ||
14 | data Tuple2 a b = Tuple2 a b | ||
15 | data Tuple3 a b c = Tuple3 a b c | ||
16 | data Tuple4 a b c d = Tuple4 a b c d | ||
17 | data Tuple5 a b c d e = Tuple5 a b c d e | ||
18 | |||
19 | |||
20 | -- ... TODO | ||
21 | |||
22 | -- builtin used for overlapping instances | ||
23 | parEval :: forall a -> a -> a -> a | ||
24 | |||
25 | type family EqC a b -- equality constraints | ||
26 | type family T2 a b -- conjuction of constraints | ||
27 | |||
28 | -- builtin conjuction of constraint witnesses | ||
29 | t2C :: Unit -> Unit -> Unit | ||
30 | |||
31 | -- builtin type constructors | ||
32 | data Int | ||
33 | data Word | ||
34 | data Float | ||
35 | data Char | ||
36 | |||
37 | data Bool = False | True | ||
38 | |||
39 | data Ordering = LT | EQ | GT | ||
40 | |||
41 | -- builtin primitives | ||
42 | primIntToWord :: Int -> Word | ||
43 | primIntToFloat :: Int -> Float | ||
44 | primCompareInt :: Int -> Int -> Ordering | ||
45 | primCompareWord :: Word -> Word -> Ordering | ||
46 | primCompareFloat :: Float -> Float -> Ordering | ||
47 | primCompareString :: String -> String -> Ordering | ||
48 | primNegateInt :: Int -> Int | ||
49 | primNegateWord :: Word -> Word | ||
50 | primNegateFloat :: Float -> Float | ||
51 | primAddInt :: Int -> Int -> Int | ||
52 | primSubInt :: Int -> Int -> Int | ||
53 | primModInt :: Int -> Int -> Int | ||
54 | primSqrtFloat :: Float -> Float | ||
55 | primRound :: Float -> Int | ||
56 | |||
57 | |||
58 | primIfThenElse :: Bool -> a -> a -> a | ||
59 | primIfThenElse True a b = a | ||
60 | primIfThenElse False a b = b | ||
61 | |||
62 | |||
diff --git a/lc/Prelude.lc b/lc/Prelude.lc new file mode 100644 index 00000000..6ab787d1 --- /dev/null +++ b/lc/Prelude.lc | |||
@@ -0,0 +1,362 @@ | |||
1 | {-# LANGUAGE NoImplicitPrelude #-} | ||
2 | module Prelude | ||
3 | ( module Prelude | ||
4 | , module Builtins | ||
5 | ) where | ||
6 | |||
7 | import Builtins | ||
8 | |||
9 | infixr 9 . | ||
10 | infixl 7 `PrimMulMatVec`, `PrimDot` | ||
11 | infixr 3 *** | ||
12 | infixr 5 : | ||
13 | infixr 0 $ | ||
14 | --infixl 0 & | ||
15 | |||
16 | const x y = x | ||
17 | |||
18 | otherwise = True | ||
19 | |||
20 | x & f = f x | ||
21 | |||
22 | ($) = \f x -> f x | ||
23 | (.) = \f g x -> f (g x) | ||
24 | |||
25 | uncurry f (x, y) = f x y | ||
26 | |||
27 | (***) f g (x, y) = (f x, g y) | ||
28 | |||
29 | pi = 3.14 | ||
30 | |||
31 | zip :: [a] -> [b] -> [(a,b)] | ||
32 | zip [] xs = [] | ||
33 | zip xs [] = [] | ||
34 | zip (a: as) (b: bs) = (a,b): zip as bs | ||
35 | |||
36 | unzip :: [(a,b)] -> ([a],[b]) | ||
37 | unzip [] = ([],[]) | ||
38 | unzip ((a,b):xs) = (a:as,b:bs) | ||
39 | where (as,bs) = unzip xs | ||
40 | |||
41 | filter pred [] = [] | ||
42 | filter pred (x:xs) = case pred x of | ||
43 | True -> (x : filter pred xs) | ||
44 | False -> (filter pred xs) | ||
45 | |||
46 | head :: [a] -> a | ||
47 | head (a: _) = a | ||
48 | |||
49 | tail :: [a] -> [a] | ||
50 | tail (_: xs) = xs | ||
51 | |||
52 | pairs :: [a] -> [(a, a)] | ||
53 | pairs v = zip v (tail v) | ||
54 | |||
55 | foldl' f e [] = e | ||
56 | foldl' f e (x: xs) = foldl' f (f e x) xs | ||
57 | |||
58 | singleton a = [a] | ||
59 | |||
60 | append [] ys = ys | ||
61 | append (x:xs) ys = x : append xs ys | ||
62 | |||
63 | concat = foldl' append [] | ||
64 | |||
65 | map _ [] = [] | ||
66 | map f (x:xs) = f x : map f xs | ||
67 | |||
68 | concatMap :: (a -> [b]) -> [a] -> [b] | ||
69 | concatMap f x = concat (map f x) | ||
70 | |||
71 | split [] = ([], []) | ||
72 | split (x: xs) = (x: bs, as) where (as, bs) = split xs | ||
73 | |||
74 | mergeBy f (x:xs) (y:ys) = case f x y of | ||
75 | LT -> x: mergeBy f xs (y:ys) | ||
76 | _ -> y: mergeBy f (x:xs) ys | ||
77 | mergeBy f [] xs = xs | ||
78 | mergeBy f xs [] = xs | ||
79 | |||
80 | sortBy f [] = [] | ||
81 | sortBy f [x] = [x] | ||
82 | sortBy f xs = uncurry (mergeBy f) ((sortBy f *** sortBy f) (split xs)) | ||
83 | |||
84 | data Maybe a | ||
85 | = Nothing | ||
86 | | Just a | ||
87 | -- deriving (Eq, Ord, Show) | ||
88 | |||
89 | |||
90 | fst (a, b) = a | ||
91 | snd (a, b) = b | ||
92 | |||
93 | tuptype :: [Type] -> Type | ||
94 | tuptype [] = '() | ||
95 | tuptype (x:xs) = '(x, tuptype xs) | ||
96 | |||
97 | data RecordC (xs :: [(String, Type)]) | ||
98 | = RecordCons (tuptype (map snd xs)) | ||
99 | |||
100 | foldr1 f [x] = x | ||
101 | foldr1 f (x: xs) = f x (foldr1 f xs) | ||
102 | |||
103 | isEQ EQ = True | ||
104 | isEQ _ = False | ||
105 | |||
106 | False ||| x = x | ||
107 | True ||| x = True | ||
108 | |||
109 | infixr 2 ||| | ||
110 | |||
111 | True &&& x = x | ||
112 | False &&& x = False | ||
113 | |||
114 | infixr 3 &&& | ||
115 | |||
116 | class Eq a where | ||
117 | (===) :: a -> a -> Bool -- todo: use (==) sign | ||
118 | |||
119 | infix 4 === | ||
120 | |||
121 | instance Eq String where | ||
122 | a === b = isEQ (primCompareString a b) | ||
123 | |||
124 | ------------------------------------ Row polymorphism | ||
125 | -- todo: sorted field names (more efficient & easier to use) | ||
126 | |||
127 | isKey _ [] = False | ||
128 | isKey s ((s', _): ss) = s === s' ||| isKey s ss | ||
129 | |||
130 | isKeyC _ _ [] = 'Empty "" | ||
131 | isKeyC s t ((s', t'): ss) = if s === s' then t ~ t' else isKeyC s t ss | ||
132 | |||
133 | subList [] _ = [] | ||
134 | subList ((s, t): xs) ys = if isKey s ys then subList xs ys else (s, t): subList xs ys | ||
135 | |||
136 | addList [] ys = ys | ||
137 | addList ((s, t): xs) ys = if isKey s ys then addList xs ys else (s, t): addList xs ys | ||
138 | |||
139 | findEq x [] = 'Unit | ||
140 | findEq (s, t) ((s', t'):xs) = if s === s' then 'T2 (t ~ t') (findEq (s, t) xs) else findEq (s, t) xs | ||
141 | |||
142 | sameEq [] _ = 'Unit | ||
143 | sameEq (x: xs) ys = 'T2 (findEq x ys) (sameEq xs ys) | ||
144 | |||
145 | defined [] = True | ||
146 | defined (x: xs) = defined xs | ||
147 | |||
148 | type family Split a b c | ||
149 | type instance Split (RecordC xs) (RecordC ys) z | defined xs &&& defined ys = T2 (sameEq xs ys) (z ~ RecordC (subList xs ys)) | ||
150 | type instance Split (RecordC xs) z (RecordC ys) | defined xs &&& defined ys = T2 (sameEq xs ys) (z ~ RecordC (subList xs ys)) | ||
151 | type instance Split z (RecordC xs) (RecordC ys) | defined xs &&& defined ys = T2 (sameEq xs ys) (z ~ RecordC (addList xs ys)) | ||
152 | |||
153 | -- builtin | ||
154 | -- TODO | ||
155 | record :: [(String, Type)] -> Type | ||
156 | --record xs = RecordCons ({- TODO: sortBy fst-} xs) | ||
157 | |||
158 | -- builtin | ||
159 | unsafeCoerce :: forall a b . a -> b | ||
160 | |||
161 | -- todo: don't use unsafeCoerce | ||
162 | project :: forall a (xs :: [(String, Type)]) . forall (s :: String) -> 'isKeyC s a xs => RecordC xs -> a | ||
163 | project @a @((s', a'): xs) s @_ (RecordCons ts) | s === s' = fst (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts) | ||
164 | project @a @((s', a'): xs) s @_ (RecordCons ts) = project @a @xs s @undefined (RecordCons (snd (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts))) | ||
165 | |||
166 | --------------------------------------- HTML colors | ||
167 | |||
168 | rgb r g b = V4 r g b 1.0 | ||
169 | |||
170 | black = rgb 0.0 0.0 0.0 | ||
171 | gray = rgb 0.5 0.5 0.5 | ||
172 | silver = rgb 0.75 0.75 0.75 | ||
173 | white = rgb 1.0 1.0 1.0 | ||
174 | maroon = rgb 0.5 0.0 0.0 | ||
175 | red = rgb 1.0 0.0 0.0 | ||
176 | olive = rgb 0.5 0.5 0.0 | ||
177 | yellow = rgb 1.0 1.0 0.0 | ||
178 | green = rgb 0.0 0.5 0.0 | ||
179 | lime = rgb 0.0 1.0 0.0 | ||
180 | teal = rgb 0.0 0.5 0.5 | ||
181 | aqua = rgb 0.0 1.0 1.0 | ||
182 | navy = rgb 0.0 0.0 0.5 | ||
183 | blue = rgb 0.0 0.0 1.0 | ||
184 | purple = rgb 0.5 0.0 0.5 | ||
185 | fuchsia = rgb 1.0 0.0 1.0 | ||
186 | |||
187 | colorImage1 = ColorImage @1 | ||
188 | colorImage2 = ColorImage @2 | ||
189 | |||
190 | depthImage1 = DepthImage @1 | ||
191 | |||
192 | v3FToV4F :: Vec 3 Float -> Vec 4 Float | ||
193 | v3FToV4F v = V4 0.0 0.0 0.0 1.0 --- todo! -- V4 v%x v%y v%z 1 | ||
194 | |||
195 | ------------ | ||
196 | -- * WebGL 1 | ||
197 | ------------ | ||
198 | |||
199 | -- angle and trigonometric | ||
200 | radians = PrimRadians | ||
201 | degrees = PrimDegrees | ||
202 | sin = PrimSin | ||
203 | cos = PrimCos | ||
204 | tan = PrimTan | ||
205 | asin = PrimASin | ||
206 | acos = PrimACos | ||
207 | atan = PrimATan | ||
208 | atan2 = PrimATan2 | ||
209 | |||
210 | -- exponential functions | ||
211 | pow = PrimPow | ||
212 | exp = PrimExp | ||
213 | log = PrimLog | ||
214 | exp2 = PrimExp2 | ||
215 | log2 = PrimLog2 | ||
216 | sqrt = PrimSqrt | ||
217 | inversesqrt = PrimInvSqrt | ||
218 | |||
219 | -- common functions | ||
220 | abs = PrimAbs | ||
221 | sign = PrimSign | ||
222 | floor = PrimFloor | ||
223 | ceil = PrimCeil | ||
224 | fract = PrimFract | ||
225 | mod = PrimMod | ||
226 | min = PrimMin | ||
227 | max = PrimMax | ||
228 | clamp = PrimClamp | ||
229 | clampS = PrimClampS | ||
230 | mix = PrimMix | ||
231 | step = PrimStep | ||
232 | smoothstep = PrimSmoothStep | ||
233 | |||
234 | -- geometric functions | ||
235 | length = PrimLength | ||
236 | distance = PrimDistance | ||
237 | dot = PrimDot | ||
238 | cross = PrimCross | ||
239 | normalize = PrimNormalize | ||
240 | faceforward = PrimFaceForward | ||
241 | reflect = PrimReflect | ||
242 | refract = PrimRefract | ||
243 | |||
244 | -- operators | ||
245 | infixl 7 *, /, % | ||
246 | infixl 6 +, - | ||
247 | infix 4 ==, /=, <, <=, >=, > | ||
248 | |||
249 | infixr 3 && | ||
250 | infixr 2 || | ||
251 | |||
252 | infix 7 `dot` -- dot | ||
253 | infix 7 `cross` -- cross | ||
254 | |||
255 | infixr 7 *. -- mulmv | ||
256 | infixl 7 .* -- mulvm | ||
257 | infixl 7 .*. -- mulmm | ||
258 | |||
259 | -- arithemtic | ||
260 | a + b = PrimAdd a b | ||
261 | a - b = PrimSub a b | ||
262 | a * b = PrimMul a b | ||
263 | a / b = PrimDiv a b | ||
264 | a % b = PrimMod a b | ||
265 | |||
266 | neg a = PrimNeg a | ||
267 | |||
268 | -- comparison | ||
269 | a == b = PrimEqual a b | ||
270 | a /= b = PrimNotEqual a b | ||
271 | a < b = PrimLessThan a b | ||
272 | a <= b = PrimLessThanEqual a b | ||
273 | a >= b = PrimGreaterThanEqual a b | ||
274 | a > b = PrimGreaterThan a b | ||
275 | |||
276 | -- logical | ||
277 | a && b = PrimAnd a b | ||
278 | a || b = PrimOr a b | ||
279 | not a = PrimNot a | ||
280 | any a = PrimAny a | ||
281 | all a = PrimAll a | ||
282 | |||
283 | -- matrix functions | ||
284 | a .*. b = PrimMulMatMat a b | ||
285 | a *. b = PrimMulMatVec a b | ||
286 | a .* b = PrimMulVecMat a b | ||
287 | |||
288 | dFdx = PrimDFdx | ||
289 | dFdy = PrimDFdy | ||
290 | |||
291 | -- extra | ||
292 | round = PrimRound | ||
293 | |||
294 | |||
295 | -- temp hack for vector <---> scalar operators | ||
296 | infixl 7 *!, /!, %! | ||
297 | infixl 6 +!, -! | ||
298 | |||
299 | -- arithemtic | ||
300 | a +! b = PrimAddS a b | ||
301 | a -! b = PrimSubS a b | ||
302 | a *! b = PrimMulS a b | ||
303 | a /! b = PrimDivS a b | ||
304 | a %! b = PrimModS a b | ||
305 | |||
306 | ------------------ | ||
307 | -- common matrices | ||
308 | ------------------ | ||
309 | {- | ||
310 | -- | Perspective transformation matrix in row major order. | ||
311 | perspective :: Float -- ^ Near plane clipping distance (always positive). | ||
312 | -> Float -- ^ Far plane clipping distance (always positive). | ||
313 | -> Float -- ^ Field of view of the y axis, in radians. | ||
314 | -> Float -- ^ Aspect ratio, i.e. screen's width\/height. | ||
315 | -> Mat 4 4 Float | ||
316 | perspective n f fovy aspect = --transpose $ | ||
317 | M44F (V4F (2*n/(r-l)) 0 (-(r+l)/(r-l)) 0) | ||
318 | (V4F 0 (2*n/(t-b)) ((t+b)/(t-b)) 0) | ||
319 | (V4F 0 0 (-(f+n)/(f-n)) (-2*f*n/(f-n))) | ||
320 | (V4F 0 0 (-1) 0) | ||
321 | where | ||
322 | t = n*tan(fovy/2) | ||
323 | b = -t | ||
324 | r = aspect*t | ||
325 | l = -r | ||
326 | -} | ||
327 | rotMatrixZ a = M44F (V4 c s 0 0) (V4 (-s) c 0 0) (V4 0 0 1 0) (V4 0 0 0 1) | ||
328 | where | ||
329 | c = cos a | ||
330 | s = sin a | ||
331 | |||
332 | rotMatrixY a = M44F (V4 c 0 (-s) 0) (V4 0 1 0 0) (V4 s 0 c 0) (V4 0 0 0 1) | ||
333 | where | ||
334 | c = cos a | ||
335 | s = sin a | ||
336 | |||
337 | rotMatrixX a = M44F (V4 1 0 0 0) (V4 0 c s 0) (V4 0 (-s) c 0) (V4 0 0 0 1) | ||
338 | where | ||
339 | c = cos a | ||
340 | s = sin a | ||
341 | |||
342 | rotationEuler a b c = rotMatrixY a .*. rotMatrixX b .*. rotMatrixZ c | ||
343 | |||
344 | {- | ||
345 | -- | Camera transformation matrix. | ||
346 | lookat :: Vec 3 Float -- ^ Camera position. | ||
347 | -> Vec 3 Float -- ^ Target position. | ||
348 | -> Vec 3 Float -- ^ Upward direction. | ||
349 | -> M44F | ||
350 | lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r) | ||
351 | where | ||
352 | w = normalize $ pos - target | ||
353 | u = normalize $ up `cross` w | ||
354 | v = w `cross` u | ||
355 | r = transpose $ Mat3 u v w | ||
356 | -} | ||
357 | |||
358 | scale t v = v * V4 t t t 1.0 | ||
359 | |||
360 | fromTo :: Float -> Float -> [Float] | ||
361 | fromTo a b = if a > b then [] else a: fromTo (a +! 1.0) b | ||
362 | |||