diff options
-rw-r--r-- | lambdacube-compiler.cabal | 4 | ||||
-rw-r--r-- | src/IR.hs | 1608 | ||||
-rw-r--r-- | src/Linear.hs | 60 |
3 files changed, 2 insertions, 1670 deletions
diff --git a/lambdacube-compiler.cabal b/lambdacube-compiler.cabal index a0755b8c..893874b5 100644 --- a/lambdacube-compiler.cabal +++ b/lambdacube-compiler.cabal | |||
@@ -20,8 +20,6 @@ library | |||
20 | exposed-modules: | 20 | exposed-modules: |
21 | -- Compiler | 21 | -- Compiler |
22 | Pretty | 22 | Pretty |
23 | IR | ||
24 | Linear | ||
25 | CoreToIR | 23 | CoreToIR |
26 | CoreToGLSL | 24 | CoreToGLSL |
27 | Infer | 25 | Infer |
@@ -60,6 +58,7 @@ library | |||
60 | indentation >= 0.2 && <0.3, | 58 | indentation >= 0.2 && <0.3, |
61 | pretty-compact >=1.0 && <1.1, | 59 | pretty-compact >=1.0 && <1.1, |
62 | text >= 1.2 && <1.3, | 60 | text >= 1.2 && <1.3, |
61 | lambdacube-ir, | ||
63 | vector >= 0.11 && <0.12 | 62 | vector >= 0.11 && <0.12 |
64 | hs-source-dirs: src | 63 | hs-source-dirs: src |
65 | default-language: Haskell2010 | 64 | default-language: Haskell2010 |
@@ -82,6 +81,7 @@ executable lambdacube-compiler-test-suite | |||
82 | indentation >= 0.2 && <0.3, | 81 | indentation >= 0.2 && <0.3, |
83 | pretty-compact >=1.0 && <1.1, | 82 | pretty-compact >=1.0 && <1.1, |
84 | text >= 1.2 && <1.3, | 83 | text >= 1.2 && <1.3, |
84 | lambdacube-ir, | ||
85 | vector >= 0.11 && <0.12 | 85 | vector >= 0.11 && <0.12 |
86 | default-language: Haskell2010 | 86 | default-language: Haskell2010 |
87 | if flag(profiling) | 87 | if flag(profiling) |
diff --git a/src/IR.hs b/src/IR.hs deleted file mode 100644 index 81d42558..00000000 --- a/src/IR.hs +++ /dev/null | |||
@@ -1,1608 +0,0 @@ | |||
1 | -- generated file, do not modify! | ||
2 | -- 2015-09-15T22:39:08.045384000000Z | ||
3 | |||
4 | {-# LANGUAGE OverloadedStrings, RecordWildCards #-} | ||
5 | module IR where | ||
6 | |||
7 | import Data.Int | ||
8 | import Data.Word | ||
9 | import Data.Map | ||
10 | import Data.Vector (Vector(..)) | ||
11 | import Linear | ||
12 | |||
13 | import Data.Text | ||
14 | import Data.Aeson hiding (Value,Bool) | ||
15 | import Data.Aeson.Types hiding (Value,Bool) | ||
16 | import Control.Monad | ||
17 | |||
18 | |||
19 | type StreamName = Int | ||
20 | |||
21 | type ProgramName = Int | ||
22 | |||
23 | type TextureName = Int | ||
24 | |||
25 | type SamplerName = Int | ||
26 | |||
27 | type UniformName = String | ||
28 | |||
29 | type SlotName = Int | ||
30 | |||
31 | type FrameBufferComponent = Int | ||
32 | |||
33 | type TextureUnit = Int | ||
34 | |||
35 | type RenderTargetName = Int | ||
36 | |||
37 | type TextureUnitMapping = Map UniformName TextureUnit | ||
38 | |||
39 | data ArrayValue | ||
40 | = VBoolArray (Vector Bool) | ||
41 | | VIntArray (Vector Int32) | ||
42 | | VWordArray (Vector Word32) | ||
43 | | VFloatArray (Vector Float) | ||
44 | deriving (Show, Eq, Ord) | ||
45 | |||
46 | data Value | ||
47 | = VBool Bool | ||
48 | | VV2B V2B | ||
49 | | VV3B V3B | ||
50 | | VV4B V4B | ||
51 | | VWord Word32 | ||
52 | | VV2U V2U | ||
53 | | VV3U V3U | ||
54 | | VV4U V4U | ||
55 | | VInt Int32 | ||
56 | | VV2I V2I | ||
57 | | VV3I V3I | ||
58 | | VV4I V4I | ||
59 | | VFloat Float | ||
60 | | VV2F V2F | ||
61 | | VV3F V3F | ||
62 | | VV4F V4F | ||
63 | | VM22F M22F | ||
64 | | VM23F M23F | ||
65 | | VM24F M24F | ||
66 | | VM32F M32F | ||
67 | | VM33F M33F | ||
68 | | VM34F M34F | ||
69 | | VM42F M42F | ||
70 | | VM43F M43F | ||
71 | | VM44F M44F | ||
72 | deriving (Show, Eq, Ord) | ||
73 | |||
74 | data InputType | ||
75 | = Bool | ||
76 | | V2B | ||
77 | | V3B | ||
78 | | V4B | ||
79 | | Word | ||
80 | | V2U | ||
81 | | V3U | ||
82 | | V4U | ||
83 | | Int | ||
84 | | V2I | ||
85 | | V3I | ||
86 | | V4I | ||
87 | | Float | ||
88 | | V2F | ||
89 | | V3F | ||
90 | | V4F | ||
91 | | M22F | ||
92 | | M23F | ||
93 | | M24F | ||
94 | | M32F | ||
95 | | M33F | ||
96 | | M34F | ||
97 | | M42F | ||
98 | | M43F | ||
99 | | M44F | ||
100 | | STexture1D | ||
101 | | STexture2D | ||
102 | | STextureCube | ||
103 | | STexture1DArray | ||
104 | | STexture2DArray | ||
105 | | STexture2DRect | ||
106 | | FTexture1D | ||
107 | | FTexture2D | ||
108 | | FTexture3D | ||
109 | | FTextureCube | ||
110 | | FTexture1DArray | ||
111 | | FTexture2DArray | ||
112 | | FTexture2DMS | ||
113 | | FTexture2DMSArray | ||
114 | | FTextureBuffer | ||
115 | | FTexture2DRect | ||
116 | | ITexture1D | ||
117 | | ITexture2D | ||
118 | | ITexture3D | ||
119 | | ITextureCube | ||
120 | | ITexture1DArray | ||
121 | | ITexture2DArray | ||
122 | | ITexture2DMS | ||
123 | | ITexture2DMSArray | ||
124 | | ITextureBuffer | ||
125 | | ITexture2DRect | ||
126 | | UTexture1D | ||
127 | | UTexture2D | ||
128 | | UTexture3D | ||
129 | | UTextureCube | ||
130 | | UTexture1DArray | ||
131 | | UTexture2DArray | ||
132 | | UTexture2DMS | ||
133 | | UTexture2DMSArray | ||
134 | | UTextureBuffer | ||
135 | | UTexture2DRect | ||
136 | deriving (Show, Eq, Ord) | ||
137 | |||
138 | data PointSpriteCoordOrigin | ||
139 | = LowerLeft | ||
140 | | UpperLeft | ||
141 | deriving (Show, Eq, Ord) | ||
142 | |||
143 | data PointSize | ||
144 | = PointSize Float | ||
145 | | ProgramPointSize | ||
146 | deriving (Show, Eq, Ord) | ||
147 | |||
148 | data PolygonOffset | ||
149 | = NoOffset | ||
150 | | Offset Float Float | ||
151 | deriving (Show, Eq, Ord) | ||
152 | |||
153 | data FrontFace | ||
154 | = CCW | ||
155 | | CW | ||
156 | deriving (Show, Eq, Ord) | ||
157 | |||
158 | data PolygonMode | ||
159 | = PolygonPoint PointSize | ||
160 | | PolygonLine Float | ||
161 | | PolygonFill | ||
162 | deriving (Show, Eq, Ord) | ||
163 | |||
164 | data ProvokingVertex | ||
165 | = FirstVertex | ||
166 | | LastVertex | ||
167 | deriving (Show, Eq, Ord) | ||
168 | |||
169 | data CullMode | ||
170 | = CullNone | ||
171 | | CullFront FrontFace | ||
172 | | CullBack FrontFace | ||
173 | deriving (Show, Eq, Ord) | ||
174 | |||
175 | data ComparisonFunction | ||
176 | = Never | ||
177 | | Less | ||
178 | | Equal | ||
179 | | Lequal | ||
180 | | Greater | ||
181 | | Notequal | ||
182 | | Gequal | ||
183 | | Always | ||
184 | deriving (Show, Eq, Ord) | ||
185 | |||
186 | type DepthFunction = ComparisonFunction | ||
187 | |||
188 | data StencilOperation | ||
189 | = OpZero | ||
190 | | OpKeep | ||
191 | | OpReplace | ||
192 | | OpIncr | ||
193 | | OpIncrWrap | ||
194 | | OpDecr | ||
195 | | OpDecrWrap | ||
196 | | OpInvert | ||
197 | deriving (Show, Eq, Ord) | ||
198 | |||
199 | data BlendEquation | ||
200 | = FuncAdd | ||
201 | | FuncSubtract | ||
202 | | FuncReverseSubtract | ||
203 | | Min | ||
204 | | Max | ||
205 | deriving (Show, Eq, Ord) | ||
206 | |||
207 | data BlendingFactor | ||
208 | = Zero | ||
209 | | One | ||
210 | | SrcColor | ||
211 | | OneMinusSrcColor | ||
212 | | DstColor | ||
213 | | OneMinusDstColor | ||
214 | | SrcAlpha | ||
215 | | OneMinusSrcAlpha | ||
216 | | DstAlpha | ||
217 | | OneMinusDstAlpha | ||
218 | | ConstantColor | ||
219 | | OneMinusConstantColor | ||
220 | | ConstantAlpha | ||
221 | | OneMinusConstantAlpha | ||
222 | | SrcAlphaSaturate | ||
223 | deriving (Show, Eq, Ord) | ||
224 | |||
225 | data LogicOperation | ||
226 | = Clear | ||
227 | | And | ||
228 | | AndReverse | ||
229 | | Copy | ||
230 | | AndInverted | ||
231 | | Noop | ||
232 | | Xor | ||
233 | | Or | ||
234 | | Nor | ||
235 | | Equiv | ||
236 | | Invert | ||
237 | | OrReverse | ||
238 | | CopyInverted | ||
239 | | OrInverted | ||
240 | | Nand | ||
241 | | Set | ||
242 | deriving (Show, Eq, Ord) | ||
243 | |||
244 | data StencilOps | ||
245 | = StencilOps | ||
246 | { frontStencilOp :: StencilOperation | ||
247 | , backStencilOp :: StencilOperation | ||
248 | } | ||
249 | |||
250 | deriving (Show, Eq, Ord) | ||
251 | |||
252 | data StencilTest | ||
253 | = StencilTest | ||
254 | { stencilComparision :: ComparisonFunction | ||
255 | , stencilReference :: Int32 | ||
256 | , stencilMask :: Word32 | ||
257 | } | ||
258 | |||
259 | deriving (Show, Eq, Ord) | ||
260 | |||
261 | data StencilTests | ||
262 | = StencilTests StencilTest StencilTest | ||
263 | deriving (Show, Eq, Ord) | ||
264 | |||
265 | data FetchPrimitive | ||
266 | = Points | ||
267 | | Lines | ||
268 | | Triangles | ||
269 | | LinesAdjacency | ||
270 | | TrianglesAdjacency | ||
271 | deriving (Show, Eq, Ord) | ||
272 | |||
273 | data OutputPrimitive | ||
274 | = TrianglesOutput | ||
275 | | LinesOutput | ||
276 | | PointsOutput | ||
277 | deriving (Show, Eq, Ord) | ||
278 | |||
279 | data ColorArity | ||
280 | = Red | ||
281 | | RG | ||
282 | | RGB | ||
283 | | RGBA | ||
284 | deriving (Show, Eq, Ord) | ||
285 | |||
286 | data Blending | ||
287 | = NoBlending | ||
288 | | BlendLogicOp LogicOperation | ||
289 | | Blend | ||
290 | { colorEqSrc :: BlendEquation | ||
291 | , alphaEqSrc :: BlendEquation | ||
292 | , colorFSrc :: BlendingFactor | ||
293 | , colorFDst :: BlendingFactor | ||
294 | , alphaFSrc :: BlendingFactor | ||
295 | , alphaFDst :: BlendingFactor | ||
296 | , color :: V4F | ||
297 | } | ||
298 | |||
299 | deriving (Show, Eq, Ord) | ||
300 | |||
301 | data RasterContext | ||
302 | = PointCtx PointSize Float PointSpriteCoordOrigin | ||
303 | | LineCtx Float ProvokingVertex | ||
304 | | TriangleCtx CullMode PolygonMode PolygonOffset ProvokingVertex | ||
305 | deriving (Show, Eq, Ord) | ||
306 | |||
307 | data FragmentOperation | ||
308 | = DepthOp DepthFunction Bool | ||
309 | | StencilOp StencilTests StencilOps StencilOps | ||
310 | | ColorOp Blending Value | ||
311 | deriving (Show, Eq, Ord) | ||
312 | |||
313 | data AccumulationContext | ||
314 | = AccumulationContext | ||
315 | { accViewportName :: Maybe String | ||
316 | , accOperations :: [FragmentOperation] | ||
317 | } | ||
318 | |||
319 | deriving (Show, Eq, Ord) | ||
320 | |||
321 | data TextureDataType | ||
322 | = FloatT ColorArity | ||
323 | | IntT ColorArity | ||
324 | | WordT ColorArity | ||
325 | | ShadowT | ||
326 | deriving (Show, Eq, Ord) | ||
327 | |||
328 | data TextureType | ||
329 | = Texture1D TextureDataType Int | ||
330 | | Texture2D TextureDataType Int | ||
331 | | Texture3D TextureDataType | ||
332 | | TextureCube TextureDataType | ||
333 | | TextureRect TextureDataType | ||
334 | | Texture2DMS TextureDataType Int Int Bool | ||
335 | | TextureBuffer TextureDataType | ||
336 | deriving (Show, Eq, Ord) | ||
337 | |||
338 | data MipMap | ||
339 | = Mip Int Int | ||
340 | | NoMip | ||
341 | | AutoMip Int Int | ||
342 | deriving (Show, Eq, Ord) | ||
343 | |||
344 | data Filter | ||
345 | = Nearest | ||
346 | | Linear | ||
347 | | NearestMipmapNearest | ||
348 | | NearestMipmapLinear | ||
349 | | LinearMipmapNearest | ||
350 | | LinearMipmapLinear | ||
351 | deriving (Show, Eq, Ord) | ||
352 | |||
353 | data EdgeMode | ||
354 | = Repeat | ||
355 | | MirroredRepeat | ||
356 | | ClampToEdge | ||
357 | | ClampToBorder | ||
358 | deriving (Show, Eq, Ord) | ||
359 | |||
360 | data ImageSemantic | ||
361 | = Depth | ||
362 | | Stencil | ||
363 | | Color | ||
364 | deriving (Show, Eq, Ord) | ||
365 | |||
366 | data ImageRef | ||
367 | = TextureImage TextureName Int (Maybe Int) | ||
368 | | Framebuffer ImageSemantic | ||
369 | deriving (Show, Eq, Ord) | ||
370 | |||
371 | data ClearImage | ||
372 | = ClearImage | ||
373 | { imageSemantic :: ImageSemantic | ||
374 | , clearValue :: Value | ||
375 | } | ||
376 | |||
377 | deriving (Show, Eq, Ord) | ||
378 | |||
379 | data Command | ||
380 | = SetRasterContext RasterContext | ||
381 | | SetAccumulationContext AccumulationContext | ||
382 | | SetRenderTarget RenderTargetName | ||
383 | | SetProgram ProgramName | ||
384 | | SetSamplerUniform UniformName TextureUnit | ||
385 | | SetTexture TextureUnit TextureName | ||
386 | | SetSampler TextureUnit (Maybe SamplerName) | ||
387 | | RenderSlot SlotName | ||
388 | | RenderStream StreamName | ||
389 | | ClearRenderTarget (Vector ClearImage) | ||
390 | | GenerateMipMap TextureUnit | ||
391 | | SaveImage FrameBufferComponent ImageRef | ||
392 | | LoadImage ImageRef FrameBufferComponent | ||
393 | deriving (Show, Eq, Ord) | ||
394 | |||
395 | data SamplerDescriptor | ||
396 | = SamplerDescriptor | ||
397 | { samplerWrapS :: EdgeMode | ||
398 | , samplerWrapT :: Maybe EdgeMode | ||
399 | , samplerWrapR :: Maybe EdgeMode | ||
400 | , samplerMinFilter :: Filter | ||
401 | , samplerMagFilter :: Filter | ||
402 | , samplerBorderColor :: Value | ||
403 | , samplerMinLod :: Maybe Float | ||
404 | , samplerMaxLod :: Maybe Float | ||
405 | , samplerLodBias :: Float | ||
406 | , samplerCompareFunc :: Maybe ComparisonFunction | ||
407 | } | ||
408 | |||
409 | deriving (Show, Eq, Ord) | ||
410 | |||
411 | data TextureDescriptor | ||
412 | = TextureDescriptor | ||
413 | { textureType :: TextureType | ||
414 | , textureSize :: Value | ||
415 | , textureSemantic :: ImageSemantic | ||
416 | , textureSampler :: SamplerDescriptor | ||
417 | , textureBaseLevel :: Int | ||
418 | , textureMaxLevel :: Int | ||
419 | } | ||
420 | |||
421 | deriving (Show, Eq, Ord) | ||
422 | |||
423 | data Parameter | ||
424 | = Parameter | ||
425 | { name :: String | ||
426 | , ty :: InputType | ||
427 | } | ||
428 | |||
429 | deriving (Show, Eq, Ord) | ||
430 | |||
431 | data Program | ||
432 | = Program | ||
433 | { programUniforms :: Map UniformName InputType | ||
434 | , programStreams :: Map UniformName Parameter | ||
435 | , programInTextures :: Map UniformName InputType | ||
436 | , programOutput :: Vector Parameter | ||
437 | , vertexShader :: String | ||
438 | , geometryShader :: Maybe String | ||
439 | , fragmentShader :: String | ||
440 | } | ||
441 | |||
442 | deriving (Show, Eq, Ord) | ||
443 | |||
444 | data Slot | ||
445 | = Slot | ||
446 | { slotName :: String | ||
447 | , slotStreams :: Map String InputType | ||
448 | , slotUniforms :: Map UniformName InputType | ||
449 | , slotPrimitive :: FetchPrimitive | ||
450 | , slotPrograms :: Vector ProgramName | ||
451 | } | ||
452 | |||
453 | deriving (Show, Eq, Ord) | ||
454 | |||
455 | data StreamData | ||
456 | = StreamData | ||
457 | { streamData :: Map String ArrayValue | ||
458 | , streamType :: Map String InputType | ||
459 | , streamPrimitive :: FetchPrimitive | ||
460 | , streamPrograms :: Vector ProgramName | ||
461 | } | ||
462 | |||
463 | deriving (Show, Eq, Ord) | ||
464 | |||
465 | data TargetItem | ||
466 | = TargetItem | ||
467 | { targetSemantic :: ImageSemantic | ||
468 | , targetRef :: Maybe ImageRef | ||
469 | } | ||
470 | |||
471 | deriving (Show, Eq, Ord) | ||
472 | |||
473 | data RenderTarget | ||
474 | = RenderTarget | ||
475 | { renderTargets :: Vector TargetItem | ||
476 | } | ||
477 | |||
478 | deriving (Show, Eq, Ord) | ||
479 | |||
480 | data Backend | ||
481 | = WebGL1 | ||
482 | | OpenGL33 | ||
483 | deriving (Show, Eq, Ord) | ||
484 | |||
485 | data Pipeline | ||
486 | = Pipeline | ||
487 | { backend :: Backend | ||
488 | , textures :: Vector TextureDescriptor | ||
489 | , samplers :: Vector SamplerDescriptor | ||
490 | , targets :: Vector RenderTarget | ||
491 | , programs :: Vector Program | ||
492 | , slots :: Vector Slot | ||
493 | , streams :: Vector StreamData | ||
494 | , commands :: Vector Command | ||
495 | } | ||
496 | |||
497 | deriving (Show, Eq, Ord) | ||
498 | |||
499 | |||
500 | instance ToJSON ArrayValue where | ||
501 | toJSON v = case v of | ||
502 | VBoolArray arg0 -> object [ "tag" .= ("VBoolArray" :: Text), "arg0" .= arg0] | ||
503 | VIntArray arg0 -> object [ "tag" .= ("VIntArray" :: Text), "arg0" .= arg0] | ||
504 | VWordArray arg0 -> object [ "tag" .= ("VWordArray" :: Text), "arg0" .= arg0] | ||
505 | VFloatArray arg0 -> object [ "tag" .= ("VFloatArray" :: Text), "arg0" .= arg0] | ||
506 | |||
507 | instance FromJSON ArrayValue where | ||
508 | parseJSON (Object obj) = do | ||
509 | tag <- obj .: "tag" | ||
510 | case tag :: Text of | ||
511 | "VBoolArray" -> VBoolArray <$> obj .: "arg0" | ||
512 | "VIntArray" -> VIntArray <$> obj .: "arg0" | ||
513 | "VWordArray" -> VWordArray <$> obj .: "arg0" | ||
514 | "VFloatArray" -> VFloatArray <$> obj .: "arg0" | ||
515 | parseJSON _ = mzero | ||
516 | |||
517 | instance ToJSON Value where | ||
518 | toJSON v = case v of | ||
519 | VBool arg0 -> object [ "tag" .= ("VBool" :: Text), "arg0" .= arg0] | ||
520 | VV2B arg0 -> object [ "tag" .= ("VV2B" :: Text), "arg0" .= arg0] | ||
521 | VV3B arg0 -> object [ "tag" .= ("VV3B" :: Text), "arg0" .= arg0] | ||
522 | VV4B arg0 -> object [ "tag" .= ("VV4B" :: Text), "arg0" .= arg0] | ||
523 | VWord arg0 -> object [ "tag" .= ("VWord" :: Text), "arg0" .= arg0] | ||
524 | VV2U arg0 -> object [ "tag" .= ("VV2U" :: Text), "arg0" .= arg0] | ||
525 | VV3U arg0 -> object [ "tag" .= ("VV3U" :: Text), "arg0" .= arg0] | ||
526 | VV4U arg0 -> object [ "tag" .= ("VV4U" :: Text), "arg0" .= arg0] | ||
527 | VInt arg0 -> object [ "tag" .= ("VInt" :: Text), "arg0" .= arg0] | ||
528 | VV2I arg0 -> object [ "tag" .= ("VV2I" :: Text), "arg0" .= arg0] | ||
529 | VV3I arg0 -> object [ "tag" .= ("VV3I" :: Text), "arg0" .= arg0] | ||
530 | VV4I arg0 -> object [ "tag" .= ("VV4I" :: Text), "arg0" .= arg0] | ||
531 | VFloat arg0 -> object [ "tag" .= ("VFloat" :: Text), "arg0" .= arg0] | ||
532 | VV2F arg0 -> object [ "tag" .= ("VV2F" :: Text), "arg0" .= arg0] | ||
533 | VV3F arg0 -> object [ "tag" .= ("VV3F" :: Text), "arg0" .= arg0] | ||
534 | VV4F arg0 -> object [ "tag" .= ("VV4F" :: Text), "arg0" .= arg0] | ||
535 | VM22F arg0 -> object [ "tag" .= ("VM22F" :: Text), "arg0" .= arg0] | ||
536 | VM23F arg0 -> object [ "tag" .= ("VM23F" :: Text), "arg0" .= arg0] | ||
537 | VM24F arg0 -> object [ "tag" .= ("VM24F" :: Text), "arg0" .= arg0] | ||
538 | VM32F arg0 -> object [ "tag" .= ("VM32F" :: Text), "arg0" .= arg0] | ||
539 | VM33F arg0 -> object [ "tag" .= ("VM33F" :: Text), "arg0" .= arg0] | ||
540 | VM34F arg0 -> object [ "tag" .= ("VM34F" :: Text), "arg0" .= arg0] | ||
541 | VM42F arg0 -> object [ "tag" .= ("VM42F" :: Text), "arg0" .= arg0] | ||
542 | VM43F arg0 -> object [ "tag" .= ("VM43F" :: Text), "arg0" .= arg0] | ||
543 | VM44F arg0 -> object [ "tag" .= ("VM44F" :: Text), "arg0" .= arg0] | ||
544 | |||
545 | instance FromJSON Value where | ||
546 | parseJSON (Object obj) = do | ||
547 | tag <- obj .: "tag" | ||
548 | case tag :: Text of | ||
549 | "VBool" -> VBool <$> obj .: "arg0" | ||
550 | "VV2B" -> VV2B <$> obj .: "arg0" | ||
551 | "VV3B" -> VV3B <$> obj .: "arg0" | ||
552 | "VV4B" -> VV4B <$> obj .: "arg0" | ||
553 | "VWord" -> VWord <$> obj .: "arg0" | ||
554 | "VV2U" -> VV2U <$> obj .: "arg0" | ||
555 | "VV3U" -> VV3U <$> obj .: "arg0" | ||
556 | "VV4U" -> VV4U <$> obj .: "arg0" | ||
557 | "VInt" -> VInt <$> obj .: "arg0" | ||
558 | "VV2I" -> VV2I <$> obj .: "arg0" | ||
559 | "VV3I" -> VV3I <$> obj .: "arg0" | ||
560 | "VV4I" -> VV4I <$> obj .: "arg0" | ||
561 | "VFloat" -> VFloat <$> obj .: "arg0" | ||
562 | "VV2F" -> VV2F <$> obj .: "arg0" | ||
563 | "VV3F" -> VV3F <$> obj .: "arg0" | ||
564 | "VV4F" -> VV4F <$> obj .: "arg0" | ||
565 | "VM22F" -> VM22F <$> obj .: "arg0" | ||
566 | "VM23F" -> VM23F <$> obj .: "arg0" | ||
567 | "VM24F" -> VM24F <$> obj .: "arg0" | ||
568 | "VM32F" -> VM32F <$> obj .: "arg0" | ||
569 | "VM33F" -> VM33F <$> obj .: "arg0" | ||
570 | "VM34F" -> VM34F <$> obj .: "arg0" | ||
571 | "VM42F" -> VM42F <$> obj .: "arg0" | ||
572 | "VM43F" -> VM43F <$> obj .: "arg0" | ||
573 | "VM44F" -> VM44F <$> obj .: "arg0" | ||
574 | parseJSON _ = mzero | ||
575 | |||
576 | instance ToJSON InputType where | ||
577 | toJSON v = case v of | ||
578 | Bool -> object [ "tag" .= ("Bool" :: Text)] | ||
579 | V2B -> object [ "tag" .= ("V2B" :: Text)] | ||
580 | V3B -> object [ "tag" .= ("V3B" :: Text)] | ||
581 | V4B -> object [ "tag" .= ("V4B" :: Text)] | ||
582 | Word -> object [ "tag" .= ("Word" :: Text)] | ||
583 | V2U -> object [ "tag" .= ("V2U" :: Text)] | ||
584 | V3U -> object [ "tag" .= ("V3U" :: Text)] | ||
585 | V4U -> object [ "tag" .= ("V4U" :: Text)] | ||
586 | Int -> object [ "tag" .= ("Int" :: Text)] | ||
587 | V2I -> object [ "tag" .= ("V2I" :: Text)] | ||
588 | V3I -> object [ "tag" .= ("V3I" :: Text)] | ||
589 | V4I -> object [ "tag" .= ("V4I" :: Text)] | ||
590 | Float -> object [ "tag" .= ("Float" :: Text)] | ||
591 | V2F -> object [ "tag" .= ("V2F" :: Text)] | ||
592 | V3F -> object [ "tag" .= ("V3F" :: Text)] | ||
593 | V4F -> object [ "tag" .= ("V4F" :: Text)] | ||
594 | M22F -> object [ "tag" .= ("M22F" :: Text)] | ||
595 | M23F -> object [ "tag" .= ("M23F" :: Text)] | ||
596 | M24F -> object [ "tag" .= ("M24F" :: Text)] | ||
597 | M32F -> object [ "tag" .= ("M32F" :: Text)] | ||
598 | M33F -> object [ "tag" .= ("M33F" :: Text)] | ||
599 | M34F -> object [ "tag" .= ("M34F" :: Text)] | ||
600 | M42F -> object [ "tag" .= ("M42F" :: Text)] | ||
601 | M43F -> object [ "tag" .= ("M43F" :: Text)] | ||
602 | M44F -> object [ "tag" .= ("M44F" :: Text)] | ||
603 | STexture1D -> object [ "tag" .= ("STexture1D" :: Text)] | ||
604 | STexture2D -> object [ "tag" .= ("STexture2D" :: Text)] | ||
605 | STextureCube -> object [ "tag" .= ("STextureCube" :: Text)] | ||
606 | STexture1DArray -> object [ "tag" .= ("STexture1DArray" :: Text)] | ||
607 | STexture2DArray -> object [ "tag" .= ("STexture2DArray" :: Text)] | ||
608 | STexture2DRect -> object [ "tag" .= ("STexture2DRect" :: Text)] | ||
609 | FTexture1D -> object [ "tag" .= ("FTexture1D" :: Text)] | ||
610 | FTexture2D -> object [ "tag" .= ("FTexture2D" :: Text)] | ||
611 | FTexture3D -> object [ "tag" .= ("FTexture3D" :: Text)] | ||
612 | FTextureCube -> object [ "tag" .= ("FTextureCube" :: Text)] | ||
613 | FTexture1DArray -> object [ "tag" .= ("FTexture1DArray" :: Text)] | ||
614 | FTexture2DArray -> object [ "tag" .= ("FTexture2DArray" :: Text)] | ||
615 | FTexture2DMS -> object [ "tag" .= ("FTexture2DMS" :: Text)] | ||
616 | FTexture2DMSArray -> object [ "tag" .= ("FTexture2DMSArray" :: Text)] | ||
617 | FTextureBuffer -> object [ "tag" .= ("FTextureBuffer" :: Text)] | ||
618 | FTexture2DRect -> object [ "tag" .= ("FTexture2DRect" :: Text)] | ||
619 | ITexture1D -> object [ "tag" .= ("ITexture1D" :: Text)] | ||
620 | ITexture2D -> object [ "tag" .= ("ITexture2D" :: Text)] | ||
621 | ITexture3D -> object [ "tag" .= ("ITexture3D" :: Text)] | ||
622 | ITextureCube -> object [ "tag" .= ("ITextureCube" :: Text)] | ||
623 | ITexture1DArray -> object [ "tag" .= ("ITexture1DArray" :: Text)] | ||
624 | ITexture2DArray -> object [ "tag" .= ("ITexture2DArray" :: Text)] | ||
625 | ITexture2DMS -> object [ "tag" .= ("ITexture2DMS" :: Text)] | ||
626 | ITexture2DMSArray -> object [ "tag" .= ("ITexture2DMSArray" :: Text)] | ||
627 | ITextureBuffer -> object [ "tag" .= ("ITextureBuffer" :: Text)] | ||
628 | ITexture2DRect -> object [ "tag" .= ("ITexture2DRect" :: Text)] | ||
629 | UTexture1D -> object [ "tag" .= ("UTexture1D" :: Text)] | ||
630 | UTexture2D -> object [ "tag" .= ("UTexture2D" :: Text)] | ||
631 | UTexture3D -> object [ "tag" .= ("UTexture3D" :: Text)] | ||
632 | UTextureCube -> object [ "tag" .= ("UTextureCube" :: Text)] | ||
633 | UTexture1DArray -> object [ "tag" .= ("UTexture1DArray" :: Text)] | ||
634 | UTexture2DArray -> object [ "tag" .= ("UTexture2DArray" :: Text)] | ||
635 | UTexture2DMS -> object [ "tag" .= ("UTexture2DMS" :: Text)] | ||
636 | UTexture2DMSArray -> object [ "tag" .= ("UTexture2DMSArray" :: Text)] | ||
637 | UTextureBuffer -> object [ "tag" .= ("UTextureBuffer" :: Text)] | ||
638 | UTexture2DRect -> object [ "tag" .= ("UTexture2DRect" :: Text)] | ||
639 | |||
640 | instance FromJSON InputType where | ||
641 | parseJSON (Object obj) = do | ||
642 | tag <- obj .: "tag" | ||
643 | case tag :: Text of | ||
644 | "Bool" -> pure Bool | ||
645 | "V2B" -> pure V2B | ||
646 | "V3B" -> pure V3B | ||
647 | "V4B" -> pure V4B | ||
648 | "Word" -> pure Word | ||
649 | "V2U" -> pure V2U | ||
650 | "V3U" -> pure V3U | ||
651 | "V4U" -> pure V4U | ||
652 | "Int" -> pure Int | ||
653 | "V2I" -> pure V2I | ||
654 | "V3I" -> pure V3I | ||
655 | "V4I" -> pure V4I | ||
656 | "Float" -> pure Float | ||
657 | "V2F" -> pure V2F | ||
658 | "V3F" -> pure V3F | ||
659 | "V4F" -> pure V4F | ||
660 | "M22F" -> pure M22F | ||
661 | "M23F" -> pure M23F | ||
662 | "M24F" -> pure M24F | ||
663 | "M32F" -> pure M32F | ||
664 | "M33F" -> pure M33F | ||
665 | "M34F" -> pure M34F | ||
666 | "M42F" -> pure M42F | ||
667 | "M43F" -> pure M43F | ||
668 | "M44F" -> pure M44F | ||
669 | "STexture1D" -> pure STexture1D | ||
670 | "STexture2D" -> pure STexture2D | ||
671 | "STextureCube" -> pure STextureCube | ||
672 | "STexture1DArray" -> pure STexture1DArray | ||
673 | "STexture2DArray" -> pure STexture2DArray | ||
674 | "STexture2DRect" -> pure STexture2DRect | ||
675 | "FTexture1D" -> pure FTexture1D | ||
676 | "FTexture2D" -> pure FTexture2D | ||
677 | "FTexture3D" -> pure FTexture3D | ||
678 | "FTextureCube" -> pure FTextureCube | ||
679 | "FTexture1DArray" -> pure FTexture1DArray | ||
680 | "FTexture2DArray" -> pure FTexture2DArray | ||
681 | "FTexture2DMS" -> pure FTexture2DMS | ||
682 | "FTexture2DMSArray" -> pure FTexture2DMSArray | ||
683 | "FTextureBuffer" -> pure FTextureBuffer | ||
684 | "FTexture2DRect" -> pure FTexture2DRect | ||
685 | "ITexture1D" -> pure ITexture1D | ||
686 | "ITexture2D" -> pure ITexture2D | ||
687 | "ITexture3D" -> pure ITexture3D | ||
688 | "ITextureCube" -> pure ITextureCube | ||
689 | "ITexture1DArray" -> pure ITexture1DArray | ||
690 | "ITexture2DArray" -> pure ITexture2DArray | ||
691 | "ITexture2DMS" -> pure ITexture2DMS | ||
692 | "ITexture2DMSArray" -> pure ITexture2DMSArray | ||
693 | "ITextureBuffer" -> pure ITextureBuffer | ||
694 | "ITexture2DRect" -> pure ITexture2DRect | ||
695 | "UTexture1D" -> pure UTexture1D | ||
696 | "UTexture2D" -> pure UTexture2D | ||
697 | "UTexture3D" -> pure UTexture3D | ||
698 | "UTextureCube" -> pure UTextureCube | ||
699 | "UTexture1DArray" -> pure UTexture1DArray | ||
700 | "UTexture2DArray" -> pure UTexture2DArray | ||
701 | "UTexture2DMS" -> pure UTexture2DMS | ||
702 | "UTexture2DMSArray" -> pure UTexture2DMSArray | ||
703 | "UTextureBuffer" -> pure UTextureBuffer | ||
704 | "UTexture2DRect" -> pure UTexture2DRect | ||
705 | parseJSON _ = mzero | ||
706 | |||
707 | instance ToJSON PointSpriteCoordOrigin where | ||
708 | toJSON v = case v of | ||
709 | LowerLeft -> object [ "tag" .= ("LowerLeft" :: Text)] | ||
710 | UpperLeft -> object [ "tag" .= ("UpperLeft" :: Text)] | ||
711 | |||
712 | instance FromJSON PointSpriteCoordOrigin where | ||
713 | parseJSON (Object obj) = do | ||
714 | tag <- obj .: "tag" | ||
715 | case tag :: Text of | ||
716 | "LowerLeft" -> pure LowerLeft | ||
717 | "UpperLeft" -> pure UpperLeft | ||
718 | parseJSON _ = mzero | ||
719 | |||
720 | instance ToJSON PointSize where | ||
721 | toJSON v = case v of | ||
722 | PointSize arg0 -> object [ "tag" .= ("PointSize" :: Text), "arg0" .= arg0] | ||
723 | ProgramPointSize -> object [ "tag" .= ("ProgramPointSize" :: Text)] | ||
724 | |||
725 | instance FromJSON PointSize where | ||
726 | parseJSON (Object obj) = do | ||
727 | tag <- obj .: "tag" | ||
728 | case tag :: Text of | ||
729 | "PointSize" -> PointSize <$> obj .: "arg0" | ||
730 | "ProgramPointSize" -> pure ProgramPointSize | ||
731 | parseJSON _ = mzero | ||
732 | |||
733 | instance ToJSON PolygonOffset where | ||
734 | toJSON v = case v of | ||
735 | NoOffset -> object [ "tag" .= ("NoOffset" :: Text)] | ||
736 | Offset arg0 arg1 -> object [ "tag" .= ("Offset" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
737 | |||
738 | instance FromJSON PolygonOffset where | ||
739 | parseJSON (Object obj) = do | ||
740 | tag <- obj .: "tag" | ||
741 | case tag :: Text of | ||
742 | "NoOffset" -> pure NoOffset | ||
743 | "Offset" -> Offset <$> obj .: "arg0" <*> obj .: "arg1" | ||
744 | parseJSON _ = mzero | ||
745 | |||
746 | instance ToJSON FrontFace where | ||
747 | toJSON v = case v of | ||
748 | CCW -> object [ "tag" .= ("CCW" :: Text)] | ||
749 | CW -> object [ "tag" .= ("CW" :: Text)] | ||
750 | |||
751 | instance FromJSON FrontFace where | ||
752 | parseJSON (Object obj) = do | ||
753 | tag <- obj .: "tag" | ||
754 | case tag :: Text of | ||
755 | "CCW" -> pure CCW | ||
756 | "CW" -> pure CW | ||
757 | parseJSON _ = mzero | ||
758 | |||
759 | instance ToJSON PolygonMode where | ||
760 | toJSON v = case v of | ||
761 | PolygonPoint arg0 -> object [ "tag" .= ("PolygonPoint" :: Text), "arg0" .= arg0] | ||
762 | PolygonLine arg0 -> object [ "tag" .= ("PolygonLine" :: Text), "arg0" .= arg0] | ||
763 | PolygonFill -> object [ "tag" .= ("PolygonFill" :: Text)] | ||
764 | |||
765 | instance FromJSON PolygonMode where | ||
766 | parseJSON (Object obj) = do | ||
767 | tag <- obj .: "tag" | ||
768 | case tag :: Text of | ||
769 | "PolygonPoint" -> PolygonPoint <$> obj .: "arg0" | ||
770 | "PolygonLine" -> PolygonLine <$> obj .: "arg0" | ||
771 | "PolygonFill" -> pure PolygonFill | ||
772 | parseJSON _ = mzero | ||
773 | |||
774 | instance ToJSON ProvokingVertex where | ||
775 | toJSON v = case v of | ||
776 | FirstVertex -> object [ "tag" .= ("FirstVertex" :: Text)] | ||
777 | LastVertex -> object [ "tag" .= ("LastVertex" :: Text)] | ||
778 | |||
779 | instance FromJSON ProvokingVertex where | ||
780 | parseJSON (Object obj) = do | ||
781 | tag <- obj .: "tag" | ||
782 | case tag :: Text of | ||
783 | "FirstVertex" -> pure FirstVertex | ||
784 | "LastVertex" -> pure LastVertex | ||
785 | parseJSON _ = mzero | ||
786 | |||
787 | instance ToJSON CullMode where | ||
788 | toJSON v = case v of | ||
789 | CullNone -> object [ "tag" .= ("CullNone" :: Text)] | ||
790 | CullFront arg0 -> object [ "tag" .= ("CullFront" :: Text), "arg0" .= arg0] | ||
791 | CullBack arg0 -> object [ "tag" .= ("CullBack" :: Text), "arg0" .= arg0] | ||
792 | |||
793 | instance FromJSON CullMode where | ||
794 | parseJSON (Object obj) = do | ||
795 | tag <- obj .: "tag" | ||
796 | case tag :: Text of | ||
797 | "CullNone" -> pure CullNone | ||
798 | "CullFront" -> CullFront <$> obj .: "arg0" | ||
799 | "CullBack" -> CullBack <$> obj .: "arg0" | ||
800 | parseJSON _ = mzero | ||
801 | |||
802 | instance ToJSON ComparisonFunction where | ||
803 | toJSON v = case v of | ||
804 | Never -> object [ "tag" .= ("Never" :: Text)] | ||
805 | Less -> object [ "tag" .= ("Less" :: Text)] | ||
806 | Equal -> object [ "tag" .= ("Equal" :: Text)] | ||
807 | Lequal -> object [ "tag" .= ("Lequal" :: Text)] | ||
808 | Greater -> object [ "tag" .= ("Greater" :: Text)] | ||
809 | Notequal -> object [ "tag" .= ("Notequal" :: Text)] | ||
810 | Gequal -> object [ "tag" .= ("Gequal" :: Text)] | ||
811 | Always -> object [ "tag" .= ("Always" :: Text)] | ||
812 | |||
813 | instance FromJSON ComparisonFunction where | ||
814 | parseJSON (Object obj) = do | ||
815 | tag <- obj .: "tag" | ||
816 | case tag :: Text of | ||
817 | "Never" -> pure Never | ||
818 | "Less" -> pure Less | ||
819 | "Equal" -> pure Equal | ||
820 | "Lequal" -> pure Lequal | ||
821 | "Greater" -> pure Greater | ||
822 | "Notequal" -> pure Notequal | ||
823 | "Gequal" -> pure Gequal | ||
824 | "Always" -> pure Always | ||
825 | parseJSON _ = mzero | ||
826 | |||
827 | instance ToJSON StencilOperation where | ||
828 | toJSON v = case v of | ||
829 | OpZero -> object [ "tag" .= ("OpZero" :: Text)] | ||
830 | OpKeep -> object [ "tag" .= ("OpKeep" :: Text)] | ||
831 | OpReplace -> object [ "tag" .= ("OpReplace" :: Text)] | ||
832 | OpIncr -> object [ "tag" .= ("OpIncr" :: Text)] | ||
833 | OpIncrWrap -> object [ "tag" .= ("OpIncrWrap" :: Text)] | ||
834 | OpDecr -> object [ "tag" .= ("OpDecr" :: Text)] | ||
835 | OpDecrWrap -> object [ "tag" .= ("OpDecrWrap" :: Text)] | ||
836 | OpInvert -> object [ "tag" .= ("OpInvert" :: Text)] | ||
837 | |||
838 | instance FromJSON StencilOperation where | ||
839 | parseJSON (Object obj) = do | ||
840 | tag <- obj .: "tag" | ||
841 | case tag :: Text of | ||
842 | "OpZero" -> pure OpZero | ||
843 | "OpKeep" -> pure OpKeep | ||
844 | "OpReplace" -> pure OpReplace | ||
845 | "OpIncr" -> pure OpIncr | ||
846 | "OpIncrWrap" -> pure OpIncrWrap | ||
847 | "OpDecr" -> pure OpDecr | ||
848 | "OpDecrWrap" -> pure OpDecrWrap | ||
849 | "OpInvert" -> pure OpInvert | ||
850 | parseJSON _ = mzero | ||
851 | |||
852 | instance ToJSON BlendEquation where | ||
853 | toJSON v = case v of | ||
854 | FuncAdd -> object [ "tag" .= ("FuncAdd" :: Text)] | ||
855 | FuncSubtract -> object [ "tag" .= ("FuncSubtract" :: Text)] | ||
856 | FuncReverseSubtract -> object [ "tag" .= ("FuncReverseSubtract" :: Text)] | ||
857 | Min -> object [ "tag" .= ("Min" :: Text)] | ||
858 | Max -> object [ "tag" .= ("Max" :: Text)] | ||
859 | |||
860 | instance FromJSON BlendEquation where | ||
861 | parseJSON (Object obj) = do | ||
862 | tag <- obj .: "tag" | ||
863 | case tag :: Text of | ||
864 | "FuncAdd" -> pure FuncAdd | ||
865 | "FuncSubtract" -> pure FuncSubtract | ||
866 | "FuncReverseSubtract" -> pure FuncReverseSubtract | ||
867 | "Min" -> pure Min | ||
868 | "Max" -> pure Max | ||
869 | parseJSON _ = mzero | ||
870 | |||
871 | instance ToJSON BlendingFactor where | ||
872 | toJSON v = case v of | ||
873 | Zero -> object [ "tag" .= ("Zero" :: Text)] | ||
874 | One -> object [ "tag" .= ("One" :: Text)] | ||
875 | SrcColor -> object [ "tag" .= ("SrcColor" :: Text)] | ||
876 | OneMinusSrcColor -> object [ "tag" .= ("OneMinusSrcColor" :: Text)] | ||
877 | DstColor -> object [ "tag" .= ("DstColor" :: Text)] | ||
878 | OneMinusDstColor -> object [ "tag" .= ("OneMinusDstColor" :: Text)] | ||
879 | SrcAlpha -> object [ "tag" .= ("SrcAlpha" :: Text)] | ||
880 | OneMinusSrcAlpha -> object [ "tag" .= ("OneMinusSrcAlpha" :: Text)] | ||
881 | DstAlpha -> object [ "tag" .= ("DstAlpha" :: Text)] | ||
882 | OneMinusDstAlpha -> object [ "tag" .= ("OneMinusDstAlpha" :: Text)] | ||
883 | ConstantColor -> object [ "tag" .= ("ConstantColor" :: Text)] | ||
884 | OneMinusConstantColor -> object [ "tag" .= ("OneMinusConstantColor" :: Text)] | ||
885 | ConstantAlpha -> object [ "tag" .= ("ConstantAlpha" :: Text)] | ||
886 | OneMinusConstantAlpha -> object [ "tag" .= ("OneMinusConstantAlpha" :: Text)] | ||
887 | SrcAlphaSaturate -> object [ "tag" .= ("SrcAlphaSaturate" :: Text)] | ||
888 | |||
889 | instance FromJSON BlendingFactor where | ||
890 | parseJSON (Object obj) = do | ||
891 | tag <- obj .: "tag" | ||
892 | case tag :: Text of | ||
893 | "Zero" -> pure Zero | ||
894 | "One" -> pure One | ||
895 | "SrcColor" -> pure SrcColor | ||
896 | "OneMinusSrcColor" -> pure OneMinusSrcColor | ||
897 | "DstColor" -> pure DstColor | ||
898 | "OneMinusDstColor" -> pure OneMinusDstColor | ||
899 | "SrcAlpha" -> pure SrcAlpha | ||
900 | "OneMinusSrcAlpha" -> pure OneMinusSrcAlpha | ||
901 | "DstAlpha" -> pure DstAlpha | ||
902 | "OneMinusDstAlpha" -> pure OneMinusDstAlpha | ||
903 | "ConstantColor" -> pure ConstantColor | ||
904 | "OneMinusConstantColor" -> pure OneMinusConstantColor | ||
905 | "ConstantAlpha" -> pure ConstantAlpha | ||
906 | "OneMinusConstantAlpha" -> pure OneMinusConstantAlpha | ||
907 | "SrcAlphaSaturate" -> pure SrcAlphaSaturate | ||
908 | parseJSON _ = mzero | ||
909 | |||
910 | instance ToJSON LogicOperation where | ||
911 | toJSON v = case v of | ||
912 | Clear -> object [ "tag" .= ("Clear" :: Text)] | ||
913 | And -> object [ "tag" .= ("And" :: Text)] | ||
914 | AndReverse -> object [ "tag" .= ("AndReverse" :: Text)] | ||
915 | Copy -> object [ "tag" .= ("Copy" :: Text)] | ||
916 | AndInverted -> object [ "tag" .= ("AndInverted" :: Text)] | ||
917 | Noop -> object [ "tag" .= ("Noop" :: Text)] | ||
918 | Xor -> object [ "tag" .= ("Xor" :: Text)] | ||
919 | Or -> object [ "tag" .= ("Or" :: Text)] | ||
920 | Nor -> object [ "tag" .= ("Nor" :: Text)] | ||
921 | Equiv -> object [ "tag" .= ("Equiv" :: Text)] | ||
922 | Invert -> object [ "tag" .= ("Invert" :: Text)] | ||
923 | OrReverse -> object [ "tag" .= ("OrReverse" :: Text)] | ||
924 | CopyInverted -> object [ "tag" .= ("CopyInverted" :: Text)] | ||
925 | OrInverted -> object [ "tag" .= ("OrInverted" :: Text)] | ||
926 | Nand -> object [ "tag" .= ("Nand" :: Text)] | ||
927 | Set -> object [ "tag" .= ("Set" :: Text)] | ||
928 | |||
929 | instance FromJSON LogicOperation where | ||
930 | parseJSON (Object obj) = do | ||
931 | tag <- obj .: "tag" | ||
932 | case tag :: Text of | ||
933 | "Clear" -> pure Clear | ||
934 | "And" -> pure And | ||
935 | "AndReverse" -> pure AndReverse | ||
936 | "Copy" -> pure Copy | ||
937 | "AndInverted" -> pure AndInverted | ||
938 | "Noop" -> pure Noop | ||
939 | "Xor" -> pure Xor | ||
940 | "Or" -> pure Or | ||
941 | "Nor" -> pure Nor | ||
942 | "Equiv" -> pure Equiv | ||
943 | "Invert" -> pure Invert | ||
944 | "OrReverse" -> pure OrReverse | ||
945 | "CopyInverted" -> pure CopyInverted | ||
946 | "OrInverted" -> pure OrInverted | ||
947 | "Nand" -> pure Nand | ||
948 | "Set" -> pure Set | ||
949 | parseJSON _ = mzero | ||
950 | |||
951 | instance ToJSON StencilOps where | ||
952 | toJSON v = case v of | ||
953 | StencilOps{..} -> object | ||
954 | [ "tag" .= ("StencilOps" :: Text) | ||
955 | , "frontStencilOp" .= frontStencilOp | ||
956 | , "backStencilOp" .= backStencilOp | ||
957 | ] | ||
958 | |||
959 | instance FromJSON StencilOps where | ||
960 | parseJSON (Object obj) = do | ||
961 | tag <- obj .: "tag" | ||
962 | case tag :: Text of | ||
963 | "StencilOps" -> do | ||
964 | frontStencilOp <- obj .: "frontStencilOp" | ||
965 | backStencilOp <- obj .: "backStencilOp" | ||
966 | pure $ StencilOps | ||
967 | { frontStencilOp = frontStencilOp | ||
968 | , backStencilOp = backStencilOp | ||
969 | } | ||
970 | parseJSON _ = mzero | ||
971 | |||
972 | instance ToJSON StencilTest where | ||
973 | toJSON v = case v of | ||
974 | StencilTest{..} -> object | ||
975 | [ "tag" .= ("StencilTest" :: Text) | ||
976 | , "stencilComparision" .= stencilComparision | ||
977 | , "stencilReference" .= stencilReference | ||
978 | , "stencilMask" .= stencilMask | ||
979 | ] | ||
980 | |||
981 | instance FromJSON StencilTest where | ||
982 | parseJSON (Object obj) = do | ||
983 | tag <- obj .: "tag" | ||
984 | case tag :: Text of | ||
985 | "StencilTest" -> do | ||
986 | stencilComparision <- obj .: "stencilComparision" | ||
987 | stencilReference <- obj .: "stencilReference" | ||
988 | stencilMask <- obj .: "stencilMask" | ||
989 | pure $ StencilTest | ||
990 | { stencilComparision = stencilComparision | ||
991 | , stencilReference = stencilReference | ||
992 | , stencilMask = stencilMask | ||
993 | } | ||
994 | parseJSON _ = mzero | ||
995 | |||
996 | instance ToJSON StencilTests where | ||
997 | toJSON v = case v of | ||
998 | StencilTests arg0 arg1 -> object [ "tag" .= ("StencilTests" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
999 | |||
1000 | instance FromJSON StencilTests where | ||
1001 | parseJSON (Object obj) = do | ||
1002 | tag <- obj .: "tag" | ||
1003 | case tag :: Text of | ||
1004 | "StencilTests" -> StencilTests <$> obj .: "arg0" <*> obj .: "arg1" | ||
1005 | parseJSON _ = mzero | ||
1006 | |||
1007 | instance ToJSON FetchPrimitive where | ||
1008 | toJSON v = case v of | ||
1009 | Points -> object [ "tag" .= ("Points" :: Text)] | ||
1010 | Lines -> object [ "tag" .= ("Lines" :: Text)] | ||
1011 | Triangles -> object [ "tag" .= ("Triangles" :: Text)] | ||
1012 | LinesAdjacency -> object [ "tag" .= ("LinesAdjacency" :: Text)] | ||
1013 | TrianglesAdjacency -> object [ "tag" .= ("TrianglesAdjacency" :: Text)] | ||
1014 | |||
1015 | instance FromJSON FetchPrimitive where | ||
1016 | parseJSON (Object obj) = do | ||
1017 | tag <- obj .: "tag" | ||
1018 | case tag :: Text of | ||
1019 | "Points" -> pure Points | ||
1020 | "Lines" -> pure Lines | ||
1021 | "Triangles" -> pure Triangles | ||
1022 | "LinesAdjacency" -> pure LinesAdjacency | ||
1023 | "TrianglesAdjacency" -> pure TrianglesAdjacency | ||
1024 | parseJSON _ = mzero | ||
1025 | |||
1026 | instance ToJSON OutputPrimitive where | ||
1027 | toJSON v = case v of | ||
1028 | TrianglesOutput -> object [ "tag" .= ("TrianglesOutput" :: Text)] | ||
1029 | LinesOutput -> object [ "tag" .= ("LinesOutput" :: Text)] | ||
1030 | PointsOutput -> object [ "tag" .= ("PointsOutput" :: Text)] | ||
1031 | |||
1032 | instance FromJSON OutputPrimitive where | ||
1033 | parseJSON (Object obj) = do | ||
1034 | tag <- obj .: "tag" | ||
1035 | case tag :: Text of | ||
1036 | "TrianglesOutput" -> pure TrianglesOutput | ||
1037 | "LinesOutput" -> pure LinesOutput | ||
1038 | "PointsOutput" -> pure PointsOutput | ||
1039 | parseJSON _ = mzero | ||
1040 | |||
1041 | instance ToJSON ColorArity where | ||
1042 | toJSON v = case v of | ||
1043 | Red -> object [ "tag" .= ("Red" :: Text)] | ||
1044 | RG -> object [ "tag" .= ("RG" :: Text)] | ||
1045 | RGB -> object [ "tag" .= ("RGB" :: Text)] | ||
1046 | RGBA -> object [ "tag" .= ("RGBA" :: Text)] | ||
1047 | |||
1048 | instance FromJSON ColorArity where | ||
1049 | parseJSON (Object obj) = do | ||
1050 | tag <- obj .: "tag" | ||
1051 | case tag :: Text of | ||
1052 | "Red" -> pure Red | ||
1053 | "RG" -> pure RG | ||
1054 | "RGB" -> pure RGB | ||
1055 | "RGBA" -> pure RGBA | ||
1056 | parseJSON _ = mzero | ||
1057 | |||
1058 | instance ToJSON Blending where | ||
1059 | toJSON v = case v of | ||
1060 | NoBlending -> object [ "tag" .= ("NoBlending" :: Text)] | ||
1061 | BlendLogicOp arg0 -> object [ "tag" .= ("BlendLogicOp" :: Text), "arg0" .= arg0] | ||
1062 | Blend{..} -> object | ||
1063 | [ "tag" .= ("Blend" :: Text) | ||
1064 | , "colorEqSrc" .= colorEqSrc | ||
1065 | , "alphaEqSrc" .= alphaEqSrc | ||
1066 | , "colorFSrc" .= colorFSrc | ||
1067 | , "colorFDst" .= colorFDst | ||
1068 | , "alphaFSrc" .= alphaFSrc | ||
1069 | , "alphaFDst" .= alphaFDst | ||
1070 | , "color" .= color | ||
1071 | ] | ||
1072 | |||
1073 | instance FromJSON Blending where | ||
1074 | parseJSON (Object obj) = do | ||
1075 | tag <- obj .: "tag" | ||
1076 | case tag :: Text of | ||
1077 | "NoBlending" -> pure NoBlending | ||
1078 | "BlendLogicOp" -> BlendLogicOp <$> obj .: "arg0" | ||
1079 | "Blend" -> do | ||
1080 | colorEqSrc <- obj .: "colorEqSrc" | ||
1081 | alphaEqSrc <- obj .: "alphaEqSrc" | ||
1082 | colorFSrc <- obj .: "colorFSrc" | ||
1083 | colorFDst <- obj .: "colorFDst" | ||
1084 | alphaFSrc <- obj .: "alphaFSrc" | ||
1085 | alphaFDst <- obj .: "alphaFDst" | ||
1086 | color <- obj .: "color" | ||
1087 | pure $ Blend | ||
1088 | { colorEqSrc = colorEqSrc | ||
1089 | , alphaEqSrc = alphaEqSrc | ||
1090 | , colorFSrc = colorFSrc | ||
1091 | , colorFDst = colorFDst | ||
1092 | , alphaFSrc = alphaFSrc | ||
1093 | , alphaFDst = alphaFDst | ||
1094 | , color = color | ||
1095 | } | ||
1096 | parseJSON _ = mzero | ||
1097 | |||
1098 | instance ToJSON RasterContext where | ||
1099 | toJSON v = case v of | ||
1100 | PointCtx arg0 arg1 arg2 -> object [ "tag" .= ("PointCtx" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2] | ||
1101 | LineCtx arg0 arg1 -> object [ "tag" .= ("LineCtx" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1102 | TriangleCtx arg0 arg1 arg2 arg3 -> object [ "tag" .= ("TriangleCtx" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2, "arg3" .= arg3] | ||
1103 | |||
1104 | instance FromJSON RasterContext where | ||
1105 | parseJSON (Object obj) = do | ||
1106 | tag <- obj .: "tag" | ||
1107 | case tag :: Text of | ||
1108 | "PointCtx" -> PointCtx <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" | ||
1109 | "LineCtx" -> LineCtx <$> obj .: "arg0" <*> obj .: "arg1" | ||
1110 | "TriangleCtx" -> TriangleCtx <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" <*> obj .: "arg3" | ||
1111 | parseJSON _ = mzero | ||
1112 | |||
1113 | instance ToJSON FragmentOperation where | ||
1114 | toJSON v = case v of | ||
1115 | DepthOp arg0 arg1 -> object [ "tag" .= ("DepthOp" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1116 | StencilOp arg0 arg1 arg2 -> object [ "tag" .= ("StencilOp" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2] | ||
1117 | ColorOp arg0 arg1 -> object [ "tag" .= ("ColorOp" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1118 | |||
1119 | instance FromJSON FragmentOperation where | ||
1120 | parseJSON (Object obj) = do | ||
1121 | tag <- obj .: "tag" | ||
1122 | case tag :: Text of | ||
1123 | "DepthOp" -> DepthOp <$> obj .: "arg0" <*> obj .: "arg1" | ||
1124 | "StencilOp" -> StencilOp <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" | ||
1125 | "ColorOp" -> ColorOp <$> obj .: "arg0" <*> obj .: "arg1" | ||
1126 | parseJSON _ = mzero | ||
1127 | |||
1128 | instance ToJSON AccumulationContext where | ||
1129 | toJSON v = case v of | ||
1130 | AccumulationContext{..} -> object | ||
1131 | [ "tag" .= ("AccumulationContext" :: Text) | ||
1132 | , "accViewportName" .= accViewportName | ||
1133 | , "accOperations" .= accOperations | ||
1134 | ] | ||
1135 | |||
1136 | instance FromJSON AccumulationContext where | ||
1137 | parseJSON (Object obj) = do | ||
1138 | tag <- obj .: "tag" | ||
1139 | case tag :: Text of | ||
1140 | "AccumulationContext" -> do | ||
1141 | accViewportName <- obj .: "accViewportName" | ||
1142 | accOperations <- obj .: "accOperations" | ||
1143 | pure $ AccumulationContext | ||
1144 | { accViewportName = accViewportName | ||
1145 | , accOperations = accOperations | ||
1146 | } | ||
1147 | parseJSON _ = mzero | ||
1148 | |||
1149 | instance ToJSON TextureDataType where | ||
1150 | toJSON v = case v of | ||
1151 | FloatT arg0 -> object [ "tag" .= ("FloatT" :: Text), "arg0" .= arg0] | ||
1152 | IntT arg0 -> object [ "tag" .= ("IntT" :: Text), "arg0" .= arg0] | ||
1153 | WordT arg0 -> object [ "tag" .= ("WordT" :: Text), "arg0" .= arg0] | ||
1154 | ShadowT -> object [ "tag" .= ("ShadowT" :: Text)] | ||
1155 | |||
1156 | instance FromJSON TextureDataType where | ||
1157 | parseJSON (Object obj) = do | ||
1158 | tag <- obj .: "tag" | ||
1159 | case tag :: Text of | ||
1160 | "FloatT" -> FloatT <$> obj .: "arg0" | ||
1161 | "IntT" -> IntT <$> obj .: "arg0" | ||
1162 | "WordT" -> WordT <$> obj .: "arg0" | ||
1163 | "ShadowT" -> pure ShadowT | ||
1164 | parseJSON _ = mzero | ||
1165 | |||
1166 | instance ToJSON TextureType where | ||
1167 | toJSON v = case v of | ||
1168 | Texture1D arg0 arg1 -> object [ "tag" .= ("Texture1D" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1169 | Texture2D arg0 arg1 -> object [ "tag" .= ("Texture2D" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1170 | Texture3D arg0 -> object [ "tag" .= ("Texture3D" :: Text), "arg0" .= arg0] | ||
1171 | TextureCube arg0 -> object [ "tag" .= ("TextureCube" :: Text), "arg0" .= arg0] | ||
1172 | TextureRect arg0 -> object [ "tag" .= ("TextureRect" :: Text), "arg0" .= arg0] | ||
1173 | Texture2DMS arg0 arg1 arg2 arg3 -> object [ "tag" .= ("Texture2DMS" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2, "arg3" .= arg3] | ||
1174 | TextureBuffer arg0 -> object [ "tag" .= ("TextureBuffer" :: Text), "arg0" .= arg0] | ||
1175 | |||
1176 | instance FromJSON TextureType where | ||
1177 | parseJSON (Object obj) = do | ||
1178 | tag <- obj .: "tag" | ||
1179 | case tag :: Text of | ||
1180 | "Texture1D" -> Texture1D <$> obj .: "arg0" <*> obj .: "arg1" | ||
1181 | "Texture2D" -> Texture2D <$> obj .: "arg0" <*> obj .: "arg1" | ||
1182 | "Texture3D" -> Texture3D <$> obj .: "arg0" | ||
1183 | "TextureCube" -> TextureCube <$> obj .: "arg0" | ||
1184 | "TextureRect" -> TextureRect <$> obj .: "arg0" | ||
1185 | "Texture2DMS" -> Texture2DMS <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" <*> obj .: "arg3" | ||
1186 | "TextureBuffer" -> TextureBuffer <$> obj .: "arg0" | ||
1187 | parseJSON _ = mzero | ||
1188 | |||
1189 | instance ToJSON MipMap where | ||
1190 | toJSON v = case v of | ||
1191 | Mip arg0 arg1 -> object [ "tag" .= ("Mip" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1192 | NoMip -> object [ "tag" .= ("NoMip" :: Text)] | ||
1193 | AutoMip arg0 arg1 -> object [ "tag" .= ("AutoMip" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1194 | |||
1195 | instance FromJSON MipMap where | ||
1196 | parseJSON (Object obj) = do | ||
1197 | tag <- obj .: "tag" | ||
1198 | case tag :: Text of | ||
1199 | "Mip" -> Mip <$> obj .: "arg0" <*> obj .: "arg1" | ||
1200 | "NoMip" -> pure NoMip | ||
1201 | "AutoMip" -> AutoMip <$> obj .: "arg0" <*> obj .: "arg1" | ||
1202 | parseJSON _ = mzero | ||
1203 | |||
1204 | instance ToJSON Filter where | ||
1205 | toJSON v = case v of | ||
1206 | Nearest -> object [ "tag" .= ("Nearest" :: Text)] | ||
1207 | Linear -> object [ "tag" .= ("Linear" :: Text)] | ||
1208 | NearestMipmapNearest -> object [ "tag" .= ("NearestMipmapNearest" :: Text)] | ||
1209 | NearestMipmapLinear -> object [ "tag" .= ("NearestMipmapLinear" :: Text)] | ||
1210 | LinearMipmapNearest -> object [ "tag" .= ("LinearMipmapNearest" :: Text)] | ||
1211 | LinearMipmapLinear -> object [ "tag" .= ("LinearMipmapLinear" :: Text)] | ||
1212 | |||
1213 | instance FromJSON Filter where | ||
1214 | parseJSON (Object obj) = do | ||
1215 | tag <- obj .: "tag" | ||
1216 | case tag :: Text of | ||
1217 | "Nearest" -> pure Nearest | ||
1218 | "Linear" -> pure Linear | ||
1219 | "NearestMipmapNearest" -> pure NearestMipmapNearest | ||
1220 | "NearestMipmapLinear" -> pure NearestMipmapLinear | ||
1221 | "LinearMipmapNearest" -> pure LinearMipmapNearest | ||
1222 | "LinearMipmapLinear" -> pure LinearMipmapLinear | ||
1223 | parseJSON _ = mzero | ||
1224 | |||
1225 | instance ToJSON EdgeMode where | ||
1226 | toJSON v = case v of | ||
1227 | Repeat -> object [ "tag" .= ("Repeat" :: Text)] | ||
1228 | MirroredRepeat -> object [ "tag" .= ("MirroredRepeat" :: Text)] | ||
1229 | ClampToEdge -> object [ "tag" .= ("ClampToEdge" :: Text)] | ||
1230 | ClampToBorder -> object [ "tag" .= ("ClampToBorder" :: Text)] | ||
1231 | |||
1232 | instance FromJSON EdgeMode where | ||
1233 | parseJSON (Object obj) = do | ||
1234 | tag <- obj .: "tag" | ||
1235 | case tag :: Text of | ||
1236 | "Repeat" -> pure Repeat | ||
1237 | "MirroredRepeat" -> pure MirroredRepeat | ||
1238 | "ClampToEdge" -> pure ClampToEdge | ||
1239 | "ClampToBorder" -> pure ClampToBorder | ||
1240 | parseJSON _ = mzero | ||
1241 | |||
1242 | instance ToJSON ImageSemantic where | ||
1243 | toJSON v = case v of | ||
1244 | Depth -> object [ "tag" .= ("Depth" :: Text)] | ||
1245 | Stencil -> object [ "tag" .= ("Stencil" :: Text)] | ||
1246 | Color -> object [ "tag" .= ("Color" :: Text)] | ||
1247 | |||
1248 | instance FromJSON ImageSemantic where | ||
1249 | parseJSON (Object obj) = do | ||
1250 | tag <- obj .: "tag" | ||
1251 | case tag :: Text of | ||
1252 | "Depth" -> pure Depth | ||
1253 | "Stencil" -> pure Stencil | ||
1254 | "Color" -> pure Color | ||
1255 | parseJSON _ = mzero | ||
1256 | |||
1257 | instance ToJSON ImageRef where | ||
1258 | toJSON v = case v of | ||
1259 | TextureImage arg0 arg1 arg2 -> object [ "tag" .= ("TextureImage" :: Text), "arg0" .= arg0, "arg1" .= arg1, "arg2" .= arg2] | ||
1260 | Framebuffer arg0 -> object [ "tag" .= ("Framebuffer" :: Text), "arg0" .= arg0] | ||
1261 | |||
1262 | instance FromJSON ImageRef where | ||
1263 | parseJSON (Object obj) = do | ||
1264 | tag <- obj .: "tag" | ||
1265 | case tag :: Text of | ||
1266 | "TextureImage" -> TextureImage <$> obj .: "arg0" <*> obj .: "arg1" <*> obj .: "arg2" | ||
1267 | "Framebuffer" -> Framebuffer <$> obj .: "arg0" | ||
1268 | parseJSON _ = mzero | ||
1269 | |||
1270 | instance ToJSON ClearImage where | ||
1271 | toJSON v = case v of | ||
1272 | ClearImage{..} -> object | ||
1273 | [ "tag" .= ("ClearImage" :: Text) | ||
1274 | , "imageSemantic" .= imageSemantic | ||
1275 | , "clearValue" .= clearValue | ||
1276 | ] | ||
1277 | |||
1278 | instance FromJSON ClearImage where | ||
1279 | parseJSON (Object obj) = do | ||
1280 | tag <- obj .: "tag" | ||
1281 | case tag :: Text of | ||
1282 | "ClearImage" -> do | ||
1283 | imageSemantic <- obj .: "imageSemantic" | ||
1284 | clearValue <- obj .: "clearValue" | ||
1285 | pure $ ClearImage | ||
1286 | { imageSemantic = imageSemantic | ||
1287 | , clearValue = clearValue | ||
1288 | } | ||
1289 | parseJSON _ = mzero | ||
1290 | |||
1291 | instance ToJSON Command where | ||
1292 | toJSON v = case v of | ||
1293 | SetRasterContext arg0 -> object [ "tag" .= ("SetRasterContext" :: Text), "arg0" .= arg0] | ||
1294 | SetAccumulationContext arg0 -> object [ "tag" .= ("SetAccumulationContext" :: Text), "arg0" .= arg0] | ||
1295 | SetRenderTarget arg0 -> object [ "tag" .= ("SetRenderTarget" :: Text), "arg0" .= arg0] | ||
1296 | SetProgram arg0 -> object [ "tag" .= ("SetProgram" :: Text), "arg0" .= arg0] | ||
1297 | SetSamplerUniform arg0 arg1 -> object [ "tag" .= ("SetSamplerUniform" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1298 | SetTexture arg0 arg1 -> object [ "tag" .= ("SetTexture" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1299 | SetSampler arg0 arg1 -> object [ "tag" .= ("SetSampler" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1300 | RenderSlot arg0 -> object [ "tag" .= ("RenderSlot" :: Text), "arg0" .= arg0] | ||
1301 | RenderStream arg0 -> object [ "tag" .= ("RenderStream" :: Text), "arg0" .= arg0] | ||
1302 | ClearRenderTarget arg0 -> object [ "tag" .= ("ClearRenderTarget" :: Text), "arg0" .= arg0] | ||
1303 | GenerateMipMap arg0 -> object [ "tag" .= ("GenerateMipMap" :: Text), "arg0" .= arg0] | ||
1304 | SaveImage arg0 arg1 -> object [ "tag" .= ("SaveImage" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1305 | LoadImage arg0 arg1 -> object [ "tag" .= ("LoadImage" :: Text), "arg0" .= arg0, "arg1" .= arg1] | ||
1306 | |||
1307 | instance FromJSON Command where | ||
1308 | parseJSON (Object obj) = do | ||
1309 | tag <- obj .: "tag" | ||
1310 | case tag :: Text of | ||
1311 | "SetRasterContext" -> SetRasterContext <$> obj .: "arg0" | ||
1312 | "SetAccumulationContext" -> SetAccumulationContext <$> obj .: "arg0" | ||
1313 | "SetRenderTarget" -> SetRenderTarget <$> obj .: "arg0" | ||
1314 | "SetProgram" -> SetProgram <$> obj .: "arg0" | ||
1315 | "SetSamplerUniform" -> SetSamplerUniform <$> obj .: "arg0" <*> obj .: "arg1" | ||
1316 | "SetTexture" -> SetTexture <$> obj .: "arg0" <*> obj .: "arg1" | ||
1317 | "SetSampler" -> SetSampler <$> obj .: "arg0" <*> obj .: "arg1" | ||
1318 | "RenderSlot" -> RenderSlot <$> obj .: "arg0" | ||
1319 | "RenderStream" -> RenderStream <$> obj .: "arg0" | ||
1320 | "ClearRenderTarget" -> ClearRenderTarget <$> obj .: "arg0" | ||
1321 | "GenerateMipMap" -> GenerateMipMap <$> obj .: "arg0" | ||
1322 | "SaveImage" -> SaveImage <$> obj .: "arg0" <*> obj .: "arg1" | ||
1323 | "LoadImage" -> LoadImage <$> obj .: "arg0" <*> obj .: "arg1" | ||
1324 | parseJSON _ = mzero | ||
1325 | |||
1326 | instance ToJSON SamplerDescriptor where | ||
1327 | toJSON v = case v of | ||
1328 | SamplerDescriptor{..} -> object | ||
1329 | [ "tag" .= ("SamplerDescriptor" :: Text) | ||
1330 | , "samplerWrapS" .= samplerWrapS | ||
1331 | , "samplerWrapT" .= samplerWrapT | ||
1332 | , "samplerWrapR" .= samplerWrapR | ||
1333 | , "samplerMinFilter" .= samplerMinFilter | ||
1334 | , "samplerMagFilter" .= samplerMagFilter | ||
1335 | , "samplerBorderColor" .= samplerBorderColor | ||
1336 | , "samplerMinLod" .= samplerMinLod | ||
1337 | , "samplerMaxLod" .= samplerMaxLod | ||
1338 | , "samplerLodBias" .= samplerLodBias | ||
1339 | , "samplerCompareFunc" .= samplerCompareFunc | ||
1340 | ] | ||
1341 | |||
1342 | instance FromJSON SamplerDescriptor where | ||
1343 | parseJSON (Object obj) = do | ||
1344 | tag <- obj .: "tag" | ||
1345 | case tag :: Text of | ||
1346 | "SamplerDescriptor" -> do | ||
1347 | samplerWrapS <- obj .: "samplerWrapS" | ||
1348 | samplerWrapT <- obj .: "samplerWrapT" | ||
1349 | samplerWrapR <- obj .: "samplerWrapR" | ||
1350 | samplerMinFilter <- obj .: "samplerMinFilter" | ||
1351 | samplerMagFilter <- obj .: "samplerMagFilter" | ||
1352 | samplerBorderColor <- obj .: "samplerBorderColor" | ||
1353 | samplerMinLod <- obj .: "samplerMinLod" | ||
1354 | samplerMaxLod <- obj .: "samplerMaxLod" | ||
1355 | samplerLodBias <- obj .: "samplerLodBias" | ||
1356 | samplerCompareFunc <- obj .: "samplerCompareFunc" | ||
1357 | pure $ SamplerDescriptor | ||
1358 | { samplerWrapS = samplerWrapS | ||
1359 | , samplerWrapT = samplerWrapT | ||
1360 | , samplerWrapR = samplerWrapR | ||
1361 | , samplerMinFilter = samplerMinFilter | ||
1362 | , samplerMagFilter = samplerMagFilter | ||
1363 | , samplerBorderColor = samplerBorderColor | ||
1364 | , samplerMinLod = samplerMinLod | ||
1365 | , samplerMaxLod = samplerMaxLod | ||
1366 | , samplerLodBias = samplerLodBias | ||
1367 | , samplerCompareFunc = samplerCompareFunc | ||
1368 | } | ||
1369 | parseJSON _ = mzero | ||
1370 | |||
1371 | instance ToJSON TextureDescriptor where | ||
1372 | toJSON v = case v of | ||
1373 | TextureDescriptor{..} -> object | ||
1374 | [ "tag" .= ("TextureDescriptor" :: Text) | ||
1375 | , "textureType" .= textureType | ||
1376 | , "textureSize" .= textureSize | ||
1377 | , "textureSemantic" .= textureSemantic | ||
1378 | , "textureSampler" .= textureSampler | ||
1379 | , "textureBaseLevel" .= textureBaseLevel | ||
1380 | , "textureMaxLevel" .= textureMaxLevel | ||
1381 | ] | ||
1382 | |||
1383 | instance FromJSON TextureDescriptor where | ||
1384 | parseJSON (Object obj) = do | ||
1385 | tag <- obj .: "tag" | ||
1386 | case tag :: Text of | ||
1387 | "TextureDescriptor" -> do | ||
1388 | textureType <- obj .: "textureType" | ||
1389 | textureSize <- obj .: "textureSize" | ||
1390 | textureSemantic <- obj .: "textureSemantic" | ||
1391 | textureSampler <- obj .: "textureSampler" | ||
1392 | textureBaseLevel <- obj .: "textureBaseLevel" | ||
1393 | textureMaxLevel <- obj .: "textureMaxLevel" | ||
1394 | pure $ TextureDescriptor | ||
1395 | { textureType = textureType | ||
1396 | , textureSize = textureSize | ||
1397 | , textureSemantic = textureSemantic | ||
1398 | , textureSampler = textureSampler | ||
1399 | , textureBaseLevel = textureBaseLevel | ||
1400 | , textureMaxLevel = textureMaxLevel | ||
1401 | } | ||
1402 | parseJSON _ = mzero | ||
1403 | |||
1404 | instance ToJSON Parameter where | ||
1405 | toJSON v = case v of | ||
1406 | Parameter{..} -> object | ||
1407 | [ "tag" .= ("Parameter" :: Text) | ||
1408 | , "name" .= name | ||
1409 | , "ty" .= ty | ||
1410 | ] | ||
1411 | |||
1412 | instance FromJSON Parameter where | ||
1413 | parseJSON (Object obj) = do | ||
1414 | tag <- obj .: "tag" | ||
1415 | case tag :: Text of | ||
1416 | "Parameter" -> do | ||
1417 | name <- obj .: "name" | ||
1418 | ty <- obj .: "ty" | ||
1419 | pure $ Parameter | ||
1420 | { name = name | ||
1421 | , ty = ty | ||
1422 | } | ||
1423 | parseJSON _ = mzero | ||
1424 | |||
1425 | instance ToJSON Program where | ||
1426 | toJSON v = case v of | ||
1427 | Program{..} -> object | ||
1428 | [ "tag" .= ("Program" :: Text) | ||
1429 | , "programUniforms" .= programUniforms | ||
1430 | , "programStreams" .= programStreams | ||
1431 | , "programInTextures" .= programInTextures | ||
1432 | , "programOutput" .= programOutput | ||
1433 | , "vertexShader" .= vertexShader | ||
1434 | , "geometryShader" .= geometryShader | ||
1435 | , "fragmentShader" .= fragmentShader | ||
1436 | ] | ||
1437 | |||
1438 | instance FromJSON Program where | ||
1439 | parseJSON (Object obj) = do | ||
1440 | tag <- obj .: "tag" | ||
1441 | case tag :: Text of | ||
1442 | "Program" -> do | ||
1443 | programUniforms <- obj .: "programUniforms" | ||
1444 | programStreams <- obj .: "programStreams" | ||
1445 | programInTextures <- obj .: "programInTextures" | ||
1446 | programOutput <- obj .: "programOutput" | ||
1447 | vertexShader <- obj .: "vertexShader" | ||
1448 | geometryShader <- obj .: "geometryShader" | ||
1449 | fragmentShader <- obj .: "fragmentShader" | ||
1450 | pure $ Program | ||
1451 | { programUniforms = programUniforms | ||
1452 | , programStreams = programStreams | ||
1453 | , programInTextures = programInTextures | ||
1454 | , programOutput = programOutput | ||
1455 | , vertexShader = vertexShader | ||
1456 | , geometryShader = geometryShader | ||
1457 | , fragmentShader = fragmentShader | ||
1458 | } | ||
1459 | parseJSON _ = mzero | ||
1460 | |||
1461 | instance ToJSON Slot where | ||
1462 | toJSON v = case v of | ||
1463 | Slot{..} -> object | ||
1464 | [ "tag" .= ("Slot" :: Text) | ||
1465 | , "slotName" .= slotName | ||
1466 | , "slotStreams" .= slotStreams | ||
1467 | , "slotUniforms" .= slotUniforms | ||
1468 | , "slotPrimitive" .= slotPrimitive | ||
1469 | , "slotPrograms" .= slotPrograms | ||
1470 | ] | ||
1471 | |||
1472 | instance FromJSON Slot where | ||
1473 | parseJSON (Object obj) = do | ||
1474 | tag <- obj .: "tag" | ||
1475 | case tag :: Text of | ||
1476 | "Slot" -> do | ||
1477 | slotName <- obj .: "slotName" | ||
1478 | slotStreams <- obj .: "slotStreams" | ||
1479 | slotUniforms <- obj .: "slotUniforms" | ||
1480 | slotPrimitive <- obj .: "slotPrimitive" | ||
1481 | slotPrograms <- obj .: "slotPrograms" | ||
1482 | pure $ Slot | ||
1483 | { slotName = slotName | ||
1484 | , slotStreams = slotStreams | ||
1485 | , slotUniforms = slotUniforms | ||
1486 | , slotPrimitive = slotPrimitive | ||
1487 | , slotPrograms = slotPrograms | ||
1488 | } | ||
1489 | parseJSON _ = mzero | ||
1490 | |||
1491 | instance ToJSON StreamData where | ||
1492 | toJSON v = case v of | ||
1493 | StreamData{..} -> object | ||
1494 | [ "tag" .= ("StreamData" :: Text) | ||
1495 | , "streamData" .= streamData | ||
1496 | , "streamType" .= streamType | ||
1497 | , "streamPrimitive" .= streamPrimitive | ||
1498 | , "streamPrograms" .= streamPrograms | ||
1499 | ] | ||
1500 | |||
1501 | instance FromJSON StreamData where | ||
1502 | parseJSON (Object obj) = do | ||
1503 | tag <- obj .: "tag" | ||
1504 | case tag :: Text of | ||
1505 | "StreamData" -> do | ||
1506 | streamData <- obj .: "streamData" | ||
1507 | streamType <- obj .: "streamType" | ||
1508 | streamPrimitive <- obj .: "streamPrimitive" | ||
1509 | streamPrograms <- obj .: "streamPrograms" | ||
1510 | pure $ StreamData | ||
1511 | { streamData = streamData | ||
1512 | , streamType = streamType | ||
1513 | , streamPrimitive = streamPrimitive | ||
1514 | , streamPrograms = streamPrograms | ||
1515 | } | ||
1516 | parseJSON _ = mzero | ||
1517 | |||
1518 | instance ToJSON TargetItem where | ||
1519 | toJSON v = case v of | ||
1520 | TargetItem{..} -> object | ||
1521 | [ "tag" .= ("TargetItem" :: Text) | ||
1522 | , "targetSemantic" .= targetSemantic | ||
1523 | , "targetRef" .= targetRef | ||
1524 | ] | ||
1525 | |||
1526 | instance FromJSON TargetItem where | ||
1527 | parseJSON (Object obj) = do | ||
1528 | tag <- obj .: "tag" | ||
1529 | case tag :: Text of | ||
1530 | "TargetItem" -> do | ||
1531 | targetSemantic <- obj .: "targetSemantic" | ||
1532 | targetRef <- obj .: "targetRef" | ||
1533 | pure $ TargetItem | ||
1534 | { targetSemantic = targetSemantic | ||
1535 | , targetRef = targetRef | ||
1536 | } | ||
1537 | parseJSON _ = mzero | ||
1538 | |||
1539 | instance ToJSON RenderTarget where | ||
1540 | toJSON v = case v of | ||
1541 | RenderTarget{..} -> object | ||
1542 | [ "tag" .= ("RenderTarget" :: Text) | ||
1543 | , "renderTargets" .= renderTargets | ||
1544 | ] | ||
1545 | |||
1546 | instance FromJSON RenderTarget where | ||
1547 | parseJSON (Object obj) = do | ||
1548 | tag <- obj .: "tag" | ||
1549 | case tag :: Text of | ||
1550 | "RenderTarget" -> do | ||
1551 | renderTargets <- obj .: "renderTargets" | ||
1552 | pure $ RenderTarget | ||
1553 | { renderTargets = renderTargets | ||
1554 | } | ||
1555 | parseJSON _ = mzero | ||
1556 | |||
1557 | instance ToJSON Backend where | ||
1558 | toJSON v = case v of | ||
1559 | WebGL1 -> object [ "tag" .= ("WebGL1" :: Text)] | ||
1560 | OpenGL33 -> object [ "tag" .= ("OpenGL33" :: Text)] | ||
1561 | |||
1562 | instance FromJSON Backend where | ||
1563 | parseJSON (Object obj) = do | ||
1564 | tag <- obj .: "tag" | ||
1565 | case tag :: Text of | ||
1566 | "WebGL1" -> pure WebGL1 | ||
1567 | "OpenGL33" -> pure OpenGL33 | ||
1568 | parseJSON _ = mzero | ||
1569 | |||
1570 | instance ToJSON Pipeline where | ||
1571 | toJSON v = case v of | ||
1572 | Pipeline{..} -> object | ||
1573 | [ "tag" .= ("Pipeline" :: Text) | ||
1574 | , "backend" .= backend | ||
1575 | , "textures" .= textures | ||
1576 | , "samplers" .= samplers | ||
1577 | , "targets" .= targets | ||
1578 | , "programs" .= programs | ||
1579 | , "slots" .= slots | ||
1580 | , "streams" .= streams | ||
1581 | , "commands" .= commands | ||
1582 | ] | ||
1583 | |||
1584 | instance FromJSON Pipeline where | ||
1585 | parseJSON (Object obj) = do | ||
1586 | tag <- obj .: "tag" | ||
1587 | case tag :: Text of | ||
1588 | "Pipeline" -> do | ||
1589 | backend <- obj .: "backend" | ||
1590 | textures <- obj .: "textures" | ||
1591 | samplers <- obj .: "samplers" | ||
1592 | targets <- obj .: "targets" | ||
1593 | programs <- obj .: "programs" | ||
1594 | slots <- obj .: "slots" | ||
1595 | streams <- obj .: "streams" | ||
1596 | commands <- obj .: "commands" | ||
1597 | pure $ Pipeline | ||
1598 | { backend = backend | ||
1599 | , textures = textures | ||
1600 | , samplers = samplers | ||
1601 | , targets = targets | ||
1602 | , programs = programs | ||
1603 | , slots = slots | ||
1604 | , streams = streams | ||
1605 | , commands = commands | ||
1606 | } | ||
1607 | parseJSON _ = mzero | ||
1608 | |||
diff --git a/src/Linear.hs b/src/Linear.hs deleted file mode 100644 index 13298411..00000000 --- a/src/Linear.hs +++ /dev/null | |||
@@ -1,60 +0,0 @@ | |||
1 | {-# LANGUAGE DeriveFunctor, OverloadedStrings #-} | ||
2 | module Linear where | ||
3 | |||
4 | import Data.Int | ||
5 | import Data.Word | ||
6 | import Data.Map | ||
7 | |||
8 | import Data.Text | ||
9 | import Data.Aeson | ||
10 | import Control.Monad | ||
11 | |||
12 | data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Functor) | ||
13 | data V3 a = V3 !a !a !a deriving (Eq,Ord,Show,Read,Functor) | ||
14 | data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show,Read,Functor) | ||
15 | |||
16 | -- matrices are stored in column major order | ||
17 | type M22F = V2 V2F | ||
18 | type M23F = V3 V2F | ||
19 | type M24F = V4 V2F | ||
20 | type M32F = V2 V3F | ||
21 | type M33F = V3 V3F | ||
22 | type M34F = V4 V3F | ||
23 | type M42F = V2 V4F | ||
24 | type M43F = V3 V4F | ||
25 | type M44F = V4 V4F | ||
26 | |||
27 | type V2F = V2 Float | ||
28 | type V3F = V3 Float | ||
29 | type V4F = V4 Float | ||
30 | type V2I = V2 Int32 | ||
31 | type V3I = V3 Int32 | ||
32 | type V4I = V4 Int32 | ||
33 | type V2U = V2 Word32 | ||
34 | type V3U = V3 Word32 | ||
35 | type V4U = V4 Word32 | ||
36 | type V2B = V2 Bool | ||
37 | type V3B = V3 Bool | ||
38 | type V4B = V4 Bool | ||
39 | |||
40 | instance ToJSON a => ToJSON (V2 a) where | ||
41 | toJSON (V2 x y) = object ["x" .= x, "y" .= y] | ||
42 | |||
43 | instance ToJSON a => ToJSON (V3 a) where | ||
44 | toJSON (V3 x y z) = object ["x" .= x, "y" .= y, "z" .= z] | ||
45 | |||
46 | instance ToJSON a => ToJSON (V4 a) where | ||
47 | toJSON (V4 x y z w) = object ["x" .= x, "y" .= y, "z" .= z, "w" .= w] | ||
48 | |||
49 | instance FromJSON a => FromJSON (V2 a) where | ||
50 | parseJSON (Object obj) = V2 <$> obj .: "x" <*> obj .: "y" | ||
51 | parseJSON _ = mzero | ||
52 | |||
53 | instance FromJSON a => FromJSON (V3 a) where | ||
54 | parseJSON (Object obj) = V3 <$> obj .: "x" <*> obj .: "y" <*> obj .: "z" | ||
55 | parseJSON _ = mzero | ||
56 | |||
57 | instance FromJSON a => FromJSON (V4 a) where | ||
58 | parseJSON (Object obj) = V4 <$> obj .: "x" <*> obj .: "y" <*> obj .: "z" <*> obj .: "w" | ||
59 | parseJSON _ = mzero | ||
60 | |||