コミット: bde46bead99fec6dfa3bb1bb1d2a1186c2487341 - Saffron (git)

Graphics library for Mercury, including OpenGL bindings, TGA image reading, and X11, Win32, and SDL2 windowing and input.

コミットメタ情報

• リビジョン: bde46bead99fec6dfa3bb1bb1d2a1186c2487341 (tree)
• 日時: 2023-06-27 04:12:19
• 作者: AlaskanEmily <emily@alas...>
• コミッター: AlaskanEmily

ログメッセージ

Add GLFW delegate window backend.

This doesn't yet have a Java implementation, but providing one with LWJGL is
the next step for a usable Java backend.

変更サマリ

• add: demo/saffron_glfw_demo.m
• add: demo/saffron_glfw_demo.sh
• modified: makefile
• add: util/glfw/saffron_glfw.m

差分

--- /dev/null
+++ b/demo/saffron_glfw_demo.m
@@ -0,0 +1,310 @@
+% Released as public domain by Transnat Games for demonstration purposes.
+%
+% Any copyright is dedicated to the Public Domain.
+% https://creativecommons.org/publicdomain/zero/1.0/
+
+:- module saffron_glfw_demo.
+
+%=============================================================================%
+:- interface.
+%=============================================================================%
+
+:- use_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io.io::di, io.io::uo) is det.
+
+%=============================================================================%
+:- implementation.
+%=============================================================================%
+
+:- use_module bool.
+:- use_module exception.
+:- import_module float.
+:- import_module int.
+:- import_module list.
+:- use_module math.
+:- use_module maybe.
+:- use_module thread.
+:- use_module thread.mvar.
+
+:- use_module mmath.
+:- use_module mmath.matrix.
+:- use_module mmath.vector.
+:- import_module mmath.vector.vector3.
+:- import_module mmath.vector.vector4.
+
+:- use_module saffron.
+:- use_module saffron.draw.
+:- import_module saffron.geometry.
+:- use_module saffron.gl.
+:- use_module saffron.gl2.
+:- use_module saffron.soft.
+:- use_module saffron_window.
+:- use_module saffron_delegate.
+:- use_module saffron_glfw.
+:- use_module saffron_tga.
+
+:- use_module timer.
+
+%-----------------------------------------------------------------------------%
+
+:- type state(Ctx, Group) ---> state(thread.mvar.mvar({Ctx, Group})).
+
+%-----------------------------------------------------------------------------%
+
+:- pred redraw(state(Ctx, Group), io.io, io.io)
+    <= (saffron.gl.context(Ctx),
+        saffron.draw.basic_transform(Ctx),
+        saffron.draw.transform_stack(Ctx),
+        saffron.draw.draw(Ctx, Group)).
+:- mode redraw(in, di, uo) is det.
+
+redraw(state(MVar), !IO) :-
+    thread.mvar.read(MVar, {Ctx, Group}, !IO),
+    % Get the current time in order to animate the camera.
+    timer.ms(Ticks, !IO),
+    Seconds = float(int.unchecked_rem(Ticks, 6283185)) / 1000.0,
+    
+    % Alternatively...
+    % time.clock(Ticks, !IO),
+    % (time.clocks_per_sec =< 0 -> Rate = 100 ; Rate = time.clocks_per_sec),
+    % Seconds = float(Ticks) / float(Rate),
+    
+    % Build the rotation matrix.
+    % To make this more visually interesting, we also move the rotation
+    % vector. If this seems confusing, just change RotateVector to be
+    % `vector(U1, U1, 1.0)` or some other constant to see the rotation
+    % normal in action.
+    SpinT = Seconds, % / 0.23,
+    Angle = Seconds * 0.87,
+    RotateVector =
+        mmath.vector.normalize(vector(math.sin(SpinT), 1.0, math.cos(SpinT))),
+    % In general, you should always normalize vectors being used to build
+    % transformation matrices.
+    Matrix = mmath.matrix.rotate(Angle, RotateVector),
+    
+    % Here we will push the ortho matrix set in main/2 and then transform
+    % it by our rotation. Then, after drawing, we pop the transformed
+    % matrix to restore the ortho matrix.
+    saffron.draw.push_matrix(Ctx, !IO),
+    
+    % In most actual programs, this would be tracked separately for the
+    % model and camera.
+    saffron.draw.transform(Ctx, Matrix, !IO),
+    
+    % Draw the model. Most real programs would iterate a set of Groups.
+    saffron.draw.draw(Ctx, Group, !IO),
+    
+    saffron.draw.pop_matrix(Ctx, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron_delegate.delegate(state(Ctx, Group))
+    <= (saffron.gl.context(Ctx),
+        saffron.draw.basic_transform(Ctx),
+        saffron.draw.transform_stack(Ctx),
+        saffron.draw.draw(Ctx, Group)) where [
+    pred(saffron_delegate.key_press/4) is saffron_delegate.key_nop,
+    pred(saffron_delegate.key_release/4) is saffron_delegate.key_nop,
+    pred(saffron_delegate.button_press/6) is saffron_delegate.button_nop,
+    pred(saffron_delegate.button_release/6) is saffron_delegate.button_nop,
+    pred(saffron_delegate.mouse_motion/5) is saffron_delegate.motion_nop,
+    pred(saffron_delegate.resize/5) is saffron_delegate.resize_nop,
+    pred(saffron_delegate.redraw/3) is saffron_glfw_demo.redraw,
+    pred(saffron_delegate.quit/3) is saffron_delegate.quit_nop
+].
+
+%-----------------------------------------------------------------------------%
+
+:- pred run(Win, thread.mvar.mvar({T1, T2}), io.io, io.io)
+    <= saffron_delegate.window(Win).
+:- mode run(in, in, di, uo) is det.
+
+run(Win, MVar, !IO) :-
+    % Although this isn't really needed here, it is good hygiene to ensure that
+    % you measure your game and update calls, and then sleep based on the
+    % difference of the time used and expected frame time.
+    timer.ms(NewTicks, !IO),
+    
+    saffron_delegate.update(Win, ShouldQuit, !IO),
+    (
+        ShouldQuit = bool.yes % Nothing else to do.
+    ;
+        ShouldQuit = bool.no,
+        % Delay, then continue looping.
+        % The delay is from now (EndMS) until the anticipated end of frame/tick
+        % (NewTicks + 16). This should give us an optimistic 60 FPS.
+        timer.ms(EndMS, !IO),
+        SleepMS = NewTicks + 16 - EndMS,
+        % Delay only if we didn't blow the frame budget.
+        ( SleepMS >= 0 -> timer.sleep(SleepMS, !IO) ; true ),
+        run(Win, MVar, !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+% Geometry for the cube model.
+%
+% Normally, you will want to load a model file, or perhaps just have a few
+% primitives defined in a similar to this.
+% 
+% 0 ----- 1
+%  \       \
+% | \     | \
+% |  2 ----- 3
+% |  |    |  |
+% |  |    |  |
+% 4 -|--- 5  |
+%  \ |     \ |
+%   \       \
+%    6 ----- 7
+% 
+%    y
+% z  |
+%  \ |
+%   \|
+%    o----x
+% 
+% Faces (in triangle strip order):
+% 0: 0, 1, 2, 3
+% 1: 0, 2, 4, 6
+% 2: 3, 1, 7, 5
+% 3: 1, 0, 5, 4
+% 4: 2, 3, 6, 7
+% 5: 6, 7, 4, 5
+:- func cube_geometry = list.list(list.list(saffron.geometry.vertex3d)).
+cube_geometry = [
+        [
+            vertex(Vec0, U0, U0) |[
+            vertex(Vec1, U1, U0) |[
+            vertex(Vec2, U0, U1) |[
+            vertex(Vec3, U1, U1) |[
+        ]]]]] |[
+        [
+            vertex(Vec0, U0, U0) |[
+            vertex(Vec2, U1, U0) |[
+            vertex(Vec4, U0, U1) |[
+            vertex(Vec6, U1, U1) |[
+        ]]]]] |[
+        [
+            vertex(Vec3, U0, U0) |[
+            vertex(Vec1, U1, U0) |[
+            vertex(Vec7, U0, U1) |[
+            vertex(Vec5, U1, U1) |[
+        ]]]]] |[
+        [
+            vertex(Vec1, U0, U0) |[
+            vertex(Vec0, U1, U0) |[
+            vertex(Vec5, U0, U1) |[
+            vertex(Vec4, U1, U1) |[
+        ]]]]] |[
+        [
+            vertex(Vec2, U0, U0) |[
+            vertex(Vec3, U1, U0) |[
+            vertex(Vec6, U0, U1) |[
+            vertex(Vec7, U1, U1) |[
+        ]]]]] |[
+        [
+            vertex(Vec6, U0, U0) |[
+            vertex(Vec7, U1, U0) |[
+            vertex(Vec4, U0, U1) |[
+            vertex(Vec5, U1, U1) |[
+        ]]]]] |[
+    ]]]]]]] :-
+     
+    Vec0 = vector(-1.0,  1.0,  1.0),
+    Vec1 = vector( 1.0,  1.0,  1.0),
+    Vec2 = vector(-1.0,  1.0, -1.0),
+    Vec3 = vector( 1.0,  1.0, -1.0),
+    Vec4 = vector(-1.0, -1.0,  1.0),
+    Vec5 = vector( 1.0, -1.0,  1.0),
+    Vec6 = vector(-1.0, -1.0, -1.0),
+    Vec7 = vector( 1.0, -1.0, -1.0),
+    U0 = 0.0,
+    U1 = 1.0 .
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    % Load the demo image
+    saffron_tga.load_path("res/crate.tga", ImageResult, !IO),
+    
+    % The Mercury compiler is smart enough to see that the error branch will
+    % throw, and will unify the result outside that disjunction.
+    (
+        ImageResult = io.error(Err),
+        exception.throw(exception.software_error(io.error_message(Err)))
+    ;
+        ImageResult = io.ok({BMP, TexW, TexH})
+    ),
+    W = 640,
+    H = 480,
+    Title = "Saffron GLFW Demo",
+    
+    thread.mvar.init(MVar, !IO),
+    saffron_glfw.create_window(state(MVar), W, H, Title, 2, 0, WinRes, !IO),
+    (
+        WinRes = io.error(Err),
+        exception.throw(exception.software_error(io.error_message(Err)))
+    ;
+        WinRes = io.ok(Win)
+    ),
+    
+    % Using the backend-specific type is what determines what backend Glow is
+    % using.
+    saffron.gl2.init(Win, Ctx, !IO),
+    
+    saffron.gl.opengl_version_string(Ctx, GLVersion, !IO),
+    io.write_string("OpenGL Version: ", !IO),
+    io.write_string(GLVersion, !IO),
+    io.nl(!IO),
+    
+    saffron.gl.shader_model_version_string(Ctx, GLSLVersion, !IO),
+    io.write_string("GLSL Version: ", !IO),
+    io.write_string(GLSLVersion, !IO),
+    io.nl(!IO),
+    
+    % Set the ortho mode
+    AR = float(W) / float(H),
+    
+    Matrix = mmath.matrix.ortho(-AR, AR, 1.0, -1.0, -1000.0, 1000.0),
+    saffron.draw.set_matrix(Ctx, Matrix, !IO),
+    
+    saffron.draw.transform(Ctx, mmath.matrix.scale(0.4, 0.4, 0.4), !IO),
+    
+    % Upload the image to create a texture.
+    saffron.gl.create_texture_from_bitmap(Ctx, BMP, TexW, TexH, Texture, !IO),
+    Faces = cube_geometry,
+    
+    % Upload geometry to buffers.
+    % Most programs would probably want to use index buffers for a shape like
+    % this with mostly shared geometry.
+    list.map_foldl(
+        saffron.geometry.create_buffer_list(Ctx),
+        Faces, FaceBuffers,
+        !IO),
+    
+    % Construct the faces.
+    % This *could* be done as one large, wound shape, but the majority of
+    % programs will be loading meshes that will contain individual hulls/faces
+    % that will need to be constructed in this way.
+    list.map_foldl(
+        saffron.geometry.create_shape2(Ctx, saffron.geometry.triangle_strip, Texture),
+        FaceBuffers,
+        Shapes,
+        !IO),
+    
+    % Construct the shape.
+    saffron.draw.create_group_list(Ctx, Shapes, Group, !IO),
+    
+    thread.mvar.put(MVar, {Ctx, Group}, !IO),
+    % Run the engine.
+    run(Win, MVar, !IO),
+    
+    % Cleanup
+    saffron.destroy(Ctx, Group, !IO),
+    list.foldl(saffron.destroy(Ctx), Shapes, !IO),
+    list.foldl(saffron.destroy(Ctx), FaceBuffers, !IO),
+    saffron.destroy(Ctx, Texture, !IO).
+

--- /dev/null
+++ b/demo/saffron_glfw_demo.sh
@@ -0,0 +1,2 @@
+cd `dirname "$0"`
+exec sh run_demo.sh saffron_glfw_demo $@

--- a/makefile
+++ b/makefile
@@ -23,7 +23,7 @@ all: $(ALL)
 UTILS=build_saffron_window build_saffron_delegate build_saffron_glow build_saffron_tga
 utils: $(UTILS)
 
-DEMOS=build_saffron_cube_demo build_saffron_shader_demo
+DEMOS=build_saffron_cube_demo build_saffron_shader_demo build_saffron_glfw_demo
 demos: $(DEMOS)
 
 MMATH_LINK_FLAGS=--search-lib-files-dir '$(ROOT)/mmath' --init-file '$(ROOT)/mmath/mmath.init'
@@ -37,6 +37,7 @@ SAFFRON_TGA_LINK_FLAGS=--search-lib-files-dir '$(ROOT)/util/tga' --init-file '$(
 SAFFRON_GLOW_LINK_FLAGS=--search-lib-files-dir '$(ROOT)/util/glow' --init-file '$(ROOT)/util/glow/saffron_glow.init' $(GLOW_INCLUDE_FLAGS)
 SAFFRON_WINDOW_LINK_FLAGS=--search-lib-files-dir '$(ROOT)/util/window' --init-file '$(ROOT)/util/window/saffron_window.init'
 SAFFRON_DELEGATE_LINK_FLAGS=$(SAFFRON_WINDOW_LINK_FLAGS) --search-lib-files-dir '$(ROOT)/util/delegate' --init-file '$(ROOT)/util/delegate/saffron_delegate.init'
+SAFFRON_GLFW_LINK_FLAGS=$(SAFFRON_DELEGATE_LINK_FLAGS) --search-lib-files-dir '$(ROOT)/util/glfw' --init-file '$(ROOT)/util/glfw/saffron_glfw.init'
 
 # Generated source.
 saffron.gl.buffer.inc: saffron.gl_gen.awk saffron.gl.buffer.csv
@@ -91,10 +92,17 @@ build_saffron_window:
 util/window/libsaffron_delegate.$(SO): build_saffron_delegate
 build_saffron_delegate: build_saffron_window
 	cd util/delegate && $(MMC) $(SAFFRON_MMC_OPTS) $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_WINDOW_LINK_FLAGS) --make libsaffron_delegate $(STATIC_MMC_FLAGS)
-	cd util/delegate && $(MMC) $(SAFFRON_MMC_OPTS) $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_WINDOW_LINK_FLAGS) --make libsaffron_delegate $(SHARED_MMC_FLAGS)
+	cd util/delegate && $(MMC) $(SAFFRON_MMC_OPTS) $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_WINDOW_LINK_FLAGS) --make libsaffron_delegate $(SHARED_MMC_FLAGS) -L '$(ROOT)/util/window' -lsaffron_window
 	install util/delegate/libsaffron_delegate.$(SO) demo/
 	install util/delegate/libsaffron_delegate.$(SO) test/
 
