summaryrefslogtreecommitdiff
path: root/ddl/out/LambdaCube.Mesh.hs
blob: 27b0462d0e27b839a072cdce4fd7885563287e0c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
-- generated file, do not modify!
<<<<<<< d022971b99be214c71429d58f97f85b13e33a426
<<<<<<< 4d40c4ee5ed15544d2ac7fb1ea7b61e89766d277
<<<<<<< c5e063b3c9aeff65161e24445e9672daff980b45
<<<<<<< 3b50722f433ec5ecc515ea1441fd633d85118cb9
-- 2016-03-01T13:00:40.781208000000Z
=======
-- 2016-03-20T21:42:12.936741000000Z
>>>>>>> working c# backend
=======
-- 2016-03-20T22:19:43.568791000000Z
>>>>>>> fix c#
=======
-- 2016-03-21T11:36:01.121658000000Z
>>>>>>> work on java json loader
=======
-- 2016-03-21T11:41:52.391032000000Z
>>>>>>> improve java json

{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module LambdaCube.Mesh where

import Data.Int
import Data.Word
import Data.Map
import Data.Vector (Vector(..))
import LambdaCube.Linear

import Data.Text
import Data.Aeson hiding (Value,Bool)
import Data.Aeson.Types hiding (Value,Bool)
import Control.Monad


data MeshAttribute
  = A_Float (Vector Float)
  | A_V2F (Vector V2F)
  | A_V3F (Vector V3F)
  | A_V4F (Vector V4F)
  | A_M22F (Vector M22F)
  | A_M33F (Vector M33F)
  | A_M44F (Vector M44F)
  | A_Int (Vector Int32)
  | A_Word (Vector Word32)
  deriving (Show, Eq, Ord)

data MeshPrimitive
  = P_Points
  | P_TriangleStrip
  | P_Triangles
  | P_TriangleStripI (Vector Int32)
  | P_TrianglesI (Vector Int32)
  deriving (Show, Eq, Ord)

data Mesh
  = Mesh
  { mAttributes :: Map String MeshAttribute
  , mPrimitive :: MeshPrimitive
  }

  deriving (Show, Eq, Ord)


instance ToJSON MeshAttribute where
  toJSON v = case v of
    A_Float arg0 -> object [ "tag" .= ("A_Float" :: Text), "arg0" .= arg0]
    A_V2F arg0 -> object [ "tag" .= ("A_V2F" :: Text), "arg0" .= arg0]
    A_V3F arg0 -> object [ "tag" .= ("A_V3F" :: Text), "arg0" .= arg0]
    A_V4F arg0 -> object [ "tag" .= ("A_V4F" :: Text), "arg0" .= arg0]
    A_M22F arg0 -> object [ "tag" .= ("A_M22F" :: Text), "arg0" .= arg0]
    A_M33F arg0 -> object [ "tag" .= ("A_M33F" :: Text), "arg0" .= arg0]
    A_M44F arg0 -> object [ "tag" .= ("A_M44F" :: Text), "arg0" .= arg0]
    A_Int arg0 -> object [ "tag" .= ("A_Int" :: Text), "arg0" .= arg0]
    A_Word arg0 -> object [ "tag" .= ("A_Word" :: Text), "arg0" .= arg0]

instance FromJSON MeshAttribute where
  parseJSON (Object obj) = do
    tag <- obj .: "tag"
    case tag :: Text of
      "A_Float" -> A_Float <$> obj .: "arg0"
      "A_V2F" -> A_V2F <$> obj .: "arg0"
      "A_V3F" -> A_V3F <$> obj .: "arg0"
      "A_V4F" -> A_V4F <$> obj .: "arg0"
      "A_M22F" -> A_M22F <$> obj .: "arg0"
      "A_M33F" -> A_M33F <$> obj .: "arg0"
      "A_M44F" -> A_M44F <$> obj .: "arg0"
      "A_Int" -> A_Int <$> obj .: "arg0"
      "A_Word" -> A_Word <$> obj .: "arg0"
  parseJSON _ = mzero

instance ToJSON MeshPrimitive where
  toJSON v = case v of
    P_Points -> object [ "tag" .= ("P_Points" :: Text)]
    P_TriangleStrip -> object [ "tag" .= ("P_TriangleStrip" :: Text)]
    P_Triangles -> object [ "tag" .= ("P_Triangles" :: Text)]
    P_TriangleStripI arg0 -> object [ "tag" .= ("P_TriangleStripI" :: Text), "arg0" .= arg0]
    P_TrianglesI arg0 -> object [ "tag" .= ("P_TrianglesI" :: Text), "arg0" .= arg0]

instance FromJSON MeshPrimitive where
  parseJSON (Object obj) = do
    tag <- obj .: "tag"
    case tag :: Text of
      "P_Points" -> pure P_Points
      "P_TriangleStrip" -> pure P_TriangleStrip
      "P_Triangles" -> pure P_Triangles
      "P_TriangleStripI" -> P_TriangleStripI <$> obj .: "arg0"
      "P_TrianglesI" -> P_TrianglesI <$> obj .: "arg0"
  parseJSON _ = mzero

instance ToJSON Mesh where
  toJSON v = case v of
    Mesh{..} -> object
      [ "tag" .= ("Mesh" :: Text)
      , "mAttributes" .= mAttributes
      , "mPrimitive" .= mPrimitive
      ]

instance FromJSON Mesh where
  parseJSON (Object obj) = do
    tag <- obj .: "tag"
    case tag :: Text of
      "Mesh" -> do
        mAttributes <- obj .: "mAttributes"
        mPrimitive <- obj .: "mPrimitive"
        pure $ Mesh
          { mAttributes = mAttributes
          , mPrimitive = mPrimitive
          } 
  parseJSON _ = mzero