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

SCM Repository

[sml3d] Annotation of /gen/gl-types.sml
ViewVC logotype

Annotation of /gen/gl-types.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 243 - (view) (download)

1 : jhr 243 (* gl-types.sml
2 :     *
3 :     * COPYRIGHT (c) 2008 John Reppy (http://cs.uchicago.edu/~jhr)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure GLTypes =
8 :     struct
9 :    
10 :     datatype c_type
11 :     = VoidTy
12 :     | BaseTy of Atom.atom
13 :     | PtrTy of c_type
14 :    
15 :     (* a parser for simple C types *)
16 :     fun parseCType ty = let
17 :     fun scanId start = let
18 :     fun scan (ss, n) = (case Substring.getc ss
19 :     of SOME(c, ss') => if Char.isAlphaNum c orelse (c = #"_")
20 :     then scan(ss', n+1)
21 :     else SOME(Substring.string(Substring.slice(start, 0, SOME n)), ss)
22 :     | NONE => SOME(Substring.string(Substring.slice(start, 0, SOME n)), ss)
23 :     (* end case *))
24 :     in
25 :     case Substring.getc start
26 :     of SOME(c, ss) => if Char.isAlpha c
27 :     then scan (ss, 1)
28 :     else NONE
29 :     | NONE => NONE
30 :     (* end case *)
31 :     end
32 :     val skipWS = StringCvt.skipWS Substring.getc
33 :     fun parse ss = (case scanId ss
34 :     of SOME("const", ss) => parse(skipWS ss)
35 :     | SOME("void", ss) => parse1 (VoidTy, ss)
36 :     | SOME("GLvoid", ss) => parse1 (VoidTy, ss)
37 :     | SOME(id, ss) => parse1 (BaseTy(Atom.atom id), ss)
38 :     | NONE => raise Fail "bogus C type"
39 :     (* end case *))
40 :     and parse1 (ty, ss) = (case Substring.getc(skipWS ss)
41 :     of NONE => ty
42 :     | SOME(#"*", ss) => parse1 (PtrTy ty, ss)
43 :     (* end case *))
44 :     in
45 :     parse (Substring.full ty)
46 :     end
47 :    
48 :     (* mapping from OpenGL base types to their ML names. Note that we assume these
49 :     * types are in the context of "open GLTypes". Also, we assume that "ptr" has been
50 :     * defined to be MLton.Pointer.t.
51 :     *)
52 :     val typeMap = let
53 :     val tbl = AtomTable.mkTable (32, Fail "typeMap")
54 :     val ins = AtomTable.insert tbl
55 :     fun lookup ty = (case AtomTable.find tbl ty
56 :     of NONE => raise Fail("unknown C type " ^ Atom.toString ty)
57 :     | SOME ty => ty
58 :     (* end case *))
59 :     in
60 :     List.app (fn (a, b) => ins(Atom.atom a, b)) [
61 :     ("GLboolean", "glboolean"),
62 :     ("GLbyte", "glbyte"),
63 :     ("GLenum", "glenum"),
64 :     ("GLfloat", "glfloat"),
65 :     ("GLsizeiptr", "glsizeiptr"),
66 :     ("GLdouble", "gldouble"),
67 :     ("GLubyte", "glubyte"),
68 :     ("GLuint", "gluint"),
69 :     ("GLclampd", "glclampd"),
70 :     ("GLvoid", "glvoid"),
71 :     ("GLclampf", "glclampf"),
72 :     ("GLsizei", "glsizei"),
73 :     ("GLushort", "glushort"),
74 :     ("GLshort", "glshort"),
75 :     ("GLint", "glint"),
76 :     ("GLchar", "glchar"),
77 :     ("GLuint", "gluint"),
78 :     ("GLintptr", "glintptr"),
79 :     ("GLbitfield", "glbitfield"),
80 :     ("GLushort", "glushort")
81 :     ];
82 :     lookup
83 :     end
84 :    
85 :     (* convert a C type string to an ML type string *)
86 :     fun cToML ty = (case parseCType ty
87 :     of VoidTy =>"unit"
88 :     | BaseTy bty => typeMap bty
89 :     | PtrTy _ => "ptr" (* MLton.Pointer.t *)
90 :     (* end case *))
91 :    
92 :     end

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