@@ -15,8 +15,8 @@ import ManPages
15
15
16
16
main :: IO ()
17
17
main = do
18
- [registryPath] <- E. getArgs
19
- let api = API " gl "
18
+ [a, registryPath] <- E. getArgs
19
+ let api = API a
20
20
res <- parseRegistry toEnumType `fmap` readFile registryPath
21
21
case res of
22
22
Left msg -> SI. hPutStrLn SI. stderr msg
@@ -28,25 +28,40 @@ main = do
28
28
let extModules = extensionModules api registry
29
29
CM. forM_ extModules printExtensionModule
30
30
printReExports extModules
31
- CM. forM_ openGLVersions $ \ v ->
32
- CM. forM_ (supportedProfiles v) $ \ p ->
31
+ CM. forM_ ( openGLVersions api) $ \ v ->
32
+ CM. forM_ (supportedProfiles api v) $ \ p ->
33
33
printFeature api v p registry
34
- printTopLevel extModules
35
-
36
- openGLVersions :: [Version ]
37
- openGLVersions = map read $ [
38
- " 1.0" , " 1.1" , " 1.2" , " 1.3" , " 1.4" , " 1.5" ,
39
- " 2.0" , " 2.1" ,
40
- " 3.0" , " 3.1" , " 3.2" , " 3.3" ,
41
- " 4.0" , " 4.1" , " 4.2" , " 4.3" , " 4.4" , " 4.5" ]
42
-
43
- supportedProfiles :: Version -> [Maybe ProfileName ]
44
- supportedProfiles v
45
- | major v < 3 = [ Nothing ]
46
- | otherwise = map (Just . ProfileName ) [ " core" , " compatibility" ]
34
+ printTopLevel api extModules
35
+
36
+ openGLVersions :: API -> [Version ]
37
+ openGLVersions api = map read $ case unAPI api of
38
+ " gl" -> [ " 1.0" , " 1.1" , " 1.2" , " 1.3" , " 1.4" , " 1.5" ,
39
+ " 2.0" , " 2.1" ,
40
+ " 3.0" , " 3.1" , " 3.2" , " 3.3" ,
41
+ " 4.0" , " 4.1" , " 4.2" , " 4.3" , " 4.4" , " 4.5" ]
42
+ " gles1" -> [ " 1.0" ]
43
+ " gles2" -> [ " 2.0" , " 3.0" , " 3.1" ]
44
+ a -> error $ " unknown API " ++ a
45
+
46
+ latestVersion :: API -> Version
47
+ latestVersion = last . openGLVersions
48
+
49
+ supportedProfiles :: API -> Version -> [Maybe ProfileName ]
50
+ supportedProfiles api v = case unAPI api of
51
+ " gl" | major v < 3 -> [ Nothing ]
52
+ | otherwise -> map (Just . ProfileName ) [ " core" , " compatibility" ]
53
+ " gles1" -> map (Just . ProfileName ) [ " lite" , " common" ]
54
+ " gles2" -> [ Nothing ]
55
+ a -> error $ " unknown API " ++ a
56
+
57
+ latestProfiles :: API -> [Maybe ProfileName ]
58
+ latestProfiles api = supportedProfiles api (latestVersion api)
59
+
60
+ profileToReExport :: API -> Maybe ProfileName
61
+ profileToReExport = last . latestProfiles
47
62
48
63
printFeature :: API -> Version -> Maybe ProfileName -> Registry -> IO ()
49
- printFeature api version mbProfile registry = do
64
+ printFeature api version mbProfile registry =
50
65
printExtension [featureName version mbProfile] [] $
51
66
fixedReplay api version mbProfile registry
52
67
@@ -181,11 +196,13 @@ extensionModules :: API -> Registry -> [(ExtensionName, ExtensionName, ([TypeNam
181
196
extensionModules api registry =
182
197
[ (extName, mangledExtName, executeModifications api mbProfile registry mods)
183
198
| (extName, mods) <- supportedExtensions api registry
184
- , mbProfile <- supportedProfiles $ ( if any isProfileDependent mods then last else head ) openGLVersions
199
+ , mbProfile <- if isProfileDependent mods then suppProfs else [ Nothing ]
185
200
, let mangledExtName = mangleExtensionName (extendWithProfile extName mbProfile)
186
201
]
187
- where isProfileDependent :: Modification -> Bool
188
- isProfileDependent = DM. isJust . modificationProfile
202
+ where suppProfs = latestProfiles api
203
+ isProfileDependent mods = any (`S.member` allProfileNames) (mentionedProfileNames mods)
204
+ mentionedProfileNames mods = DM. catMaybes . map modificationProfile $ mods
205
+ allProfileNames = S. fromList . DM. catMaybes $ suppProfs
189
206
190
207
-- We only consider non-empty supported extensions/modifications for the given API.
191
208
supportedExtensions :: API -> Registry -> [(ExtensionName , [Modification ])]
@@ -288,13 +305,18 @@ printExtension moduleNameSuffix comment (ts, es, cs) =
288
305
CM. unless (null cs) $
289
306
SI. hPutStrLn h $ " import " ++ moduleNameFor [" Functions" ]
290
307
291
- printTopLevel :: [(ExtensionName , ExtensionName , ([TypeName ], [Enum' ], [Command ]))] -> IO ()
292
- printTopLevel extModules = do
308
+ printTopLevel :: API -> [(ExtensionName , ExtensionName , ([TypeName ], [Enum' ], [Command ]))] -> IO ()
309
+ printTopLevel api extModules = do
293
310
let mangledCategories = sortUnique [ extensionNameCategory mangledExtName
294
311
| (_, mangledExtName, _) <- extModules ]
295
- lastComp = featureName (last openGLVersions) (Just (ProfileName " compatibility" ))
312
+ profToReExport = profileToReExport api
313
+ lastComp = featureName (latestVersion api) profToReExport
296
314
moduleNames = [ moduleNameFor [c] | c <- [ lastComp, " GetProcAddress" ] ++ mangledCategories ]
297
- comment = [ " A convenience module, combining the latest OpenGL compatibility profile plus"
315
+ comment = [ L. intercalate " "
316
+ [ " A convenience module, combining the latest"
317
+ , apiName api
318
+ , maybe " version" (\ p -> unProfileName p ++ " profile" ) profToReExport
319
+ , " plus" ]
298
320
, " all extensions." ]
299
321
startModule [] Nothing comment $ \ moduleName h -> do
300
322
SI. hPutStrLn h $ " module " ++ moduleName ++ " ("
@@ -304,6 +326,13 @@ printTopLevel extModules = do
304
326
CM. forM_ moduleNames $ \ moduleName ->
305
327
SI. hPutStrLn h $ " import " ++ moduleName
306
328
329
+ apiName :: API -> String
330
+ apiName api = case unAPI api of
331
+ " gl" -> " OpenGL"
332
+ " gles1" -> " OpenGL ES 1.x"
333
+ " gles2" -> " OpenGL ES"
334
+ a -> error $ " unknown API " ++ a
335
+
307
336
sortUnique :: Ord a => [a ] -> [a ]
308
337
sortUnique = S. toList . S. fromList
309
338
0 commit comments