Commit: 1d825675170ef4cc80eaf3c9b1b3b174501aae6e - Saffron (git)

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

Commit MetaInfo

• Revision: 1d825675170ef4cc80eaf3c9b1b3b174501aae6e (tree)
• Time: 2023-06-30 08:39:39
• Author: AlaskanEmily <emily@alas...>
• Commiter: AlaskanEmily

Log Message

Add Java support to core and GL components

Change Summary

• modified: saffron.geometry.m
• modified: saffron.gl.buffer.m
• modified: saffron.gl.m
• modified: saffron.gl.shader.m
• modified: saffron.gl2.m
• modified: saffron.m

Incremental Difference

--- a/saffron.geometry.m
+++ b/saffron.geometry.m
@@ -197,24 +197,40 @@
     vertex(in, in, in, in) = (out),
     "SaffronGeometry_CreateVertex2D").
 
+:- pragma foreign_export("C",
+    vertex(in, in, in, in) = (out),
+    "CreateVertex").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_export("C",
     vertex(out, out, out, out, in),
     "SaffronGeometry_GetVertex2D").
 
+:- pragma foreign_export("Java",
+    vertex(out, out, out, out, in),
+    "GetVertex").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_export("C",
     vertex(in, in, in, in, in) = (out),
     "SaffronGeometry_CreateVertex3D").
 
+:- pragma foreign_export("Java",
+    vertex(in, in, in, in, in) = (out),
+    "CreateVertex").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_export("C",
     vertex(out, out, out, out, out, in),
     "SaffronGeometry_GetVertex3D").
 
+:- pragma foreign_export("Java",
+    vertex(out, out, out, out, out, in),
+    "GetVertex").
+
 %-----------------------------------------------------------------------------%
 
 vertex(X, Y, U, V) = vertex(mmath.vector.vector2.vector(X, Y), U, V).

--- a/saffron.gl.buffer.m
+++ b/saffron.gl.buffer.m
@@ -124,6 +124,19 @@
 #undef SAFFRON_GL_IMPL
     ").
 
