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 1369 - (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 :     val a_GLuint = Atom.atom "GLuint"
47 :     val a_GLuint64 = Atom.atom "GLuint64"
48 :    
49 :     fun gen {db, outFile, structName} = let
50 :     val outS = TextIO.openOut outFile
51 :     fun pr s = TextIO.output(outS, s)
52 :     fun prf (fmt, items) = pr(F.format fmt items)
53 :     val X.DB{registry, enums, ...} = db
54 :     fun genEnum {name, ty, value} = let
55 :     val (isSigned, mlty) = (case ty
56 :     of NONE => (true, "glint")
57 :     | SOME(CType.NamedTy ty) =>
58 :     if Atom.same(ty, a_GLint) then (true, "glint")
59 :     else if Atom.same(ty, a_GLuint) then (false, "glenum")
60 :     else if Atom.same(ty, a_GLuint64) then (false, "glint64")
61 :     else raise Fail "unknown C type"
62 :     | _ => raise Fail "unknown C type"
63 :     (* end case *))
64 :     in
65 :     if isSigned
66 :     then prf(" val %s : %s = %d\n", [F.ATOM name, F.STR mlty, F.LINT value])
67 :     else prf(" val %s : %s = 0wx%08x\n", [F.ATOM name, F.STR mlty, F.LINT value])
68 :     end
69 :     in
70 :     prf (header, [
71 :     F.STR(OS.Path.file outFile), F.INT(Date.year(Date.fromTimeLocal(Time.now()))),
72 :     F.STR registry, F.STR structName
73 :     ]);
74 :     List.app genEnum enums;
75 :     prf (footer, [F.STR structName]);
76 :     TextIO.closeOut outS
77 :     end
78 :    
79 :     fun test dbFile = let
80 :     val db = DBXMLParser.parseFile dbFile
81 :     in
82 :     gen {db = db, outFile = "consts.sml", structName = "Consts"}
83 :     end
84 :    
85 :     end

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