init

build-unix.sh

@@ -0,0 +1,8 @@
+#!/bin/sh
+mlton -link-opt "$(pkg-config --cflags glfw3) $(pkg-config --static --libs glfw3)" \
+  -export-header ffi/export.h \
+  shf.mlb \
+  ffi/glad.c \
+  ffi/glfw-export.c \
+  ffi/gles3-export.c \
+  ffi/glfw-input.c

ffi/export.h

@@ -0,0 +1,168 @@
+#ifndef __SHF_ML_H__
+#define __SHF_ML_H__
+
+/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a HPND-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_MLTYPES_H_
+#define _MLTON_MLTYPES_H_
+
+/* We need these because in header files for exported SML functions, 
+ * types.h is included without cenv.h.
+ */
+#if (defined (_AIX) || defined (__hpux__) || defined (__OpenBSD__))
+#include <inttypes.h>
+#elif (defined (__sun__))
+#include <sys/int_types.h>
+#else
+#include <stdint.h>
+#endif
+
+/* ML types */
+typedef unsigned char PointerAux __attribute__ ((may_alias));
+typedef PointerAux* Pointer;
+#define Array(t) Pointer
+#define Ref(t) Pointer
+#define Vector(t) Pointer
+
+typedef int8_t Int8_t;
+typedef int8_t Int8;
+typedef int16_t Int16_t;
+typedef int16_t Int16;
+typedef int32_t Int32_t;
+typedef int32_t Int32;
+typedef int64_t Int64_t;
+typedef int64_t Int64;
+typedef float Real32_t;
+typedef float Real32;
+typedef double Real64_t;
+typedef double Real64;
+typedef uint8_t Word8_t;
+typedef uint8_t Word8;
+typedef uint16_t Word16_t;
+typedef uint16_t Word16;
+typedef uint32_t Word32_t;
+typedef uint32_t Word32;
+typedef uint64_t Word64_t;
+typedef uint64_t Word64;
+
+typedef Int8_t WordS8_t;
+typedef Int8_t WordS8;
+typedef Int16_t WordS16_t;
+typedef Int16_t WordS16;
+typedef Int32_t WordS32_t;
+typedef Int32_t WordS32;
+typedef Int64_t WordS64_t;
+typedef Int64_t WordS64;
+
+typedef Word8_t WordU8_t;
+typedef Word8_t WordU8;
+typedef Word16_t WordU16_t;
+typedef Word16_t WordU16;
+typedef Word32_t WordU32_t;
+typedef Word32_t WordU32;
+typedef Word64_t WordU64_t;
+typedef Word64_t WordU64;
+
+typedef WordU8_t Char8_t;
+typedef WordU8_t Char8;
+typedef WordU16_t Char16_t;
+typedef WordU16_t Char16;
+typedef WordU32_t Char32_t;
+typedef WordU32_t Char32;
+
+typedef Vector(Char8_t) String8_t;
+typedef Vector(Char8_t) String8;
+typedef Vector(Char16_t) String16_t;
+typedef Vector(Char16_t) String16;
+typedef Vector(Char32_t) String32_t;
+typedef Vector(Char32_t) String32;
+
+typedef Int32_t Bool_t;
+typedef Int32_t Bool;
+typedef String8_t NullString8_t;
+typedef String8_t NullString8;
+
+typedef void* CPointer;
+typedef Pointer Objptr;
+
+#endif /* _MLTON_MLTYPES_H_ */
+
+/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a HPND-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_EXPORT_H_
+#define _MLTON_EXPORT_H_
+
+/* ------------------------------------------------- */
+/*                      Symbols                      */
+/* ------------------------------------------------- */
+
+/* An external symbol is something not defined by the module
+ * (executable or library) being built. Rather, it is provided
+ * from a library dependency (dll, dylib, or shared object).
+ *
+ * A public symbol is defined in this module as being available
+ * to users outside of this module. If building a library, this 
+ * means the symbol will be part of the public interface.
+ * 
+ * A private symbol is defined within this module, but will not
+ * be made available outside of it. This is typically used for
+ * internal implementation details that should not be accessible.
+ */
+
+#if defined(_WIN32) || defined(_WIN64) || defined(__CYGWIN__)
+#define EXTERNAL __declspec(dllimport)
+#define PUBLIC   __declspec(dllexport)
+#define PRIVATE
+#else
+#define EXTERNAL __attribute__((visibility("default")))
+#define PUBLIC   __attribute__((visibility("default")))
+#define PRIVATE  __attribute__((visibility("hidden")))
+#endif
+
+#endif /* _MLTON_EXPORT_H_ */
+
+#if !defined(PART_OF_SHF) && \
+    !defined(STATIC_LINK_SHF) && \
+    !defined(DYNAMIC_LINK_SHF)
+#define PART_OF_SHF
+#endif
+
+#if defined(PART_OF_SHF)
+#define MLLIB_PRIVATE(x) PRIVATE x
+#define MLLIB_PUBLIC(x) PUBLIC x
+#elif defined(STATIC_LINK_SHF)
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x) PUBLIC x
+#elif defined(DYNAMIC_LINK_SHF)
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x) EXTERNAL x
+#else
+#error Must specify linkage for shf
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x)
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#undef MLLIB_PRIVATE
+#undef MLLIB_PUBLIC
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __SHF_ML_H__ */