+util/glow/libsaffron_glfw.$(SO): build_saffron_glfw
+build_saffron_glfw: build_saffron_delegate build_saffron_window build_saffron
+	cd util/glfw && $(MMC) $(SAFFRON_MMC_OPTS) $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_DELEGATE_LINK_FLAGS) --make libsaffron_glfw $(STATIC_MMC_FLAGS) 
+	cd util/glfw && $(MMC) $(SAFFRON_MMC_OPTS) $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_DELEGATE_LINK_FLAGS) --make libsaffron_glfw $(SHARED_MMC_FLAGS) -L '$(ROOT)/util/window' -lsaffron_window -L '$(ROOT)/util/delegate' -lsaffron_delegate -L '$(ROOT)' -lsaffron -lglfw -lGL
+	install util/glfw/libsaffron_glfw.$(SO) demo/
+	install util/glfw/libsaffron_glfw.$(SO) test/
+
 build_saffron_tga:
 	cd util/tga && $(MMC) $(SAFFRON_MMC_OPTS) --make libsaffron_tga $(STATIC_MMC_FLAGS)
 
@@ -118,6 +126,9 @@ build_saffron_cube_demo: build_demo_utils demo/res/crate.tga build_saffron build
 build_saffron_shader_demo: build_demo_utils build_saffron build_saffron_glow
 	cd demo && $(MMC) $(SAFFRON_MMC_OPTS) -E --make saffron_shader_demo $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_GLOW_LINK_FLAGS) $(SAFFRON_WINDOW_LINK_FLAGS) -L '$(ROOT)/glow' -lglow -lX11 -lmmath -lsaffron -lsaffron_window -lsaffron_glow -lGL
 
