triangle.factor

USING: accessors alien.c-types alien.data combinators kernel math
multiline opengl opengl.gl3 opengl.capabilities opengl.shaders
ui ui.gadgets.worlds ui.pixel-formats ;
QUALIFIED-WITH: alien.c-types c
IN: triangle

STRING: vertex-shader
#version 330 core
layout (location = 0) in vec3 position;
void main()
{
gl_Position = vec4(position.x, position.y, position.z, 1.0);
}
;

STRING: fragment-shader
#version 330 core
out vec4 color;
void main()
{
color = vec4(0.0f, 0.0f, 1.0f, 1.0f);
}
;

TUPLE: triangle-world < world
    program vertex-buffer vertex-array ;

: (program) ( -- program )
    vertex-shader fragment-shader <simple-gl-program> ;

: (vertex-buffer) ( -- vertex-buffer )
  {
    -0.5 -0.5 0.0 ! Left
     0.5 -0.5 0.0 ! Right
     0.0  0.5 0.0 ! Top
  }
  c:float >c-array underlying>>
  GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer> ;

: (vertex-array) ( vertex-buffer -- vertex-array )
    gen-vertex-array [
     [
     GL_ARRAY_BUFFER swap
       [
       0 3 GL_FLOAT GL_FALSE c:float heap-size 3 * 0 buffer-offset glVertexAttribPointer
       0 glEnableVertexAttribArray
       ] with-gl-buffer
    ] with-vertex-array ] keep ;

M: triangle-world begin-world
    "3.3" require-gl-version
    GL_DEPTH_TEST glEnable
    1.0 1.0 1.0 1.0 glClearColor
    (program) >>program
    (vertex-buffer) [ >>vertex-buffer ] keep
    (vertex-array) >>vertex-array
    drop ;

M: triangle-world end-world
    {
        [ program>> [ delete-gl-program ] when* ]
        [ vertex-buffer>> [ delete-gl-buffer ] when* ]
        [ vertex-array>> [ delete-vertex-array ] when* ]
    } cleave ;

M: triangle-world draw-world*
      GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
      dup
      vertex-array>>
        [
        program>>
           [
           GL_TRIANGLES 0 3 glDrawArrays drop
           ] with-gl-program
       ] with-vertex-array
;

MAIN-WINDOW: triangle-window {
        { world-class triangle-world }
        { title "Triangle" }
        { pixel-format-attributes {
            windowed
            double-buffered
            T{ depth-bits { value 16 } }
        } }
        { pref-dim { 640 480 } }
    } ;