ffi/gles3-export.c

@@ -0,0 +1,99 @@
+#include "export.h"
+#include "glad.h"
+#include <GLFW/glfw3.h>
+#include <stdbool.h>
+
+// OpenGL constants used below
+unsigned int VERTEX_SHADER = GL_VERTEX_SHADER;
+unsigned int FRAGMENT_SHADER = GL_FRAGMENT_SHADER;
+unsigned int TRIANGLES = GL_TRIANGLES;
+unsigned int TRIANGLE_FAN = GL_TRIANGLE_FAN;
+unsigned int STATIC_DRAW = GL_STATIC_DRAW;
+unsigned int DYNAMIC_DRAW = GL_DYNAMIC_DRAW;
+
+// OpenGL functions used below
+void loadGlad() {
+  gladLoadGLLoader((GLADloadproc)glfwGetProcAddress);
+}
+
+void viewport(int width, int height) {
+  glViewport(0, 0, width, height);
+}
+
+void clearColor(float r, float g, float b, float a) {
+  glClearColor(r, g, b, a);
+}
+
+void clear() {
+  glClear(GL_COLOR_BUFFER_BIT);
+}
+
+unsigned int createBuffer() {
+  unsigned int buffer;
+  glGenBuffers(1, &buffer);
+  return buffer;
+}
+
+void bindBuffer(unsigned int buffer) {
+  glBindBuffer(GL_ARRAY_BUFFER, buffer);
+}
+
+void bufferData(float* vector, int vectorLength, unsigned int updateMode) {
+  glBufferData(GL_ARRAY_BUFFER, sizeof(float) * vectorLength, vector, updateMode);
+}
+
+unsigned int createShader(unsigned int shaderType) {
+  return glCreateShader(shaderType);
+}
+
+void shaderSource(unsigned int shader, const char *sourceString) {
+  glShaderSource(shader, 1, &sourceString, NULL);
+}
+
+void compileShader(unsigned int shader) {
+  glCompileShader(shader);
+}
+
+void deleteShader(unsigned int shader) {
+  glDeleteShader(shader);
+}
+
+void vertexAttribPointer(int location, int numVecComponents, int stride, int offset) {
+  glVertexAttribPointer(location, numVecComponents, GL_FLOAT, GL_FALSE, stride * sizeof(float), (void*)offset);
+}
+
+void enableVertexAttribArray(int location) {
+  glEnableVertexAttribArray(location);
+}
+
+unsigned int createProgram() {
+  return glCreateProgram();
+}
+
+void attachShader(unsigned int program, unsigned int shader) {
+  glAttachShader(program, shader);
+}
+
+void linkProgram(unsigned int program) {
+  glLinkProgram(program);
+}
+
+void useProgram(unsigned int program) {
+  glUseProgram(program);
+}
+
+void deleteProgram(unsigned int program) {
+  glDeleteProgram(program);
+}
+
+void drawArrays(unsigned int drawMode, int startIndex, int numVertices) {
+  glDrawArrays(drawMode, startIndex, numVertices);
+}
+
+int getUniformLocation(unsigned int program, const char *uniformName) {
+  glGetUniformLocation(program, uniformName);
+}
+
+void uniform4f(int uniformLocation, float a, float b, float c, float d) {
+  glUniform4f(uniformLocation, a, b, c, d);
+}