+build_saffron_glfw_demo: build_demo_utils demo/res/crate.tga build_saffron build_saffron_glfw build_saffron_tga
+	cd demo && $(MMC) $(SAFFRON_MMC_OPTS) -E --make saffron_glfw_demo $(MMATH_LINK_FLAGS) $(SAFFRON_LINK_FLAGS) $(SAFFRON_GLFW_LINK_FLAGS)  $(SAFFRON_TGA_LINK_FLAGS) -lglfw -lmmath -lsaffron -lsaffron_window -lsaffron_delegate -lsaffron_glfw --link-object '$(ROOT)/util/tga/libsaffron_tga.a' -lGL
+
 # Testing
 build_transunit:
 	cd test/transunit && $(MMC) $(SAFFRON_MMC_OPTS) --make libtransunit $(STATIC_MMC_FLAGS)
@@ -149,6 +160,9 @@ clean_saffron_window:
 clean_saffron_delegate:
 	DIR=util/delegate ; TARGET=saffron_delegate ; $(CLEAN_MERCURY)
 
+clean_saffron_glfw:
+	DIR=util/glfw ; TARGET=saffron_glfw ; $(CLEAN_MERCURY)
+
 clean_test_saffron_tga:
 	DIR=test ; TARGET=test_saffron_tga ; $(CLEAN_MERCURY)
 