+% Imports for the Java grade.
+:- pragma foreign_decl("Java", "
+import org.lwjgl.opengl.ARBVertexBufferObject;
+import org.lwjgl.opengl.GLCapabilities;
+import org.lwjgl.opengl.GL;
+import org.lwjgl.opengl.GL11; // Base constants
+import org.lwjgl.opengl.GL20;
+import jmercury.list;
+import jmercury.list.List_1;
+import jmercury.maybe.Maybe_error_2;
+import jmercury.saffron__geometry.Vertex_1;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_enum("C", buffer_type/0, [
@@ -131,13 +144,222 @@
     element_array_buffer    - "GL_ELEMENT_ARRAY_BUFFER"
 ]).
 
+:- pragma foreign_export_enum(
+    "Java",
+    buffer_type/0,
+    [prefix("BUFFER_TYPE_")|[uppercase|[]]]).
+
+:- pragma foreign_code("Java", "
+public static int BufferTypeToGL(Buffer_type_0 t, boolean ARB){
+    if(t.equals(BUFFER_TYPE_ARRAY_BUFFER)){
+        return ARB ?
+            ARBVertexBufferObject.GL_ARRAY_BUFFER_ARB :
+            GL20.GL_ARRAY_BUFFER;
+    }
+    else if(t.equals(BUFFER_TYPE_ELEMENT_ARRAY_BUFFER)){
+        return ARB ?
+            ARBVertexBufferObject.GL_ELEMENT_ARRAY_BUFFER_ARB :
+            GL20.GL_ELEMENT_ARRAY_BUFFER;
+    }
+    else{
+        throw new IllegalStateException(""Unknown buffer type"");
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Base class for a Buffer context.
+///
+/// This is a base class so that we can have either a context of sufficient
+/// version to have vertex buffers, or use ARB extensions.
+///
+/// This uses the bufferType method to convert from Buffer_type_0 to an int, so
+/// that no other subclass-implemented method needs to deal with Buffer_type_0.
+///
+/// Derived classes only need to implement primitive array versions of
+/// bufferData, all mercury types and Object-ified arrays will be unwrapped
+/// and placed into primitive arrays by the base methods.
+public static abstract class Context{
+    protected abstract int bufferType(Buffer_type_0 t);
+    public abstract int createBuffer();
+    public abstract void destroyBuffer(int buffer);
+    protected abstract void bindBuffer(int buffer, int t);
+    
+    protected abstract void bufferData(int t, int[] data);
+    public void bufferData(Buffer_type_0 t, int[] data){
+        bufferData(bufferType(t), data);
+    }
+    public void bufferData(Buffer_type_0 t, Integer[] data){
+        int[] l_data = new int[data.length];
+        for(int i = 0; i < data.length; i++)
+            l_data[i] = data[i].intValue();
+        bufferData(bufferType(t), l_data);
+    }
+    public void bufferDataI(Buffer_type_0 t, List_1<Integer> data){
+        final int length = jmercury.saffron.ListLength(data);
+        int[] l_data = new int[length];
+        for(int i = 0; i < length; i++){
+            l_data[i] = list.det_head(data).intValue();
+            data = list.det_tail(data);
+        }
+        bufferData(bufferType(t), l_data);
+    }
+    
+    protected abstract void bufferData(int t, double[] data);
+    public void bufferData(Buffer_type_0 t, double[] data){
+        bufferData(bufferType(t), data);
+    }
+    public void bufferData(Buffer_type_0 t, Double[] data){
+        double[] l_data = new double[data.length];
+        for(int i = 0; i < data.length; i++)
+            l_data[i] = data[i].doubleValue();
+        bufferData(bufferType(t), l_data);
+    }
+    public void bufferDataD(Buffer_type_0 t, list.List_1<Double> data){
+        final int length = jmercury.saffron.ListLength(data);
+        double[] l_data = new double[length];
+        for(int i = 0; i < length; i++){
+            l_data[i] = list.det_head(data).doubleValue();
+            data = list.det_tail(data);
+        }
+        bufferData(bufferType(t), l_data);
+    }
+    
+    public void bufferData2(
+        Buffer_type_0 t,
+        Vertex_1<jmercury.mmath__vector__vector2.Vector_0>[] data){
+        double[] l_data = new double[data.length * 4];
+        int i = 0;
+        for(Vertex_1<jmercury.mmath__vector__vector2.Vector_0> vertex : data)
+            i = jmercury.saffron.WriteVertex2(l_data, vertex, i);
+        bufferData(bufferType(t), l_data);
+    }
+    
+    public void bufferData2(
+        Buffer_type_0 t,
+        List_1<Vertex_1<jmercury.mmath__vector__vector2.Vector_0>> data){
+        final int length = jmercury.saffron.ListLength(data);
+        double[] l_data = new double[length * 4];
+        int i = 0;
+        for(int n = 0; n < length; n++){
+            i = jmercury.saffron.WriteVertex2(l_data, list.det_head(data), i);
+            data = list.det_tail(data);
+        }
+        bufferData(bufferType(t), l_data);
+    }
+    
+    public void bufferData3(
+        Buffer_type_0 t,
+        Vertex_1<jmercury.mmath__vector__vector3.Vector_0>[] data){
+        double[] l_data = new double[data.length * 5];
+        int i = 0;
+        for(Vertex_1<jmercury.mmath__vector__vector3.Vector_0> vertex : data){
+            i = jmercury.saffron.WriteVertex3(l_data, vertex, i);
+        }
+        bufferData(bufferType(t), l_data);
+    }
+    
+    public void bufferData3(
+        Buffer_type_0 t,
+        List_1<Vertex_1<jmercury.mmath__vector__vector3.Vector_0>> data){
+        final int length = jmercury.saffron.ListLength(data);
+        double[] l_data = new double[length * 5];
+        int i = 0;
+        for(int n = 0; n < length; n++){
+            i = jmercury.saffron.WriteVertex3(l_data, list.det_head(data), i);
+            data = list.det_tail(data);
+        }
+        bufferData(bufferType(t), l_data);
+    }
+    
+    public void bindBuffer(int buffer, Buffer_type_0 t){
+        bindBuffer(buffer, bufferType(t));
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Implements a buffer context using core OpenGL functions.
+public static class GL20Context extends Context{
+    protected int bufferType(Buffer_type_0 t){
+        if(t.equals(BUFFER_TYPE_ARRAY_BUFFER))
+            return GL20.GL_ARRAY_BUFFER;
+        else if(t.equals(BUFFER_TYPE_ELEMENT_ARRAY_BUFFER))
+            return GL20.GL_ELEMENT_ARRAY_BUFFER;
+        else
+            throw new IllegalStateException(""Unknown buffer type"");
+    }
+    public int createBuffer(){
+        return GL20.glGenBuffers();
+    }
+    public void destroyBuffer(int buffer){
+        GL20.glDeleteBuffers(buffer);
+    }
+    protected void bindBuffer(int buffer, int t){
+        GL20.glBindBuffer(t, buffer);
+    }
+    protected void bufferData(int t, int[] data){
+        GL20.glBufferData(t, data, GL20.GL_STATIC_DRAW);
+    }
+    protected void bufferData(int t, double[] data){
+        GL20.glBufferData(t, data, GL20.GL_STATIC_DRAW);
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Implements a buffer context using GL_ARB_vertex_buffer_object
+public static class ARBContext extends Context{
+    protected int bufferType(Buffer_type_0 t){
+        if(t.equals(BUFFER_TYPE_ARRAY_BUFFER))
+            return ARBVertexBufferObject.GL_ARRAY_BUFFER_ARB;
+        else if(t.equals(BUFFER_TYPE_ELEMENT_ARRAY_BUFFER))
+            return ARBVertexBufferObject.GL_ELEMENT_ARRAY_BUFFER_ARB;
+        else
+            throw new IllegalStateException(""Unknown buffer type"");
+    }
+    public int createBuffer(){
+        return ARBVertexBufferObject.glGenBuffersARB();
+    }
+    public void destroyBuffer(int buffer){
+        ARBVertexBufferObject.glDeleteBuffersARB(buffer);
+    }
+    protected void bindBuffer(int buffer, int t){
+        ARBVertexBufferObject.glBindBufferARB(t, buffer);
+    }
+    protected void bufferData(int t, int[] data){
+        ARBVertexBufferObject.glBufferDataARB(t, data, ARBVertexBufferObject.GL_STATIC_DRAW_ARB);
+    }
+    protected void bufferData(int t, double[] data){
+        ARBVertexBufferObject.glBufferDataARB(t, data, ARBVertexBufferObject.GL_STATIC_DRAW_ARB);
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Creates a shader context, using OpenGL capabilities to determine
+///
+/// if a GL2.0 or an ARB context is appropriate.
+/// May return null if no context can be created.
+public static Context CreateContext(){
+    final GLCapabilities caps = GL.getCapabilities();
+    if(caps.OpenGL20){
+        return new GL20Context();
+    }
+    else if(caps.GL_ARB_vertex_buffer_object){
+        return new ARBContext();
+    }
+    else{
+        return null;
+    }
+}
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", buffer_ctx, "SAFFRON_GL_BUFFER_CTX").
+:- pragma foreign_type("Java", buffer_ctx, "jmercury.saffron__gl__buffer.Context").
 
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", buffer, "GLuint").
+:- pragma foreign_type("Java", buffer, "int").
 
 %-----------------------------------------------------------------------------%
 
@@ -157,6 +379,12 @@ create_buffer_ctx_error(E) = maybe.error(E).
 
 %-----------------------------------------------------------------------------%
 
+:- pragma foreign_code("Java", "
+final public static Maybe_error_2<Context, String> create_context_error = 
+    new Maybe_error_2.Error_1(
+        ""Buffers require OpenGL 2.0 or GL_ARB_vertex_buffer_objects"");
+    ").
+
 :- pred create_buffer_ctx_internal(
     gl_load_func_ctx,
     maybe.maybe_error(buffer_ctx),
@@ -181,6 +409,18 @@ create_buffer_ctx_error(E) = maybe.error(E).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    create_buffer_ctx_internal(Ctx::in, MaybeBufferCtx::out, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    final jmercury.saffron__gl__buffer.Context ctx =
+        jmercury.saffron__gl__buffer.CreateContext();
+    MaybeBufferCtx = (ctx == null) ?
+        jmercury.saffron__gl__buffer.create_context_error :
+        new jmercury.maybe.Maybe_error_2.Ok_1(ctx);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
@@ -201,6 +441,14 @@ create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    create_buffer(Ctx::in, Buffer::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Buffer = Ctx.createBuffer();
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -213,6 +461,14 @@ create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    destroy_buffer(Ctx::in, Buffer::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.destroyBuffer(Buffer);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- instance saffron.destroy(buffer_ctx, buffer) where [
@@ -230,6 +486,14 @@ create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    bind_buffer(Ctx::in, Buffer::in, Type::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bindBuffer(Buffer, Type);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -263,6 +527,14 @@ create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    buffer_data_float_array(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferData(Type, T);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -297,6 +569,14 @@ create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    buffer_data_int_array(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferData(Type, T);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 % TODO: This should work, and is optimal when we have unboxed floats, but
 % we should eventually implement a better C version for when we have boxed
@@ -304,11 +584,31 @@ create_buffer_ctx(Ctx, MaybeBufferCtx, !IO) :-
 buffer_data_float_list(Ctx, Type, List, !IO) :-
     buffer_data_float_array(Ctx, Type, array.from_list(List), !IO).
 
+% Java will always have boxed/Object-ified values in lists.
+% Convert from that to a primitive array in one go.
+:- pragma foreign_proc("Java",
+    buffer_data_float_list(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferDataD(Type, T);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 % As integers are always unboxed, this actually is optimal.
 buffer_data_int_list(Ctx, Type, List, !IO) :-
     buffer_data_int_array(Ctx, Type, array.from_list(List), !IO).
 
+% Java will always have boxed/Object-ified values in lists.
+% Convert from that to a primitive array in one go.
+:- pragma foreign_proc("Java",
+    buffer_data_int_list(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferDataI(Type, T);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -337,6 +637,14 @@ buffer_data_int_list(Ctx, Type, List, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    buffer_data_vertex2d_array(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferData2(Type, (Vertex_1[])T);
+    IOo = IOi;
+    ").
+
 :- pragma foreign_proc("C",
     buffer_data_vertex2d_list(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
     [may_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
@@ -369,6 +677,14 @@ buffer_data_int_list(Ctx, Type, List, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    buffer_data_vertex2d_list(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferData2(Type, T);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -400,6 +716,14 @@ buffer_data_int_list(Ctx, Type, List, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    buffer_data_vertex3d_array(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferData3(Type, (Vertex_1[])T);
+    IOo = IOi;
+    ").
+
 :- pragma foreign_proc("C",
     buffer_data_vertex3d_list(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
     [may_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
@@ -432,3 +756,11 @@ buffer_data_int_list(Ctx, Type, List, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    buffer_data_vertex3d_list(Ctx::in, Type::in, T::in, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bufferData3(Type, T);
+    IOo = IOi;
+    ").
+

--- a/saffron.gl.m
+++ b/saffron.gl.m
@@ -221,6 +221,39 @@ typedef char SaffronGLchar;
 
 ").
 
+% Imports for the Java grade.
+:- pragma foreign_decl("Java", "
+import org.lwjgl.opengl.GL;
+import org.lwjgl.opengl.GL11; // Base constants
+import org.lwjgl.opengl.GL20;
+import java.nio.ByteBuffer;
+import jmercury.maybe.Maybe_1; // Used in MaybeInteger.
+    ").
+
+:- pragma foreign_code("Java", "
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Shorthand to create a maybe(int).
+public static Maybe_1<Integer> MaybeInteger(int i, boolean b){
+    return b ? new Maybe_1.Yes_1(new Integer(i)) : new Maybe_1.No_0();
+}
+
+public static jmercury.maybe.Maybe_1<Integer> MaybeInteger(int i){
+    return MaybeInteger(i, i >= 0);
+}
+public static ByteBuffer BufferFromBitmap(
+    int w,
+    int h,
+    jmercury.runtime.MercuryBitmap bmp){
+    if(w * h * 4 < bmp.elements.length)
+        throw new IndexOutOfBoundsException(""Bitmap is too small"");
+    final ByteBuffer buffer = ByteBuffer.allocateDirect(w * h * 4);
+    buffer.put(bmp.elements, 0, w * h * 4);
+    buffer.rewind();
+    buffer.mark();
+    return buffer;
+}
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_enum("C", data_type/0, [
@@ -230,6 +263,26 @@ typedef char SaffronGLchar;
     short           - "GL_UNSIGNED_SHORT"
 ]).
 
+:- pragma foreign_export_enum(
+    "Java",
+    data_type/0,
+    [prefix("DATA_TYPE_")|[uppercase|[]]]).
+
+:- pragma foreign_code("Java", "
+public static int DataTypeToGL(Data_type_0 t){
+    if(t.equals(DATA_TYPE_INT))
+        return org.lwjgl.opengl.GL11.GL_INT;
+    else if(t.equals(DATA_TYPE_FLOAT))
+        return org.lwjgl.opengl.GL11.GL_DOUBLE;
+    else if(t.equals(DATA_TYPE_BYTE))
+        return org.lwjgl.opengl.GL11.GL_UNSIGNED_BYTE;
+    else if(t.equals(DATA_TYPE_SHORT))
+        return org.lwjgl.opengl.GL11.GL_UNSIGNED_SHORT;
+    else
+        throw new IllegalStateException(""Unknown data type"");
+}
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_enum("C", primitive_type/0, [
@@ -239,9 +292,30 @@ typedef char SaffronGLchar;
     triangle_fan    - "GL_TRIANGLE_FAN"
 ]).
 
+:- pragma foreign_export_enum(
+    "Java",
+    primitive_type/0,
+    [prefix("PRIMITIVE_TYPE_")|[uppercase|[]]]).
+
+:- pragma foreign_code("Java", "
+public static int PrimitiveTypeToGL(Primitive_type_0 t){
+    if(t.equals(PRIMITIVE_TYPE_LINE_STRIP))
+        return org.lwjgl.opengl.GL11.GL_LINE_STRIP;
+    if(t.equals(PRIMITIVE_TYPE_LINE_LOOP))
+        return org.lwjgl.opengl.GL11.GL_LINE_LOOP;
+    if(t.equals(PRIMITIVE_TYPE_TRIANGLE_STRIP))
+        return org.lwjgl.opengl.GL11.GL_TRIANGLE_STRIP;
+    if(t.equals(PRIMITIVE_TYPE_TRIANGLE_FAN))
+        return org.lwjgl.opengl.GL11.GL_TRIANGLE_FAN;
+    else
+        throw new IllegalStateException(""Unknown primitive type"");
+}
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", texture, "GLuint").
+:- pragma foreign_type("Java", texture, "int").
 
 %-----------------------------------------------------------------------------%
 
@@ -256,6 +330,7 @@ primitive_type(saffron.geometry.triangle_fan, saffron.gl.triangle_fan).
 :- mode supports_extension_inner(in, uo, di, uo) is det.
 
 supports_extension_inner(_, bool.no, !IO).
+
 :- pragma foreign_proc("C",
     supports_extension_inner(Ext::in, Supports::uo, IOi::di, IOo::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
@@ -306,6 +381,13 @@ float_bytes = 8.
     glGenTextures(1, &Tex);
     ").
 
+:- pragma foreign_proc("Java", create_texture(Tex::out, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    Tex = org.lwjgl.opengl.GL11.glGenTextures();
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred tex_parameters(io.io::di, io.io::uo) is det.
@@ -319,6 +401,14 @@ float_bytes = 8.
     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
     ").
 
+:- pragma foreign_proc("Java", tex_parameters(IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    org.lwjgl.opengl.GL11.glTexParameteri(org.lwjgl.opengl.GL11.GL_TEXTURE_2D, org.lwjgl.opengl.GL11.GL_TEXTURE_MIN_FILTER, org.lwjgl.opengl.GL11.GL_NEAREST);
+    org.lwjgl.opengl.GL11.glTexParameteri(org.lwjgl.opengl.GL11.GL_TEXTURE_2D, org.lwjgl.opengl.GL11.GL_TEXTURE_MAG_FILTER, org.lwjgl.opengl.GL11.GL_NEAREST);
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C", bind_texture(Tex::in, IOi::di, IOo::uo),
@@ -329,6 +419,13 @@ float_bytes = 8.
     glBindTexture(GL_TEXTURE_2D, Tex);
     ").
 
+:- pragma foreign_proc("Java", bind_texture(Tex::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    org.lwjgl.opengl.GL11.glBindTexture(org.lwjgl.opengl.GL11.GL_TEXTURE_2D, Tex);
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred tex_image(int::in, int::in, io.io::di, io.io::uo) is det.
@@ -342,6 +439,22 @@ float_bytes = 8.
         GL_TEXTURE_2D, 0, GL_RGBA, W, H, 0, GL_RGBA, GL_UNSIGNED_BYTE, NULL);
     ").
 
+:- pragma foreign_proc("Java", tex_image(W::in, H::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    org.lwjgl.opengl.GL11.nglTexImage2D(
+        org.lwjgl.opengl.GL11.GL_TEXTURE_2D,
+        0,
+        org.lwjgl.opengl.GL11.GL_RGBA,
+        W,
+        H,
+        0,
+        org.lwjgl.opengl.GL11.GL_RGBA,
+        org.lwjgl.opengl.GL11.GL_UNSIGNED_BYTE,
+        0);
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred tex_image(bitmap.bitmap, int, int, io.io, io.io).
@@ -357,12 +470,30 @@ float_bytes = 8.
         GL_TEXTURE_2D, 0, GL_RGBA, W, H, 0, GL_RGBA, GL_UNSIGNED_BYTE, B->elements);
     ").
 
+:- pragma foreign_proc("Java", tex_image(B::in, W::in, H::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+    "
+    final java.nio.ByteBuffer buffer = jmercury.saffron__gl.BufferFromBitmap(W, H, B);
+    org.lwjgl.opengl.GL11.glTexImage2D(
+        org.lwjgl.opengl.GL11.GL_TEXTURE_2D,
+        0,
+        org.lwjgl.opengl.GL11.GL_RGBA,
+        W,
+        H,
+        0,
+        org.lwjgl.opengl.GL11.GL_RGBA,
+        org.lwjgl.opengl.GL11.GL_UNSIGNED_BYTE,
+        buffer);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred tex_sub_image(bitmap.bitmap, int, int, int, int, io.io, io.io).
 :- mode tex_sub_image(in, in, in, in, in, di, uo) is det.
 
-:- pragma foreign_proc("C", tex_sub_image(B::in, X::in, Y::in, W::in, H::in, IOi::di, IOo::uo),
+:- pragma foreign_proc("C",
+    tex_sub_image(B::in, X::in, Y::in, W::in, H::in, IOi::di, IOo::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
     may_duplicate, does_not_affect_liveness],
     "
@@ -372,6 +503,24 @@ float_bytes = 8.
         GL_TEXTURE_2D, 0, X, Y, W, H, GL_RGBA, GL_UNSIGNED_BYTE, B->elements);
     ").
 
+:- pragma foreign_proc("Java",
+    tex_sub_image(B::in, X::in, Y::in, W::in, H::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+    "
+    final java.nio.ByteBuffer buffer = jmercury.saffron__gl.BufferFromBitmap(W, H, B);
+    org.lwjgl.opengl.GL11.glTexImage2D(
+        org.lwjgl.opengl.GL11.GL_TEXTURE_2D,
+        0,
+        X,
+        Y,
+        W,
+        H,
+        org.lwjgl.opengl.GL11.GL_RGBA,
+        org.lwjgl.opengl.GL11.GL_UNSIGNED_BYTE,
+        buffer);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred destroy_texture(texture::in, io.io::di, io.io::uo) is det.
@@ -384,6 +533,13 @@ float_bytes = 8.
     glDeleteTextures(1, &Tex);
     ").
 
+:- pragma foreign_proc("Java", destroy_texture(Tex::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    org.lwjgl.opengl.GL11.glDeleteTextures(Tex);
+    ").
+
 %-----------------------------------------------------------------------------%
 
 destroy_texture(_Ctx, Tex, !IO) :-
@@ -510,6 +666,8 @@ gl_supports_extension(gl_load_func_ctx(Ctx), Ext, Supports, !IO) :-
 :- pred version_string(version_type, string, io.io, io.io).
 :- mode version_string(in, out, di, uo) is det.
 
+version_string(_, "0.0", !IO).
+
 :- pragma foreign_proc("C",
     version_string(Type::in, Str::out, IOi::di, IOo::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
@@ -532,9 +690,21 @@ gl_supports_extension(gl_load_func_ctx(Ctx), Ext, Supports, !IO) :-
 
 %-----------------------------------------------------------------------------%
 
+:- pred opengl_version_string(string::uo, io.io::di, io.io::uo) is det.
+opengl_version_string(Str, !IO) :-
+    version_string(gl, Str, !IO).
+
+:- pragma foreign_proc("Java",
+    opengl_version_string(Str::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    Str = org.lwjgl.opengl.GL11.glGetString(org.lwjgl.opengl.GL11.GL_VERSION);
+    ").
+
 opengl_version_string(Ctx, Str, !IO) :-
     saffron.make_current(Ctx, !IO),
-    version_string(gl, Str, !IO).
+    opengl_version_string(Str, !IO).
 
 %-----------------------------------------------------------------------------%
 
@@ -543,9 +713,22 @@ opengl_version(Ctx, saffron.parse_sem_ver(Version), !IO) :-
 
 %-----------------------------------------------------------------------------%
 
+:- pred shader_model_version_string(string::uo, io.io::di, io.io::uo) is det.
+shader_model_version_string(Str, !IO) :-
+    version_string(glsl, Str, !IO).
+
+:- pragma foreign_proc("Java",
+    shader_model_version_string(Str::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    IOo = IOi;
+    Str = org.lwjgl.opengl.GL20.glGetString(
+        org.lwjgl.opengl.GL20.GL_SHADING_LANGUAGE_VERSION);
+    ").
+
 shader_model_version_string(Ctx, Str, !IO) :-
     saffron.make_current(Ctx, !IO),
-    version_string(glsl, Str, !IO).
+    shader_model_version_string(Str, !IO).
 
 %-----------------------------------------------------------------------------%
 

--- a/saffron.gl.shader.m
+++ b/saffron.gl.shader.m
@@ -287,6 +287,310 @@
 
 :- pragma foreign_import_module("C", saffron.gl).
 
+% Imports for the Java grade.
+:- pragma foreign_decl("Java", "
+import org.lwjgl.opengl.ARBShaderObjects;
+import org.lwjgl.opengl.ARBFragmentShader;
+import org.lwjgl.opengl.ARBVertexShader;
+import org.lwjgl.opengl.GLCapabilities;
+import org.lwjgl.opengl.GL;
+import org.lwjgl.opengl.GL11; // Base constants
+import org.lwjgl.opengl.GL20;
+import org.lwjgl.opengl.GL32; // Geometry shaders
+import org.lwjgl.opengl.GLCapabilities;
+import jmercury.maybe.Maybe_error_2;
+    ").
+
+:- pragma foreign_export_enum(
+    "Java",
+    shader_type/0,
+    [prefix("SHADER_TYPE_")|[uppercase|[]]]).
+
+:- pragma foreign_code("Java", "
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Base class for a Shader context.
+///
+/// This is a base class so that we can have either a context of sufficient
+/// version to have shaders, or use ARB extensions to implement shaders.
+public static abstract class Context{
+    public final boolean supports_geometry_shaders;
+    protected Context(boolean l_supports_geometry_shaders){
+        supports_geometry_shaders = l_supports_geometry_shaders;
+    }
+    public abstract int createProgram();
+    public int createShader(Shader_type_0 type){
+        if(type.equals(SHADER_TYPE_FRAGMENT)){
+            return createFragmentShader();
+        }
+        else if(type.equals(SHADER_TYPE_VERTEX)){
+            return createVertexShader();
+        }
+        else if(type.equals(SHADER_TYPE_GEOMETRY)){
+            if(supports_geometry_shaders)
+                return createGeometryShader();
+            // Otherwise, fallthrough below to be unsupported rather than
+            // unknown shader type.
+        }
+        else{
+            throw new IllegalStateException(""Unknown shader type"");
+        }
+        throw new UnsupportedOperationException(""Unsupported shader type"");
+    }
+    protected abstract int createFragmentShader();
+    protected abstract int createVertexShader();
+    protected int createGeometryShader(){
+        throw new UnsupportedOperationException(
+            ""Cannot create geometry shaders"");
+    }
+    public abstract void deleteShader(int shader);
+    public abstract void deleteProgram(int program);
+    public abstract void useProgram(int program);
+    public abstract void shaderSource(int shader, String src);
+    public abstract void compileShader(int shader);
+    public abstract void linkProgram(int program);
+    public abstract void attachShader(int program, int shader);
+    public abstract boolean shaderCompileStatus(int shader);
+    public abstract boolean programLinkStatus(int program);
+    public abstract String shaderInfoLog(int shader);
+    public abstract String programInfoLog(int program);
+    public abstract int getUniformLocation(int program, String name);
+    public abstract void uniform(int location, float f1);
+    public abstract void uniform(int location, float f1, float f2);
+    public abstract void uniform(int location, float f1, float f2, float f3);
+    public abstract void uniform(int location, float f1, float f2, float f3, float f4);
+    public abstract void uniformMat3x3(int location, float[] matrix);
+    public abstract void uniformMat4x4(int location, float[] matrix);
+    public abstract void bindAttribLocation(int program, int loc, String name);
+    public abstract int getAttribLocation(int program, String name);
+    public void vertexAttribPointer(int attrib, int n, jmercury.saffron__gl.Data_type_0 t, int stride, long ptr){
+        final int type = jmercury.saffron__gl.DataTypeToGL(t);
+        vertexAttribPointer(attrib, n, type, stride, ptr);
+    }
+    public abstract void vertexAttribPointer(int attrib, int n, int type, int stride, long ptr);
+    public void uniform(int location, double f1){
+        uniform(location, (float)f1);
+    }
+    public void uniform(int location, double f1, double f2){
+        uniform(location, (float)f1, (float)f2);
+    }
+    public void uniform(int location, double f1, double f2, double f3){
+        uniform(location, (float)f1, (float)f2, (float)f3);
+    }
+    public void uniform(int location, double f1, double f2, double f3, double f4){
+        uniform(location, (float)f1, (float)f2, (float)f3, (float)f4);
+    }
+    public void uniform(int location, Double f1){
+        uniform(location, f1.floatValue());
+    }
+    public void uniform(int location, Double f1, Double f2){
+        uniform(location, f1.floatValue(), f2.floatValue());
+    }
+    public void uniform(int location, Double f1, Double f2, Double f3){
+        uniform(location, f1.floatValue(), f2.floatValue(), f3.floatValue());
+    }
+    public void uniform(int location, Double f1, Double f2, Double f3, Double f4){
+        uniform(location, f1.floatValue(), f2.floatValue(), f3.floatValue(), f4.floatValue());
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+/// Shader context that uses OpenGL core features.
+private static class GL20Context extends Context{
+    public GL20Context(){
+        this(GL.getCapabilities());
+    }
+    public GL20Context(GLCapabilities caps){
+        super(caps.OpenGL32);
+    }
+    public int createProgram(){
+        return GL20.glCreateProgram();
+    }
+    protected int createFragmentShader(){
+        return GL20.glCreateShader(GL20.GL_FRAGMENT_SHADER);
+    }
+    protected int createVertexShader(){
+        return GL20.glCreateShader(GL20.GL_VERTEX_SHADER);
+    }
+    protected int createGeometryShader(){
+        return GL32.glCreateShader(GL32.GL_FRAGMENT_SHADER);
+    }
+    public void deleteShader(int shader){
+        GL20.glDeleteShader(shader);
+    }
+    public void deleteProgram(int program){
+        GL20.glDeleteProgram(program);
+    }
+    public void useProgram(int program){
+        GL20.glUseProgram(program);
+    }
+    public void shaderSource(int shader, String src){
+        GL20.glShaderSource(shader, src);
+    }
+    public void compileShader(int shader){
+        GL20.glCompileShader(shader);
+    }
+    public void linkProgram(int program){
+        GL20.glLinkProgram(program);
+    }
+    public void attachShader(int program, int shader){
+        GL20.glAttachShader(program, shader);
+    }
+    public boolean shaderCompileStatus(int shader){
+        final int status = GL20.glGetShaderi(shader, GL20.GL_COMPILE_STATUS);
+        return status == GL20.GL_TRUE;
+    }
+    public boolean programLinkStatus(int program){
+        final int status = GL20.glGetProgrami(program, GL20.GL_LINK_STATUS);
+        return status == GL20.GL_TRUE;
+    }
+    public String shaderInfoLog(int shader){
+        return GL20.glGetShaderInfoLog(shader);
+    }
+    public String programInfoLog(int program){
+        return GL20.glGetProgramInfoLog(program);
+    }
+    public int getUniformLocation(int program, String name){
+        return GL20.glGetUniformLocation(program, name);
+    }
+    public void uniform(int location, float f1){
+        GL20.glUniform1f(location, f1);
+    }
+    public void uniform(int location, float f1, float f2){
+        GL20.glUniform2f(location, f1, f2);
+    }
+    public void uniform(int location, float f1, float f2, float f3){
+        GL20.glUniform3f(location, f1, f2, f3);
+    }
+    public void uniform(int location, float f1, float f2, float f3, float f4){
+        GL20.glUniform4f(location, f1, f2, f3, f4);
+    }
+    public void uniformMat3x3(int location, float[] matrix){
+        GL20.glUniformMatrix3fv(location, false, matrix);
+    }
+    public void uniformMat4x4(int location, float[] matrix){
+        GL20.glUniformMatrix4fv(location, false, matrix);
+    }
+    public void bindAttribLocation(int program, int loc, String name){
+        GL20.glBindAttribLocation(program, loc, name);
+    }
+    public int getAttribLocation(int program, String name){
+        return GL20.glGetAttribLocation(program, name);
+    }
+    public void vertexAttribPointer(int attrib, int n, int type, int stride, long ptr){
+        GL20.nglVertexAttribPointer(attrib, n, type, false, stride, ptr);
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// A shader context that uses ARB extensions.
+private static class ARBContext extends Context{
+    public ARBContext(){
+        super(false);
+    }
+    public int createProgram(){
+        return ARBShaderObjects.glCreateProgramObjectARB();
+    }
+    protected int createFragmentShader(){
+        return ARBShaderObjects.glCreateShaderObjectARB(
+            ARBFragmentShader.GL_FRAGMENT_SHADER_ARB);
+    }
+    protected int createVertexShader(){
+        return ARBShaderObjects.glCreateShaderObjectARB(
+            ARBVertexShader.GL_VERTEX_SHADER_ARB);
+    }
+    public void deleteShader(int shader){
+        ARBShaderObjects.glDeleteObjectARB(shader);
+    }
+    public void deleteProgram(int program){
+        ARBShaderObjects.glDeleteObjectARB(program);
+    }
+    public void useProgram(int program){
+        ARBShaderObjects.glUseProgramObjectARB(program);
+    }
+    public void shaderSource(int shader, String src){
+        ARBShaderObjects.glShaderSourceARB(shader, src);
+    }
+    public void compileShader(int shader){
+        ARBShaderObjects.glCompileShaderARB(shader);
+    }
+    public void linkProgram(int program){
+        ARBShaderObjects.glLinkProgramARB(program);
+    }
+    public void attachShader(int program, int shader){
+        ARBShaderObjects.glAttachObjectARB(program, shader);
+    }
+    public boolean shaderCompileStatus(int shader){
+        final int status = ARBShaderObjects.glGetObjectParameteriARB(
+            shader,
+            ARBShaderObjects.GL_OBJECT_COMPILE_STATUS_ARB);
+        return status == GL11.GL_TRUE;
+    }
+    public boolean programLinkStatus(int program){
+        final int status = ARBShaderObjects.glGetObjectParameteriARB(
+            program,
+            ARBShaderObjects.GL_OBJECT_LINK_STATUS_ARB);
+        return status == GL11.GL_TRUE;
+    }
+    public String shaderInfoLog(int shader){
+        return ARBShaderObjects.glGetInfoLogARB(shader);
+    }
+    public String programInfoLog(int program){
+        return ARBShaderObjects.glGetInfoLogARB(program);
+    }
+    public int getUniformLocation(int program, String name){
+        return ARBShaderObjects.glGetUniformLocationARB(program, name);
+    }
+    public void uniform(int location, float f1){
+        ARBShaderObjects.glUniform1fARB(location, f1);
+    }
+    public void uniform(int location, float f1, float f2){
+        ARBShaderObjects.glUniform2fARB(location, f1, f2);
+    }
+    public void uniform(int location, float f1, float f2, float f3){
+        ARBShaderObjects.glUniform3fARB(location, f1, f2, f3);
+    }
+    public void uniform(int location, float f1, float f2, float f3, float f4){
+        ARBShaderObjects.glUniform4fARB(location, f1, f2, f3, f4);
+    }
+    public void uniformMat3x3(int location, float[] matrix){
+        ARBShaderObjects.glUniformMatrix3fvARB(location, false, matrix);
+    }
+    public void uniformMat4x4(int location, float[] matrix){
+        ARBShaderObjects.glUniformMatrix4fvARB(location, false, matrix);
+    }
+    public void bindAttribLocation(int program, int loc, String name){
+        ARBVertexShader.glBindAttribLocationARB(program, loc, name);
+    }
+    public int getAttribLocation(int program, String name){
+        return ARBVertexShader.glGetAttribLocationARB(program, name);
+    }
+    public void vertexAttribPointer(int attrib, int n, int type, int stride, long ptr){
+        ARBVertexShader.nglVertexAttribPointerARB(attrib, n, type, false, stride, ptr);
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+/// \brief Creates a shader context, using OpenGL capabilities to determine
+///
+/// if a GL2.0 or an ARB context is appropriate.
+/// May return null if no context can be created.
+public static Context CreateContext(){
+    final GLCapabilities caps = GL.getCapabilities();
+    if(caps.OpenGL20){
+        return new GL20Context();
+    }
+    else if(caps.GL_ARB_shader_objects &&
+        caps.GL_ARB_fragment_shader &&
+        caps.GL_ARB_vertex_shader){
+        
+        return new ARBContext();
+    }
+    else{
+        return null;
+    }
+}
+    ").
+
 % Define the native prototypes to handle shaders.
 :- pragma foreign_decl("C", "
 #include ""saffron.gl.shader.inc""
@@ -368,25 +672,32 @@ struct SaffronGL_ShaderCtx{
     geometry    - "GL_GEOMETRY_SHADER"
 ]).
 
+:- pragma foreign_export_enum("Java", shader_type/0).
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", shader_ctx, "struct SaffronGL_ShaderCtx*").
+:- pragma foreign_type("Java", shader_ctx, "jmercury.saffron__gl__shader.Context").
 
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", shader_program, "GLuint").
+:- pragma foreign_type("Java", shader_program, "int").
 
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", shader, "GLuint").
+:- pragma foreign_type("Java", shader, "int").
 
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", uniform, "GLuint").
+:- pragma foreign_type("Java", uniform, "int").
 
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_type("C", vertex_attrib, "GLuint").
+:- pragma foreign_type("Java", vertex_attrib, "int").
 
 %-----------------------------------------------------------------------------%
 
@@ -419,6 +730,12 @@ create_shader_ctx_error(E) = maybe.error(E).
 
 %-----------------------------------------------------------------------------%
 
+:- pragma foreign_code("Java", "
+final public static Maybe_error_2<Context, String> create_context_error = 
+    new Maybe_error_2.Error_1(""Shaders require OpenGL 2.0 or \
+GL_ARB_shader_objects, GL_ARB_vertex_shader, and GL_ARB_fragment_shader"");
+    ").
+
 :- pred create_shader_ctx_internal(
     gl_load_func_ctx,
     maybe.maybe_error(shader_ctx),
@@ -458,6 +775,19 @@ create_shader_ctx_error(E) = maybe.error(E).
     IOo = IOi;
     ").
 
+
+:- pragma foreign_proc("Java",
+    create_shader_ctx_internal(Ctx::in, MaybeShaderCtx::out, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    final jmercury.saffron__gl__shader.Context ctx =
+        jmercury.saffron__gl__shader.CreateContext();
+    MaybeShaderCtx = (ctx == null) ?
+        jmercury.saffron__gl__shader.create_context_error :
+        new jmercury.maybe.Maybe_error_2.Ok_1(ctx);
+    IOo = IOi;
+    ").
+
 create_shader_ctx(Ctx, MaybeShaderCtx, !IO) :-
     create_shader_ctx_internal('new gl_load_func_ctx'(Ctx), MaybeShaderCtx, !IO).
 
@@ -472,6 +802,14 @@ create_shader_ctx(Ctx, MaybeShaderCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    destroy_shader_program(Ctx::in, Program::in, IOi::di, IOo::uo),
+    [promise_pure, thread_safe, will_not_throw_exception, may_duplicate],
+    "
+    Ctx.deleteProgram(Program);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred create_program_inner(
@@ -484,8 +822,6 @@ create_shader_ctx(Ctx, MaybeShaderCtx, !IO) :-
     io.io, io.io).
 :- mode create_program_inner(in, in, in, uo, uo, uo, di, uo) is det.
 
-%-----------------------------------------------------------------------------%
-
 :- pragma foreign_proc("C",
     create_program_inner(Ctx::in, S2::in, S1::in, Prog::uo, OK::uo, Err::uo, IOi::di, IOo::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
@@ -506,6 +842,28 @@ create_shader_ctx(Ctx, MaybeShaderCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    create_program_inner(Ctx::in, S2::in, S1::in, Prog::uo, OK::uo, Err::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    Prog = Ctx.createProgram();
+    OK = jmercury.bool.NO;
+    Err = """";
+    if(Prog == 0){
+        Err = ""Error creating shader program"";
+    }
+    else{
+        Ctx.attachShader(Prog, S1);
+        Ctx.attachShader(Prog, S2);
+        Ctx.linkProgram(Prog);
+        if(Ctx.programLinkStatus(Prog))
+            OK = jmercury.bool.YES;
+        else
+            Err = Ctx.programInfoLog(Prog);
+    }
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred create_program_inner(
@@ -538,6 +896,31 @@ create_shader_ctx(Ctx, MaybeShaderCtx, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    create_program_inner(Ctx::in, Shaders::in, Prog::uo, OK::uo, Err::uo, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    Prog = Ctx.createProgram();
+    OK = jmercury.bool.NO;
+    Err = """";
+    if(Prog == 0){
+        Err = ""Error creating shader program"";
+        OK = jmercury.bool.NO;
+    }
+    else{
+        while(!jmercury.list.is_empty(Shaders)){
+            Ctx.attachShader(Prog, jmercury.list.det_head(Shaders));
+            Shaders = jmercury.list.det_tail(Shaders);
+        }
+        Ctx.linkProgram(Prog);
+        if(Ctx.programLinkStatus(Prog))
+            OK = jmercury.bool.YES;
+        else
+            Err = Ctx.programInfoLog(Prog);
+    }
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred create_program_inner_array(
@@ -573,6 +956,28 @@ create_program_inner_array(ShaderCtx, Shaders, Program, OK, Err, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    create_program_inner_array(Ctx::in, Shaders::in, Prog::uo, OK::uo, Err::uo, IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    Prog = Ctx.createProgram();
+    OK = jmercury.bool.NO;
+    Err = """";
+    if(Prog == 0){
+        Err = ""Error creating shader program"";
+    }
+    else{
+        for(int shader : Shaders)
+            Ctx.attachShader(Prog, shader);
+        Ctx.linkProgram(Prog);
+        if(Ctx.programLinkStatus(Prog))
+            OK = jmercury.bool.YES;
+        else
+            Err = Ctx.programInfoLog(Prog);
+    }
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 create_program(ShaderCtx, S1, S2, MaybeProgram, !IO) :-
@@ -621,15 +1026,26 @@ create_program_array(ShaderCtx, Shaders, MaybeProgram, !IO) :-
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
     may_duplicate, does_not_affect_liveness],
     " Prog = 0; ").
+
+:- pragma foreign_proc("Java", no_shader_program = (Prog::out),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    " Prog = 0; ").
 :- pragma inline(no_shader_program/0).
 
 %-----------------------------------------------------------------------------%
 
-:- pragma foreign_proc("C", use_program(Ctx::in, Program::in, IOi::di, IOo::uo),
+:- pragma foreign_proc("C", use_program(Ctx::in, Prog::in, IOi::di, IOo::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
     tabled_for_io, may_duplicate, does_not_affect_liveness],
     "
-    SAFFRON_GL_SHADERCORE_FUNC(Ctx->core, UseProgram)(Program);
+    SAFFRON_GL_SHADERCORE_FUNC(Ctx->core, UseProgram)(Prog);
+    IOo = IOi;
+    ").
+
+:- pragma foreign_proc("Java", use_program(Ctx::in, Prog::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.useProgram(Prog);
     IOo = IOi;
     ").
 :- pragma inline(use_program/4).
@@ -644,6 +1060,14 @@ create_program_array(ShaderCtx, Shaders, MaybeProgram, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    destroy_shader(Ctx::in, Shader::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.deleteShader(Shader);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred create_shader(
@@ -678,6 +1102,24 @@ create_program_array(ShaderCtx, Shaders, MaybeProgram, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    create_shader(Ctx::in, Type::in, Src::in, Shader::uo, OK::uo, Err::out, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Shader = Ctx.createShader(Type);
+    Ctx.shaderSource(Shader, Src);
+    Ctx.compileShader(Shader);
+    if(Ctx.shaderCompileStatus(Shader)){
+        OK = jmercury.bool.NO;
+        Err = """";
+    }
+    else{
+        OK = jmercury.bool.YES;
+        Err = Ctx.shaderInfoLog(Shader);
+    }
+    IOo = IOi;
+    ").
+
 create_shader(Ctx, Type, Src, MaybeShader, !IO) :-
     create_shader(Ctx, Type, Src, Shader, OK, Err, !IO),
     (
@@ -730,6 +1172,15 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    get_uniform_location(Ctx::in, Prog::in, Name::in, MaybeUniform::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    int i = Ctx.getUniformLocation(Prog, Name);
+    MaybeUniform = jmercury.saffron__gl.MaybeInteger(i);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -741,6 +1192,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform(Ctx::in, U::in, F1::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, F1);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -752,6 +1211,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform(Ctx::in, U::in, F1::in, F2::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, F1, F2);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -763,6 +1230,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform(Ctx::in, U::in, F1::in, F2::in, F3::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, F1, F2, F3);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -774,6 +1249,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform(Ctx::in, U::in, F1::in, F2::in, F3::in, F4::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, F1, F2, F3, F4);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -792,6 +1275,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform1(Ctx::in, U::in, FV::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, FV[0]);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -811,6 +1302,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform2(Ctx::in, U::in, FV::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, FV[0], FV[1]);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -831,6 +1330,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform3(Ctx::in, U::in, FV::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, FV[0], FV[1], FV[2]);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -852,6 +1359,14 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform4(Ctx::in, U::in, FV::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.uniform(U, FV[0], FV[1], FV[2], FV[4]);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -877,6 +1392,23 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform(Ctx::in, U::in,
+        A1::in, A2::in, A3::in,
+        B1::in, B2::in, B3::in,
+        C1::in, C2::in, C3::in,
+        IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    float[] matrix = {
+        (float)A1, (float)A2, (float)A3,
+        (float)B1, (float)B2, (float)B3,
+        (float)C1, (float)C2, (float)C3
+    };
+    Ctx.uniformMat3x3(U, matrix);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -897,6 +1429,17 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform3x3(Ctx::in, U::in, FV::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    float[] matrix = new float[9];
+    for(int i = 0; i < 9; i++)
+        matrix[i] = (float)FV[i];
+    Ctx.uniformMat3x3(U, matrix);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -930,6 +1473,25 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform(Ctx::in, U::in,
+        A1::in, A2::in, A3::in, A4::in,
+        B1::in, B2::in, B3::in, B4::in,
+        C1::in, C2::in, C3::in, C4::in,
+        D1::in, D2::in, D3::in, D4::in,
+        IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    float[] matrix = {
+        (float)A1, (float)A2, (float)A3, (float)A4,
+        (float)B1, (float)B2, (float)B3, (float)B4,
+        (float)C1, (float)C2, (float)C3, (float)C4,
+        (float)D1, (float)D2, (float)D3, (float)D4
+    };
+    Ctx.uniformMat4x4(U, matrix);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -950,6 +1512,16 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    uniform4x4(Ctx::in, U::in, FV::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    float[] matrix = new float[16];
+    for(int i = 0; i < 16; i++)
+        matrix[i] = (float)FV[i];
+    Ctx.uniformMat4x4(U, matrix);
+    IOo = IOi;
+    ").
 
 %-----------------------------------------------------------------------------%
 
@@ -966,6 +1538,15 @@ maybe_uniform_yes(Uniform) = maybe.yes(Uniform).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    bind_attrib_location(Ctx::in, Program::in, Name::in, I::in, Attrib::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.bindAttribLocation(Program, I, Name);
+    Attrib = I;
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- func maybe_vertex_attrib_no = (maybe.maybe(vertex_attrib)::uo) is det.
@@ -994,10 +1575,19 @@ maybe_vertex_attrib_yes(Attrib) = maybe.yes(Attrib).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    get_attrib_location(Ctx::in, Program::in, Name::in, MaybeAttrib::uo, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    int i = Ctx.getAttribLocation(Program, Name);
+    MaybeAttrib = jmercury.saffron__gl.MaybeInteger(i);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
-    vertex_attrib_pointer(Ctx::in, Attrib::in, Type::in, N::in, Stride::in, Offset::in, IOi::di, IOo::uo),
+    vertex_attrib_pointer(Ctx::in, Attrib::in, N::in, Type::in, Stride::in, Offset::in, IOi::di, IOo::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
     may_duplicate, does_not_affect_liveness],
     "
@@ -1011,3 +1601,11 @@ maybe_vertex_attrib_yes(Attrib) = maybe.yes(Attrib).
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    vertex_attrib_pointer(Ctx::in, Attrib::in, N::in, Type::in, Stride::in, Offset::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    Ctx.vertexAttribPointer(Attrib, N, Type, Stride, Offset);
+    IOo = IOi;
+    ").
+

--- a/saffron.gl2.m
+++ b/saffron.gl2.m
@@ -239,6 +239,12 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pragma foreign_decl("Java", "
+import org.lwjgl.opengl.GL11; // The name saffron.gl2 a lie, it's really 1.1
+    ").
+
+%-----------------------------------------------------------------------------%
+
 :- pragma foreign_decl("C", "
 // #define SAFFRON_GL2_DEBUG
 #ifdef SAFFRON_GL2_DEBUG
@@ -292,6 +298,10 @@ const char *Saffron_GL2_DebugError(void){
     saffron.draw.raise_matrix_stack_error,
     "Saffron_GL2_RaiseMatrixStackError").
 
+:- pragma foreign_export("Java",
+    saffron.draw.raise_matrix_stack_error,
+    "RaiseMatrixStackError").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_decl("C",
@@ -366,6 +376,26 @@ const char *Saffron_GL2_DebugError(void){
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    set_matrix(
+        V0::in,  V1::in,  V2::in,  V3::in,
+        V4::in,  V5::in,  V6::in,  V7::in,
+        V8::in,  V9::in,  V10::in, V11::in,
+        V12::in, V13::in, V14::in, V15::in,
+        IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+    may_duplicate],
+    "
+    double[] matrix = {
+        V0, V4, V8,V12,
+        V1, V5, V9,V13,
+        V2, V6,V10,V14,
+        V3, V7,V11,V15
+    };
+    org.lwjgl.opengl.GL11.glLoadMatrixd(matrix);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred transform `with_type` matrix_pred `with_inst` matrix_pred.
@@ -401,6 +431,26 @@ const char *Saffron_GL2_DebugError(void){
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    transform(
+        V0::in,  V1::in,  V2::in,  V3::in,
+        V4::in,  V5::in,  V6::in,  V7::in,
+        V8::in,  V9::in,  V10::in, V11::in,
+        V12::in, V13::in, V14::in, V15::in,
+        IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception,
+    may_duplicate],
+    "
+    double[] matrix = {
+        V0, V4, V8,V12,
+        V1, V5, V9,V13,
+        V2, V6,V10,V14,
+        V3, V7,V11,V15
+    };
+    org.lwjgl.opengl.GL11.glMultMatrixd(matrix);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred transform(mmath.matrix.matrix::in, io.io::di, io.io::uo) is det.
@@ -430,6 +480,13 @@ transform(Matrix, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", identity(IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glLoadIdentity();
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred push_matrix(io.io::di, io.io::uo) is det.
@@ -442,6 +499,13 @@ transform(Matrix, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", push_matrix(IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glPushMatrix();
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred pop_matrix(io.io::di, io.io::uo) is det.
@@ -455,6 +519,15 @@ transform(Matrix, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", pop_matrix(IOi::di, IOo::uo),
+    [may_call_mercury, promise_pure, thread_safe, may_duplicate],
+    "
+    org.lwjgl.opengl.GL11.glPopMatrix();
+    if(GL11.glGetError() == org.lwjgl.opengl.GL11.GL_STACK_UNDERFLOW)
+        RaiseMatrixStackError();
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- instance saffron.draw.basic_transform(context(Ctx))
@@ -761,6 +834,13 @@ generate_attrib_tree(Ctx, Shader, !:Tree, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", vertex(X::in, Y::in, Z::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glVertex3d(X, Y, Z);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred tex_coord(float::in, float::in, io.io::di, io.io::uo) is det.
@@ -774,6 +854,13 @@ generate_attrib_tree(Ctx, Shader, !:Tree, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", tex_coord(U::in, V::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glTexCoord2d(U, V);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred tex_coord_i(int::in, int::in, io.io::di, io.io::uo) is det.
@@ -787,6 +874,13 @@ generate_attrib_tree(Ctx, Shader, !:Tree, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", tex_coord_i(U::in, V::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glTexCoord2i(U, V);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred color(int::in, int::in, int::in, int::in, io.io::di, io.io::uo) is det.
@@ -800,6 +894,14 @@ generate_attrib_tree(Ctx, Shader, !:Tree, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java",
+    color(R::in, G::in, B::in, A::in, IOi::di, IOo::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glColor4ub((byte)R, (byte)G, (byte)B, (byte)A);
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred color(color::in, io.io::di, io.io::uo) is det.
@@ -849,6 +951,13 @@ draw_vertex3d(saffron.geometry.vertex(vector(X, Y, Z), U, V), C, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", begin(Type::in, IOi::di, IOo::uo),
+    [promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glBegin(jmercury.saffron__gl.PrimitiveTypeToGL(Type));
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred end(io.io::di, io.io::uo) is det.
@@ -862,6 +971,13 @@ draw_vertex3d(saffron.geometry.vertex(vector(X, Y, Z), U, V), C, !IO) :-
     IOo = IOi;
     ").
 
+:- pragma foreign_proc("Java", end(IOi::di, IOo::uo),
+    [promise_pure, thread_safe, will_not_throw_exception],
+    "
+    org.lwjgl.opengl.GL11.glEnd();
+    IOo = IOi;
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- pred draw_shape2d(shape(mmath.vector.vector2)::in, io.io::di, io.io::uo) is det.
@@ -980,6 +1096,24 @@ draw_shape3d(Shape, !IO) :-
     */
     ").
 
+:- pragma foreign_proc("Java", init(IOi::di, IOo::uo),
+    [promise_pure, thread_safe, will_not_throw_exception, no_sharing],
+    "
+    IOo = IOi;
+    GL11.glEnable(GL11.GL_BLEND);
+    GL11.glBlendFunc(GL11.GL_SRC_ALPHA, org.lwjgl.opengl.GL11.GL_ONE_MINUS_SRC_ALPHA);
+    GL11.glClearColor(0.0f, 0.0f, 0.0f, 1.0f);
+    GL11.glColor4d(1.0, 1.0, 1.0, 1.0);
+    GL11.glLineWidth(2.0f); // This is legacy for the Z2 engine (editor for Java)
+    GL11.glEnable(GL11.GL_TEXTURE_2D);
+    GL11.glEnable(GL11.GL_DEPTH_TEST);
+    GL11.glLoadIdentity();
+    GL11.glMatrixMode(GL11.GL_PROJECTION);
+    GL11.glLoadIdentity();
+    GL11.glMatrixMode(GL11.GL_MODELVIEW);
+    GL11.glLoadIdentity();
+    ").
+
 %-----------------------------------------------------------------------------%
 
 :- func complete_load_ctx(string, maybe.maybe_error(T)) = maybe.maybe(T).

--- a/saffron.m
+++ b/saffron.m
@@ -140,6 +140,50 @@
 :- use_module string.
 
 %-----------------------------------------------------------------------------%
+% Utilities used by Java code.
+:- pragma foreign_decl("Java", "
+import jmercury.list.List_1;
+import jmercury.saffron__geometry.Vertex_1;
+    ").
+
+:- pragma foreign_code("Java", "
+public static int ListLength(List_1<?> l){
+    int i = 0;
+    while(!jmercury.list.is_empty(l)){
+        i++;
+        l = jmercury.list.det_tail(l);
+    }
+    return i;
+}
+public static int WriteVector(double[] to, jmercury.mmath__vector__vector2.Vector_0 vector, int i){
+    to[i++] = vector.x;
+    to[i++] = vector.y;
+    return i;
+}
+public static int WriteVector(double[] to, jmercury.mmath__vector__vector3.Vector_0 vector, int i){
+    to[i++] = vector.x;
+    to[i++] = vector.y;
+    to[i++] = vector.z;
+    return i;
+}
+public static int WriteVertexUV(double[] to, Vertex_1<?> vertex, int i){
+    to[i++] = vertex.u;
+    to[i++] = vertex.v;
+    return i;
+}
+public static int WriteVertex2(double[] to, Vertex_1<jmercury.mmath__vector__vector2.Vector_0> vertex, int i){
+    i = WriteVector(to, vertex.vec, i);
+    i = WriteVertexUV(to, vertex, i);
+    return i;
+}
+public static int WriteVertex3(double[] to, Vertex_1<jmercury.mmath__vector__vector3.Vector_0> vertex, int i){
+    i = WriteVector(to, vertex.vec, i);
+    i = WriteVertexUV(to, vertex, i);
+    return i;
+}
+    ").
+
+%-----------------------------------------------------------------------------%
 
 default_load_function(_, _, maybe.error("load_function not supported"), !IO).