ffi/gles3-import.sml

@@ -0,0 +1,58 @@
+structure Gles3 =
+struct
+  type buffer = Word32.word
+  type shader_type = Word32.word
+  type shader = Word32.word
+  type program = Word32.word
+  type draw_mode = Word32.word
+  type update_mode = Word32.word
+
+  (* OpenGL constants used. *)
+  val (VERTEX_SHADER, _) =
+    _symbol "VERTEX_SHADER" public : ( unit -> shader_type ) * ( shader_type -> unit );
+  val (FRAGMENT_SHADER, _) =
+    _symbol "FRAGMENT_SHADER" public : ( unit -> shader_type ) * ( shader_type -> unit );
+  val (TRIANGLES, _) =
+    _symbol "TRIANGLES" public : ( unit -> draw_mode ) * ( draw_mode -> unit );
+  val (TRIANGLE_FAN, _) =
+    _symbol "TRIANGLE_FAN" public : ( unit -> draw_mode ) * ( draw_mode -> unit );
+  val (STATIC_DRAW, _) =
+    _symbol "STATIC_DRAW" public : ( unit -> update_mode ) * ( update_mode -> unit );
+  val (DYNAMIC_DRAW, _) =
+    _symbol "DYNAMIC_DRAW" public : ( unit -> update_mode ) * ( update_mode -> unit );
+
+  (* OpenGL functions used. *)
+  val loadGlad = _import "loadGlad" public : unit -> unit;
+  val viewport = _import "viewport" public : int * int -> unit;
+
+  val createBuffer = _import "createBuffer" public : unit -> buffer;
+  val bindBuffer = _import "bindBuffer" public : buffer -> unit;
+  val bufferData =
+    _import "bufferData" public : Real32.real vector * int * update_mode -> unit;
+
+  val createShader = _import "createShader" public : shader_type -> shader;
+  val compileShader = _import "compileShader" public : shader -> unit;
+  val deleteShader = _import "deleteShader" public : shader -> unit;
+  val shaderSource = _import "shaderSource" public : shader * string -> unit;
+
+  val vertexAttribPointer =
+    _import "vertexAttribPointer" public : int * int * int * int -> unit;
+  val enableVertexAttribArray =
+    _import "enableVertexAttribArray" public : int -> unit;
+
+  val createProgram = _import "createProgram" public : unit -> program;
+  val attachShader = _import "attachShader" public : program * shader -> unit;
+  val linkProgram = _import "linkProgram" public : program -> unit;
+  val useProgram = _import "useProgram" public : program -> unit;
+  val deleteProgram = _import "deleteProgram" public : program -> unit;
+
+  val clearColor =
+    _import "clearColor" public : Real32.real * Real32.real * Real32.real * Real32.real -> unit;
+  val clear = _import "clear" public : unit -> unit;
+  val drawArrays = _import "drawArrays" public : draw_mode * int * int -> unit;
+
+  val getUniformLocation =
+    _import "getUniformLocation" public : program * string -> int;
+  val uniform4f =
+    _import "uniform4f" public : int * Real32.real * Real32.real * Real32.real * Real32.real -> unit;
+end

ffi/glfw-export.c

