humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add basic imperative shell

Browse Source
This commit is contained in:
Humza Shahid
2024-12-10 19:48:07 +00:00
parent fb2be7be73
commit 9d42e14b2f
17 changed files with 5083 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
oms

2
Makefile
View File

@@ -1,2 +1,2 @@
run:
mlton oms.mlb && ./oms
./build-unix.sh && ./oms

8
build-unix.sh Executable file
View File

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

168
ffi/export.h Normal file
View File

@@ -0,0 +1,168 @@
#ifndef __OMS_ML_H__
#define __OMS_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_OMS) && \
!defined(STATIC_LINK_OMS) && \
!defined(DYNAMIC_LINK_OMS)
#define PART_OF_OMS
#endif
#if defined(PART_OF_OMS)
#define MLLIB_PRIVATE(x) PRIVATE x
#define MLLIB_PUBLIC(x) PUBLIC x
#elif defined(STATIC_LINK_OMS)
#define MLLIB_PRIVATE(x)
#define MLLIB_PUBLIC(x) PUBLIC x
#elif defined(DYNAMIC_LINK_OMS)
#define MLLIB_PRIVATE(x)
#define MLLIB_PUBLIC(x) EXTERNAL x
#else
#error Must specify linkage for oms
#define MLLIB_PRIVATE(x)
#define MLLIB_PUBLIC(x)
#endif
#ifdef __cplusplus
extern "C" {
#endif
#undef MLLIB_PRIVATE
#undef MLLIB_PUBLIC
#ifdef __cplusplus
}
#endif
#endif /* __OMS_ML_H__ */

1463
ffi/glad.c Normal file
View File

File diff suppressed because it is too large Load Diff

2749
ffi/glad.h Normal file
View File

File diff suppressed because it is too large Load Diff

98
ffi/gles3-export.c Normal file
View File

@@ -0,0 +1,98 @@
#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 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);
}

63
ffi/gles3-import.sml Normal file
View File

@@ -0,0 +1,63 @@
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 VERTEX_SHADER = VERTEX_SHADER ()
val (FRAGMENT_SHADER, _) =
_symbol "FRAGMENT_SHADER" public : ( unit -> shader_type ) * ( shader_type -> unit );
val FRAGMENT_SHADER = FRAGMENT_SHADER ()
val (TRIANGLES, _) =
_symbol "TRIANGLES" public : ( unit -> draw_mode ) * ( draw_mode -> unit );
val TRIANGLES = TRIANGLES ()
val (STATIC_DRAW, _) =
_symbol "STATIC_DRAW" public : ( unit -> update_mode ) * ( update_mode -> unit );
val STATIC_DRAW = STATIC_DRAW ()
val (DYNAMIC_DRAW, _) =
_symbol "DYNAMIC_DRAW" public : ( unit -> update_mode ) * ( update_mode -> unit );
val DYNAMIC_DRAW = DYNAMIC_DRAW ()
(* 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 deleteShader = _import "deleteShader" 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;
end

49
ffi/glfw-export.c Normal file
View File

@@ -0,0 +1,49 @@
#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_TRUE = GLFW_TRUE;
int GLFW_FFI_FALSE = GLFW_FALSE;
int SAMPLES = GLFW_SAMPLES;
int GLFW_WINDOW_MAX = GLFW_MAXIMIZED;
// 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);
}
void setClipboardString (GLFWwindow *window, const char *copyString) {
glfwSetClipboardString(window, copyString);
}

30
ffi/glfw-import.sml Normal file
View File

@@ -0,0 +1,30 @@
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 (TRUE, _) =
_symbol "GLFW_FFI_TRUE" 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 );
val (WINDOW_MAX, _) =
_symbol "GLFW_WINDOW_MAX" 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;
val setClipboardString = _import "setClipboardString" public : window * string -> unit;
end

9
ffi/glfw-input.c Normal file
View File

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

19
ffi/glfw-input.sml Normal file
View File

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

282
ffi/khrplatform.h Normal file
View File

@@ -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_ */

16
oms.mlb
View File

@@ -10,3 +10,19 @@ end
fcore/quad-tree.sml
fcore/player.sml
fcore/wall.sml
(* 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/gl-shaders.sml
shell/gl-draw.sml
shell/shell.sml

83
shell/gl-draw.sml Normal file
View File

@@ -0,0 +1,83 @@
structure GlDraw =
struct
open CML
type t = { window: MLton.Pointer.t }
fun createShader (shaderType, shaderString) =
let
val shader = Gles3.createShader shaderType
val _ = Gles3.shaderSource (shader, shaderString)
val _ = Gles3.compileShader shader
in
shader
end
fun createProgram (vertexShader, fragmentShader) =
let
val program = Gles3.createProgram ()
val _ = Gles3.attachShader (program, vertexShader)
val _ = Gles3.attachShader (program, fragmentShader)
val _ = Gles3.linkProgram program
in
program
end
fun create window =
let
(* create vertex buffer, program, etc. *)
val textVertexBuffer = Gles3.createBuffer ()
val xyrgbVertexShader = createShader
(Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString)
val rgbFragmentShader = createShader
(Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString)
val placeholderProgram = createProgram (xyrgbVertexShader, rgbFragmentShader)
in
{window = window}
end
fun drawXyrgb (vertexBuffer, program, drawLength) =
if drawLength > 0 then
let
val _ = Gles3.bindBuffer vertexBuffer
(* enable xy component from uploaded array *)
val _ = Gles3.vertexAttribPointer (0, 2, 5, 0)
val _ = Gles3.enableVertexAttribArray 0
(* enable rgb component from uploaded array *)
val _ = Gles3.vertexAttribPointer (1, 3, 5, 8)
val _ = Gles3.enableVertexAttribArray 1
val _ = Gles3.useProgram program
val _ = Gles3.drawArrays (Gles3.TRIANGLES, 0, drawLength)
in
()
end
else
()
fun helpLoop (shellState as {window, ...}: t) =
case Glfw.windowShouldClose window of
false =>
let
val _ = Gles3.clearColor (1.0, 1.0, 1.0, 1.0)
val _ = Gles3.clear ()
(* todo:
* - update game state
* - consume draw messages
* - finally, draw
* *)
val _ = Glfw.swapBuffers window
val _ = Glfw.waitEvents ()
in
helpLoop shellState
end
| true => Glfw.terminate ()
fun loop window =
let val shellState = create window
in helpLoop shellState
end
end

23
shell/gl-shaders.sml Normal file
View File

@@ -0,0 +1,23 @@
structure GlShaders =
struct
val xyrgbVertexShaderString =
"#version 300 es\n\
\layout (location = 0) in vec2 apos;\n\
\layout (location = 1) in vec3 col;\n\
\out vec3 frag_col;\n\
\void main()\n\
\{\n\
\ frag_col = col;\n\
\ gl_Position = vec4(apos.x, apos.y, 0.0f, 1.0f);\n\
\}"
val rgbFragmentShaderString =
"#version 300 es\n\
\precision mediump float;\n\
\in vec3 frag_col;\n\
\out vec4 FragColor;\n\
\void main()\n\
\{\n\
\ FragColor = vec4(frag_col.x, frag_col.y, frag_col.z, 1.0f);\n\
\}"
end

21
shell/shell.sml Normal file
View File

@@ -0,0 +1,21 @@
structure Shell =
struct
open CML
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.WINDOW_MAX (), Glfw.TRUE ())
val window = Glfw.createWindow (1920, 1080, "shf")
val _ = Glfw.makeContextCurrent window
val _ = Gles3.loadGlad ()
in
GlDraw.loop window
end
end
val _ = Shell.main ()