Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] Annotation of /trunk/sml3d/gen/gen-from-xml/glgen/gen-consts.sml
ViewVC logotype

Annotation of /trunk/sml3d/gen/gen-from-xml/glgen/gen-consts.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1379 - (view) (download)

1 : jhr 1369 (* gen-consts.sml
2 :     *
3 :     * COPYRIGHT (c) 2014 The SML3d Project (http://sml3d.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     *)
7 :    
8 :     structure GenConsts : sig
9 :    
10 :     (* Generate a structure containing all of the constant (i.e., enum) definitions
11 :     * in the database.
12 :     *)
13 :     val gen : {db : DBXMLRep.db, outFile : string, structName : string} -> unit
14 :    
15 :     val test : string -> unit
16 :    
17 :     end = struct
18 :    
19 :     structure X = DBXMLRep
20 :     structure F = Format
21 :    
22 :     (* header and footer for the output file *)
23 :     val header = "\
24 :     \(* %s\n\
25 :     \ *\n\
26 :     \ * COPYRIGHT (c) %4d The SML3d Project (http://sml3d.cs.uchicago.edu)\n\
27 :     \ * All rights reserved.\n\
28 :     \ *\n\
29 :     \ * These are the OpenGL constants taken from %s.\n\
30 :     \ *\n\
31 :     \ * WARNING: this file is generated; do not edit!!!\n\
32 :     \ *)\n\
33 :     \\n\
34 :     \structure %s =\n\
35 :     \ struct\n\
36 :     \\n\
37 :     \ type glenum = GLTypes.glenum\n\
38 :     \\n\
39 :     \"
40 :     val footer = "\
41 :     \\n\
42 :     \ end (* %s *)\n\
43 :     \"
44 :    
45 :     val a_GLint = Atom.atom "GLint"
46 : jhr 1379 val a_GLenum = Atom.atom "GLenum"
47 : jhr 1369 val a_GLuint = Atom.atom "GLuint"
48 :     val a_GLuint64 = Atom.atom "GLuint64"
49 :    
50 :     fun gen {db, outFile, structName} = let
51 :     val outS = TextIO.openOut outFile
52 :     fun pr s = TextIO.output(outS, s)
53 :     fun prf (fmt, items) = pr(F.format fmt items)
54 :     val X.DB{registry, enums, ...} = db
55 :     fun genEnum {name, ty, value} = let
56 :     val (isSigned, mlty) = (case ty
57 : jhr 1379 of NONE => (false, "glenum")
58 : jhr 1369 | SOME(CType.NamedTy ty) =>
59 :     if Atom.same(ty, a_GLint) then (true, "glint")
60 : jhr 1379 else if Atom.same(ty, a_GLenum) then (false, "glenum")
61 :     else if Atom.same(ty, a_GLuint) then (false, "gluint")
62 : jhr 1369 else if Atom.same(ty, a_GLuint64) then (false, "glint64")
63 :     else raise Fail "unknown C type"
64 :     | _ => raise Fail "unknown C type"
65 :     (* end case *))
66 :     in
67 : jhr 1379 if not isSigned
68 :     then prf(" val %s : %s = 0wx%08x\n", [F.ATOM name, F.STR mlty, F.LINT value])
69 :     else if (value < 0)
70 :     then prf(" val %s : %s = ~%d\n", [F.ATOM name, F.STR mlty, F.LINT(~value)])
71 :     else prf(" val %s : %s = %d\n", [F.ATOM name, F.STR mlty, F.LINT value])
72 : jhr 1369 end
73 :     in
74 :     prf (header, [
75 :     F.STR(OS.Path.file outFile), F.INT(Date.year(Date.fromTimeLocal(Time.now()))),
76 :     F.STR registry, F.STR structName
77 :     ]);
78 :     List.app genEnum enums;
79 :     prf (footer, [F.STR structName]);
80 :     TextIO.closeOut outS
81 :     end
82 :    
83 :     fun test dbFile = let
84 :     val db = DBXMLParser.parseFile dbFile
85 :     in
86 :     gen {db = db, outFile = "consts.sml", structName = "Consts"}
87 :     end
88 :    
89 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0