@@ -0,0 +1,43 @@
+#include <stdbool.h>
+#define GLFW_INCLUDE_NONE
+#include <GLFW/glfw3.h>
+
+// GLFW constants used below
+int CONTEXT_VERSION_MAJOR = GLFW_CONTEXT_VERSION_MAJOR;
+int DEPRECATED = GLFW_DECORATED;
+int GLFW_FFI_FALSE = GLFW_FALSE;
+int SAMPLES = GLFW_SAMPLES;
+
+// GLFW functions used below
+void init() {
+  glfwInit();
+}
+
+void windowHint(int hint, int value) {
+  glfwWindowHint(hint, value);
+}
+
+GLFWwindow* createWindow(int width, int height, const char *title) {
+  return glfwCreateWindow(width, height, title, NULL, NULL);
+}
+
+void terminate() {
+  glfwTerminate();
+}
+
+void makeContextCurrent(GLFWwindow* window) {
+  glfwMakeContextCurrent(window);
+}
+
+bool windowShouldClose(GLFWwindow *window) {
+  glfwWindowShouldClose(window);
+}
+
+void waitEvents() {
+  glfwWaitEvents();
+}
+
+void swapBuffers(GLFWwindow *window) {
+  glfwSwapBuffers(window);
+}
+

ffi/glfw-import.sml

@@ -0,0 +1,25 @@
+structure Glfw =
+struct
+  type window = MLton.Pointer.t
+
+  (* Window hint constants. *)
+  val (CONTEXT_VERSION_MAJOR, _) =
+    _symbol "CONTEXT_VERSION_MAJOR" public : ( unit -> int ) * ( int -> unit );
+  val (DEPRECATED, _) =
+    _symbol "DEPRECATED" public : ( unit -> int ) * ( int -> unit );
+  val (FALSE, _) =
+    _symbol "GLFW_FFI_FALSE" public : ( unit -> int ) * ( int -> unit );
+  val (SAMPLES, _) =
+    _symbol "SAMPLES" public : ( unit -> int ) * ( int -> unit );
+
+  (* GLFW functions. *)
+  val init = _import "init" public : unit -> unit;
+  val windowHint = _import "windowHint" public : int * int -> unit;
+  val createWindow =
+    _import "createWindow" public : int * int * string -> window;
+  val terminate = _import "terminate" public : unit -> unit;
+  val makeContextCurrent = _import "makeContextCurrent" public : window -> unit;
+  val windowShouldClose = _import "windowShouldClose" public : window -> bool;
+  val waitEvents = _import "waitEvents" public reentrant : unit -> unit;
+  val swapBuffers = _import "swapBuffers" public : window -> unit;
+end

ffi/glfw-input.c

@@ -0,0 +1,8 @@
+#include "export.h"
+#define GLFW_INCLUDE_NONE
+#include <GLFW/glfw3.h>
+
+int PRESS = GLFW_PRESS;
+int REPEAT = GLFW_REPEAT;
+int RELEASE = GLFW_RELEASE;
+

ffi/glfw-input.sml

@@ -0,0 +1,12 @@
+structure Input =
+struct
+  type window = MLton.Pointer.t
+
+  (* Constants. *)
+  val (PRESS, _) =
+    _symbol "PRESS" public : ( unit -> int ) * ( int -> unit );
+  val (REPEAT, _) =
+    _symbol "REPEAT" public : ( unit -> int ) * ( int -> unit );
+  val (RELEASE, _) =
+    _symbol "RELEASE" public : ( unit -> int ) * ( int -> unit );
+end

ffi/khrplatform.h