@@ -158,7 +172,10 @@ clean_saffron_cube_demo:
 clean_saffron_shader_demo:
 	DIR=demo ; TARGET=saffron_shader_demo ; $(CLEAN_MERCURY)
 
-CLEAN=clean_mmath clean_saffron clean_glow clean_saffron_glow clean_saffron_window clean_saffron_tga clean_saffron_delegate clean_glow clean_test_saffron_tga clean_saffron_cube_demo clean_saffron_cube_demo
+clean_saffron_glfw_demo:
+	DIR=demo ; TARGET=saffron_glfw_demo ; $(CLEAN_MERCURY)
+
+CLEAN=clean_mmath clean_saffron clean_glow clean_saffron_glow clean_saffron_window clean_saffron_delegate clean_saffron_glfw clean_saffron_tga clean_saffron_delegate clean_glow clean_test_saffron_tga clean_saffron_cube_demo clean_saffron_cube_demo clean_saffron_glfw_demo
 clean: $(CLEAN)
 	rm -f demo/res/crate.tga demo/res/ctc24.tga demo/lib*.$(SO) # Remove the demo libraries we copied and libtimer.
 

--- /dev/null
+++ b/util/glfw/saffron_glfw.m
@@ -0,0 +1,487 @@
+% Copyright (C) 2023 AlaskanEmily, Transnat Games
+%
+% this software is provided 'as-is', without any express or implied
+% warranty.  in no event will the authors be held liable for any damages
+% arising from the use of this software.
+%
+% permission is granted to anyone to use this software for any purpose,
+% including commercial applications, and to alter it and redistribute it
+% freely, subject to the following restrictions:
+%
+% 1. the origin of this software must not be misrepresented; you must not
+%    claim that you wrote the original software. if you use this software
+%    in a product, an acknowledgment in the product documentation would be
+%    appreciated but is not required.
+% 2. altered source versions must be plainly marked as such, and must not be
+%    misrepresented as being the original software.
+% 3. this notice may not be removed or altered from any source distribution.
+
+:- module saffron_glfw.
+%=============================================================================%
+% Implementation of saffron_delegate using GLFW3.
+%
+% This is currently only implemented for C, but in the future this should
+% include using GLFW through lwjgl for Java.
+%
+% There isn't a real need to use this in the C backend, as the OS X
+% implementation of saffron_delegate and the glow backend of saffron_window are
+% generally better and require fewer dependencies. You could use it if you
+% only want to use saffron_delegate instead of saffron_window on some
+% platforms, but doing that will mean more dependencies and more code running
+% on the most common platforms.
+:- interface.
+%=============================================================================%
+
+:- use_module io.
+
+:- use_module saffron.
+:- use_module saffron.gl.
+:- use_module saffron_delegate.
+
+%-----------------------------------------------------------------------------%
+
+:- inst io_res_uniq == unique(io.ok(unique) ; io.error(ground)).
+:- mode io_res_uo == (free >> io_res_uniq).
+
+%-----------------------------------------------------------------------------%
+
+:- type window.
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron.context(window).
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron.gl.context(window).
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron_delegate.window(window).
+
+%-----------------------------------------------------------------------------%
+% create_window(T, W, H, Title, GLMajor, GLMinor, Result, !IO).
+:- pred create_window(T, int, int, string, int, int, io.res(window), io.io, io.io)
+    <= saffron_delegate.delegate(T).
+:- mode create_window(in, in, in, in, in, in, io_res_uo, di, uo) is det.
+
+%=============================================================================%
+:- implementation.
+%=============================================================================%
+
+:- use_module maybe.
+:- use_module bool.
+
+:- pragma foreign_import_module("C", saffron_window).
+:- pragma foreign_import_module("C", saffron_delegate).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C",
+    "
+#include <GLFW/glfw3.h>
+extern MR_Bool saffron_glfw_init_ok;
+
+void SaffronGLFW_KeyCallback(
+    GLFWwindow *win,
+    int key,
+    int scancode,
+    int action,
+    int mods);
+
+void SaffronGLFW_MouseButtonCallback(
+    GLFWwindow *win,
+    int button,
+    int action,
+    int mods);
+
+void SaffronGLFW_MouseMotionCallback(
+    GLFWwindow *win,
+    double x,
+    double y);
+    
+#define SAFFRON_GLFW_GET_ERROR(OK, ERR) do{ \\
+    const char *SAFFRON_GLFW_GET_ERROR_err; \\
+    if(glfwGetError(&SAFFRON_GLFW_GET_ERROR_err) == 0){ \\
+        (OK) = 1; \\
+        (ERR) = (MR_String)""<NULL>""; \\
+    } \\
+    else{ \\
+        (OK) = 0; \\
+        const long SAFFRON_GLFW_GET_ERROR_len = \\
+            strlen(SAFFRON_GLFW_GET_ERROR_err); \\
+        MR_allocate_aligned_string_msg( \\
+            ERR, \\
+            SAFFRON_GLFW_GET_ERROR_len, \\
+            MR_ALLOC_ID); \\
+        memcpy((ERR), \\
+            SAFFRON_GLFW_GET_ERROR_err, \\
+            SAFFRON_GLFW_GET_ERROR_len + 1); \\
+    } \\
+}while(0)
+
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_code("C",
+    "
+MR_Bool saffron_glfw_init_ok = MR_NO;
+
+void SaffronGLFW_KeyCallback(
+    GLFWwindow *win,
+    int key,
+    int scancode,
+    int action,
+    int mods){
+    
+    MR_Word delegate;
+    MR_Word mr_key;
+    delegate = (MR_Word)glfwGetWindowUserPointer(win);
+    
+    /* Create the key data. */
+    if(key >= 32 && key <= 96){
+        mr_key = Saffron_CreateKey(key);
+    }
+    else{
+        switch(key){
+            case GLFW_KEY_ESCAPE:
+                mr_key = SAFFRON_KEY_ESCAPE;
+                break;
+            case GLFW_KEY_ENTER:
+                mr_key = SAFFRON_KEY_ENTER;
+                break;
+            case GLFW_KEY_TAB:
+                mr_key = SAFFRON_KEY_TAB;
+                break;
+            case GLFW_KEY_BACKSPACE:
+                mr_key = SAFFRON_KEY_BACKSPACE;
+                break;
+            case GLFW_KEY_DELETE:
+                mr_key = SAFFRON_KEY_DELETE;
+                break;
+            case GLFW_KEY_RIGHT:
+                mr_key = SAFFRON_KEY_RIGHT_ARROW;
+                break;
+            case GLFW_KEY_LEFT:
+                mr_key = SAFFRON_KEY_LEFT_ARROW;
+                break;
+            case GLFW_KEY_DOWN:
+                mr_key = SAFFRON_KEY_DOWN_ARROW;
+                break;
+            case GLFW_KEY_UP:
+                mr_key = SAFFRON_KEY_UP_ARROW;
+                break;
+            case GLFW_KEY_LEFT_SHIFT: /* FALLTHROUGH */
+            case GLFW_KEY_RIGHT_SHIFT:
+                mr_key = SAFFRON_KEY_SHIFT;
+                break;
+            case GLFW_KEY_LEFT_CONTROL: /* FALLTHROUGH */
+            case GLFW_KEY_RIGHT_CONTROL:
+                mr_key = SAFFRON_KEY_CONTROL;
+                break;
+            default:
+                return;
+        }
+        Saffron_CreateSpecialKey(mr_key, &mr_key);
+    }
+    switch(action){
+        case GLFW_PRESS:
+            Saffron_DelegateKeyPress(delegate, mr_key);
+            break;
+        case GLFW_RELEASE:
+            Saffron_DelegateKeyRelease(delegate, mr_key);
+            break;
+    }
+}
+
+void SaffronGLFW_MouseButtonCallback(
+    GLFWwindow *win,
+    int button,
+    int action,
+    int mods){
+    
+    MR_Word delegate;
+    MR_Word mr_button;
+    double x, y;
+    delegate = (MR_Word)glfwGetWindowUserPointer(win);
+    
+    switch(button){
+        case GLFW_MOUSE_BUTTON_LEFT:
+            mr_button = SAFFRON_BUTTON_LEFT;
+            break;
+        case GLFW_MOUSE_BUTTON_RIGHT:
+            mr_button = SAFFRON_BUTTON_RIGHT;
+            break;
+        case GLFW_MOUSE_BUTTON_MIDDLE:
+            mr_button = SAFFRON_BUTTON_MIDDLE;
+            break;
+        default:
+            return;
+    }
+    glfwGetCursorPos(win, &x, &y);
+    switch(action){
+        case GLFW_PRESS:
+            Saffron_DelegateButtonPress(delegate, mr_button, x, y);
+            break;
+        case GLFW_RELEASE:
+            Saffron_DelegateButtonRelease(delegate, mr_button, x, y);
+            break;
+    }
+}
+
+void SaffronGLFW_MouseMotionCallback(
+    GLFWwindow *win,
+    double x,
+    double y){
+    
+    MR_Word delegate;
+    delegate = (MR_Word)glfwGetWindowUserPointer(win);
+    
+    Saffron_DelegateMouseMotion(delegate, x, y);
+}
+
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_type("C", window, "GLFWwindow*").
+
+:- type delegate == saffron_delegate.delegate_private.
+
+%-----------------------------------------------------------------------------%
+
+:- impure pred glfw_initialize is det.
+glfw_initialize.
+:- pragma foreign_proc("C",
+    glfw_initialize,
+    [will_not_call_mercury, thread_safe, will_not_throw_exception],
+    "saffron_glfw_init_ok = glfwInit();").
+
+:- initialize glfw_initialize/0.
+
+%-----------------------------------------------------------------------------%
+
+:- impure pred glfw_finalize is det.
+glfw_finalize.
+:- pragma foreign_proc("C",
+    glfw_finalize,
+    [will_not_call_mercury, thread_safe, will_not_throw_exception],
+    "glfwTerminate();").
+
+:- finalize glfw_finalize/0.
+
+%-----------------------------------------------------------------------------%
+
+:- func create_window_ok(window::di) = (io.res(window)::uo) is det.
+create_window_ok(Ctx) = io.ok(Ctx).
+:- pragma foreign_export("C",
+    create_window_ok(di) = (uo),
+    "SaffronGLFW_CreateWindowOK").
+
+%-----------------------------------------------------------------------------%
+
+:- func create_window_error(string::di) = (io.res(window)::io_res_uo) is det.
+create_window_error(Str) = io.error(io.make_io_error(Str)).
+:- pragma foreign_export("C",
+    create_window_error(di) = (io_res_uo),
+    "SaffronGLFW_CreateWindowError").
+
+%-----------------------------------------------------------------------------%
+
+:- pred make_current(window::in, io.io::di, io.io::uo) is det.
+:- pragma foreign_proc("C",
+    make_current(Win::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+     does_not_affect_liveness, may_duplicate],
+    "
+    IOo = IOi;
+    glfwMakeContextCurrent(Win);
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- pred load_function(window, string, maybe.maybe_error(saffron.ctx_function), io.io, io.io).
+:- mode load_function(in, in, out, di, uo) is det.
+:- pragma foreign_proc("C",
+    load_function(Win::in, Name::in, MaybeFunc::out, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+     does_not_affect_liveness, may_duplicate],
+    "
+    GLFWglproc proc;
+    MR_String err;
+    int ok;
+    IOo = IOi;
+    (void)Win;
+    proc = glfwGetProcAddress(Name);
+    SAFFRON_GLFW_GET_ERROR(ok, err);
+    MaybeFunc = ok ?
+        Saffron_CreateCtxFunctionOK((MR_Word)proc) :
+        Saffron_CreateCtxFunctionError(err);
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron.context(window) where [
+    pred(saffron.make_current/3) is saffron_glfw.make_current,
+    pred(saffron.load_function/5) is saffron_glfw.load_function
+].
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron.gl.context(window) where [].
+
+%-----------------------------------------------------------------------------%
+
+:- pred show_window(window::in, io.io::di, io.io::uo) is det.
+:- pragma foreign_proc("C",
+    show_window(Win::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+     does_not_affect_liveness, may_duplicate],
+    "
+    IOo = IOi;
+    glfwShowWindow(Win);
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- pred hide_window(window::in, io.io::di, io.io::uo) is det.
+:- pragma foreign_proc("C",
+    hide_window(Win::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+     does_not_affect_liveness, may_duplicate],
+    "
+    IOo = IOi;
+    glfwHideWindow(Win);
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- pred update(window::in, bool.bool::uo, io.io::di, io.io::uo) is det.
+:- pragma foreign_proc("C",
+    update(Win::in, ShouldQuit::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+     does_not_affect_liveness, may_duplicate],
+    "
+    int w, h;
+    MR_Word delegate;
+    IOo = IOi;
+    ShouldQuit = glfwWindowShouldClose(Win);
+    if(!ShouldQuit){
+        glfwMakeContextCurrent(Win);
+        glfwGetFramebufferSize(Win, &w, &h);
+        glViewport(0, 0, w, h);
+        delegate = (MR_Word)glfwGetWindowUserPointer(Win);
+        Saffron_DelegateRedraw(delegate);
+        glfwSwapBuffers(Win);
+        glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
+        glfwPollEvents();
+    }
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- instance saffron_delegate.window(window) where [
+    pred(saffron_delegate.show_window/3) is saffron_glfw.show_window,
+    pred(saffron_delegate.hide_window/3) is saffron_glfw.hide_window,
+    pred(saffron_delegate.update/4) is saffron_glfw.update
+].
+
+%-----------------------------------------------------------------------------%
+
+:- type hint --->
+    context_major ;
+    context_minor ;
+    doublebuffer ;
+    red_bits ;
+    green_bits ;
+    blue_bits ;
+    alpha_bits ;
+    retina ;
+    no_error.
+
+:- pragma foreign_enum("C", hint/0, [
+    context_major - "GLFW_CONTEXT_VERSION_MAJOR",
+    context_minor - "GLFW_CONTEXT_VERSION_MINOR",
+    doublebuffer - "GLFW_DOUBLEBUFFER",
+    red_bits - "GLFW_RED_BITS",
+    green_bits - "GLFW_GREEN_BITS",
+    blue_bits - "GLFW_BLUE_BITS",
+    alpha_bits - "GLFW_ALPHA_BITS",
+    retina - "GLFW_COCOA_RETINA_FRAMEBUFFER",
+    no_error - "GLFW_CONTEXT_NO_ERROR"
+]).
+
+%-----------------------------------------------------------------------------%
+
+:- pred window_hint(hint::in, int::in, io.io::di, io.io::uo) is det.
+:- pred reset_window_hints(io.io::di, io.io::uo) is det.
+
+:- pragma foreign_proc("C",
+    window_hint(Hint::in, I::in, IOi::di, IOo::uo),
+    [promise_pure, will_not_call_mercury, will_not_throw_exception, thread_safe,
+    may_duplicate, does_not_affect_liveness],
+    "
+    IOo = IOi;
+    glfwWindowHint(Hint, I);
+    ").
+
+:- pragma foreign_proc("C",
+    reset_window_hints(IOi::di, IOo::uo),
+    [promise_pure, will_not_call_mercury, will_not_throw_exception, thread_safe,
+    may_duplicate, does_not_affect_liveness],
+    "
+    IOo = IOi;
+    glfwDefaultWindowHints();
+    ").
+
+%-----------------------------------------------------------------------------%
+
+:- pred create_window(delegate, int, int, string, io.res(window), io.io, io.io).
+:- mode create_window(in, in, in, in, io_res_uo, di, uo) is det.
+
+:- pragma foreign_proc("C",
+    create_window(D::in, W::in, H::in, Title::in, Result::io_res_uo, IOi::di, IOo::uo),
+    [promise_pure, will_not_call_mercury, will_not_throw_exception, thread_safe,
+    may_duplicate, does_not_affect_liveness],
+    "
+    GLFWwindow *window;
+    MR_String err;
+    int ok;
+    
+    IOo = IOi;
+    if(!saffron_glfw_init_ok){
+        ok = 0;
+        err = (MR_String)""GLFW did not initialize"";
+    }
+    else{
+        // glfwWindowHint(GLFW_OPENGL_PROFILE, GLFW_OPENGL_COMPAT_PROFILE);
+        window = glfwCreateWindow(W, H, Title, NULL, NULL);
+        SAFFRON_GLFW_GET_ERROR(ok, err);
+    }
+    if(ok && window != NULL){
+        glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
+        glfwSetWindowUserPointer(window, (void*)D);
+        glfwSetKeyCallback(window, SaffronGLFW_KeyCallback);
+        glfwSetMouseButtonCallback(window, SaffronGLFW_MouseButtonCallback);
+        glfwSetCursorPosCallback(window, SaffronGLFW_MouseMotionCallback);
+        Result = SaffronGLFW_CreateWindowOK(window);
+    }
+    else{
+        Result = SaffronGLFW_CreateWindowError(err);
+    }
+    ").
+
+%-----------------------------------------------------------------------------%
+
+% create_window(T, W, H, Title, GLMajor, GLMinor, Result, !IO).
+create_window(D, W, H, Title, GLMajor, GLMinor, Result, !IO) :-
+    reset_window_hints(!IO),
+    window_hint(context_major, GLMajor, !IO),
+    window_hint(context_minor, GLMinor, !IO),
+    window_hint(retina, 1, !IO),
+    Delegate = saffron_delegate.create_delegate_private(D),
+    create_window(Delegate, W, H, Title, Result, !IO).
+
+%-----------------------------------------------------------------------------%
+