@@ -0,0 +1,282 @@
+#ifndef __khrplatform_h_
+#define __khrplatform_h_
+
+/*
+** Copyright (c) 2008-2018 The Khronos Group Inc.
+**
+** Permission is hereby granted, free of charge, to any person obtaining a
+** copy of this software and/or associated documentation files (the
+** "Materials"), to deal in the Materials without restriction, including
+** without limitation the rights to use, copy, modify, merge, publish,
+** distribute, sublicense, and/or sell copies of the Materials, and to
+** permit persons to whom the Materials are furnished to do so, subject to
+** the following conditions:
+**
+** The above copyright notice and this permission notice shall be included
+** in all copies or substantial portions of the Materials.
+**
+** THE MATERIALS ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+** IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+** CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+** TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+** MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
+*/
+
+/* Khronos platform-specific types and definitions.
+ *
+ * The master copy of khrplatform.h is maintained in the Khronos EGL
+ * Registry repository at https://github.com/KhronosGroup/EGL-Registry
+ * The last semantic modification to khrplatform.h was at commit ID:
+ *      67a3e0864c2d75ea5287b9f3d2eb74a745936692
+ *
+ * Adopters may modify this file to suit their platform. Adopters are
+ * encouraged to submit platform specific modifications to the Khronos
+ * group so that they can be included in future versions of this file.
+ * Please submit changes by filing pull requests or issues on
+ * the EGL Registry repository linked above.
+ *
+ *
+ * See the Implementer's Guidelines for information about where this file
+ * should be located on your system and for more details of its use:
+ *    http://www.khronos.org/registry/implementers_guide.pdf
+ *
+ * This file should be included as
+ *        #include <KHR/khrplatform.h>
+ * by Khronos client API header files that use its types and defines.
+ *
+ * The types in khrplatform.h should only be used to define API-specific types.
+ *
+ * Types defined in khrplatform.h:
+ *    khronos_int8_t              signed   8  bit
+ *    khronos_uint8_t             unsigned 8  bit
+ *    khronos_int16_t             signed   16 bit
+ *    khronos_uint16_t            unsigned 16 bit
+ *    khronos_int32_t             signed   32 bit
+ *    khronos_uint32_t            unsigned 32 bit
+ *    khronos_int64_t             signed   64 bit
+ *    khronos_uint64_t            unsigned 64 bit
+ *    khronos_intptr_t            signed   same number of bits as a pointer
+ *    khronos_uintptr_t           unsigned same number of bits as a pointer
+ *    khronos_ssize_t             signed   size
+ *    khronos_usize_t             unsigned size
+ *    khronos_float_t             signed   32 bit floating point
+ *    khronos_time_ns_t           unsigned 64 bit time in nanoseconds
+ *    khronos_utime_nanoseconds_t unsigned time interval or absolute time in
+ *                                         nanoseconds
+ *    khronos_stime_nanoseconds_t signed time interval in nanoseconds
+ *    khronos_boolean_enum_t      enumerated boolean type. This should
+ *      only be used as a base type when a client API's boolean type is
+ *      an enum. Client APIs which use an integer or other type for
+ *      booleans cannot use this as the base type for their boolean.
+ *
+ * Tokens defined in khrplatform.h:
+ *
+ *    KHRONOS_FALSE, KHRONOS_TRUE Enumerated boolean false/true values.
+ *
+ *    KHRONOS_SUPPORT_INT64 is 1 if 64 bit integers are supported; otherwise 0.
+ *    KHRONOS_SUPPORT_FLOAT is 1 if floats are supported; otherwise 0.
+ *
+ * Calling convention macros defined in this file:
+ *    KHRONOS_APICALL
+ *    KHRONOS_APIENTRY
+ *    KHRONOS_APIATTRIBUTES
+ *
+ * These may be used in function prototypes as:
+ *
+ *      KHRONOS_APICALL void KHRONOS_APIENTRY funcname(
+ *                                  int arg1,
+ *                                  int arg2) KHRONOS_APIATTRIBUTES;
+ */
+
+/*-------------------------------------------------------------------------
+ * Definition of KHRONOS_APICALL
+ *-------------------------------------------------------------------------
+ * This precedes the return type of the function in the function prototype.
+ */
+#if defined(_WIN32) && !defined(__SCITECH_SNAP__)
+#   define KHRONOS_APICALL __declspec(dllimport)
+#elif defined (__SYMBIAN32__)
+#   define KHRONOS_APICALL IMPORT_C
+#elif defined(__ANDROID__)
+#   define KHRONOS_APICALL __attribute__((visibility("default")))
+#else
+#   define KHRONOS_APICALL
+#endif
+
+/*-------------------------------------------------------------------------
+ * Definition of KHRONOS_APIENTRY
+ *-------------------------------------------------------------------------
+ * This follows the return type of the function  and precedes the function
+ * name in the function prototype.
+ */
+#if defined(_WIN32) && !defined(_WIN32_WCE) && !defined(__SCITECH_SNAP__)
+    /* Win32 but not WinCE */
+#   define KHRONOS_APIENTRY __stdcall
+#else
+#   define KHRONOS_APIENTRY
+#endif
+
+/*-------------------------------------------------------------------------
+ * Definition of KHRONOS_APIATTRIBUTES
+ *-------------------------------------------------------------------------
+ * This follows the closing parenthesis of the function prototype arguments.
+ */
+#if defined (__ARMCC_2__)
+#define KHRONOS_APIATTRIBUTES __softfp
+#else
+#define KHRONOS_APIATTRIBUTES
+#endif
+
+/*-------------------------------------------------------------------------
+ * basic type definitions
+ *-----------------------------------------------------------------------*/
+#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || defined(__GNUC__) || defined(__SCO__) || defined(__USLC__)
+
+
+/*
+ * Using <stdint.h>
+ */
+#include <stdint.h>
+typedef int32_t                 khronos_int32_t;
+typedef uint32_t                khronos_uint32_t;
+typedef int64_t                 khronos_int64_t;
+typedef uint64_t                khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif defined(__VMS ) || defined(__sgi)
+
+/*
+ * Using <inttypes.h>
+ */
+#include <inttypes.h>
+typedef int32_t                 khronos_int32_t;
+typedef uint32_t                khronos_uint32_t;
+typedef int64_t                 khronos_int64_t;
+typedef uint64_t                khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif defined(_WIN32) && !defined(__SCITECH_SNAP__)
+
+/*
+ * Win32
+ */
+typedef __int32                 khronos_int32_t;
+typedef unsigned __int32        khronos_uint32_t;
+typedef __int64                 khronos_int64_t;
+typedef unsigned __int64        khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif defined(__sun__) || defined(__digital__)
+
+/*
+ * Sun or Digital
+ */
+typedef int                     khronos_int32_t;
+typedef unsigned int            khronos_uint32_t;
+#if defined(__arch64__) || defined(_LP64)
+typedef long int                khronos_int64_t;
+typedef unsigned long int       khronos_uint64_t;
+#else
+typedef long long int           khronos_int64_t;
+typedef unsigned long long int  khronos_uint64_t;
+#endif /* __arch64__ */
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#elif 0
+
+/*
+ * Hypothetical platform with no float or int64 support
+ */
+typedef int                     khronos_int32_t;
+typedef unsigned int            khronos_uint32_t;
+#define KHRONOS_SUPPORT_INT64   0
+#define KHRONOS_SUPPORT_FLOAT   0
+
+#else
+
+/*
+ * Generic fallback
+ */
+#include <stdint.h>
+typedef int32_t                 khronos_int32_t;
+typedef uint32_t                khronos_uint32_t;
+typedef int64_t                 khronos_int64_t;
+typedef uint64_t                khronos_uint64_t;
+#define KHRONOS_SUPPORT_INT64   1
+#define KHRONOS_SUPPORT_FLOAT   1
+
+#endif
+
+
+/*
+ * Types that are (so far) the same on all platforms
+ */
+typedef signed   char          khronos_int8_t;
+typedef unsigned char          khronos_uint8_t;
+typedef signed   short int     khronos_int16_t;
+typedef unsigned short int     khronos_uint16_t;
+
+/*
+ * Types that differ between LLP64 and LP64 architectures - in LLP64,
+ * pointers are 64 bits, but 'long' is still 32 bits. Win64 appears
+ * to be the only LLP64 architecture in current use.
+ */
+#ifdef _WIN64
+typedef signed   long long int khronos_intptr_t;
+typedef unsigned long long int khronos_uintptr_t;
+typedef signed   long long int khronos_ssize_t;
+typedef unsigned long long int khronos_usize_t;
+#else
+typedef signed   long  int     khronos_intptr_t;
+typedef unsigned long  int     khronos_uintptr_t;
+typedef signed   long  int     khronos_ssize_t;
+typedef unsigned long  int     khronos_usize_t;
+#endif
+
+#if KHRONOS_SUPPORT_FLOAT
+/*
+ * Float type
+ */
+typedef          float         khronos_float_t;
+#endif
+
+#if KHRONOS_SUPPORT_INT64
+/* Time types
+ *
+ * These types can be used to represent a time interval in nanoseconds or
+ * an absolute Unadjusted System Time.  Unadjusted System Time is the number
+ * of nanoseconds since some arbitrary system event (e.g. since the last
+ * time the system booted).  The Unadjusted System Time is an unsigned
+ * 64 bit value that wraps back to 0 every 584 years.  Time intervals
+ * may be either signed or unsigned.
+ */
+typedef khronos_uint64_t       khronos_utime_nanoseconds_t;
+typedef khronos_int64_t        khronos_stime_nanoseconds_t;
+#endif
+
+/*
+ * Dummy value used to pad enum types to 32 bits.
+ */
+#ifndef KHRONOS_MAX_ENUM
+#define KHRONOS_MAX_ENUM 0x7FFFFFFF
+#endif
+
+/*
+ * Enumerated boolean type
+ *
+ * Values other than zero should be considered to be true.  Therefore
+ * comparisons should not be made against KHRONOS_TRUE.
+ */
+typedef enum {
+    KHRONOS_FALSE = 0,
+    KHRONOS_TRUE  = 1,
+    KHRONOS_BOOLEAN_ENUM_FORCE_SIZE = KHRONOS_MAX_ENUM
+} khronos_boolean_enum_t;
+
+#endif /* __khrplatform_h_ */

shell/shell.sml

@@ -0,0 +1,34 @@
+structure Shell =
+struct
+  open CML
+
+  fun loop window =
+    case Glfw.windowShouldClose window of
+      false =>
+        let
+          val _ = Gles3.clearColor (0.1, 0.1, 0.1, 0.1)
+          val _ = Gles3.clear ()
+
+          val _ = Glfw.swapBuffers window
+          val _ = Glfw.waitEvents ()
+        in
+          loop window
+        end
+    | true => Glfw.terminate ()
+
+  fun main () =
+    let
+      (* Set up GLFW. *)
+      val _ = Glfw.init ()
+      val _ = Glfw.windowHint (Glfw.CONTEXT_VERSION_MAJOR (), 3)
+      val _ = Glfw.windowHint (Glfw.DEPRECATED (), Glfw.FALSE ())
+      val _ = Glfw.windowHint (Glfw.SAMPLES (), 4)
+      val window = Glfw.createWindow (1600, 900, "shf")
+      val _ = Glfw.makeContextCurrent window
+      val _ = Gles3.loadGlad ()
+    in
+      loop window
+    end
+end
+
+val _ = RunCML.doit (Shell.main, NONE)

shf.mlb

@@ -0,0 +1,17 @@
+$(SML_LIB)/basis/basis.mlb
+
+
+
+(* IMPERATIVE SHELL *)
+$(SML_LIB)/basis/mlton.mlb
+$(SML_LIB)/cml/cml.mlb
+
+ann
+  "allowFFI true"
+in
+  ffi/gles3-import.sml
+  ffi/glfw-import.sml
+  ffi/glfw-input.sml
+end
+
+shell/shell.sml