forked from alex-eg/sex
247 lines
8.0 KiB
Scheme
247 lines
8.0 KiB
Scheme
;;; A triangle that follows the mouse pointer, spins while the left
|
|
;;; mouse button is held down, and quits on Escape (or on closing the
|
|
;;; window).
|
|
;;;
|
|
;;; SDL3 supplies the window, the GL context and the events. Everything
|
|
;;; drawn goes through an OpenGL 3.3 core-profile pipeline: a vertex and
|
|
;;; fragment shader, and one VAO/VBO holding a unit triangle. Where the
|
|
;;; triangle is and how far it has spun are passed in as uniforms, so
|
|
;;; the geometry itself is uploaded once and never touched again.
|
|
;;;
|
|
;;; Build:
|
|
;;; ./sexc example/sdl3-triangle.sex -o sdl3-triangle -- `pkg-config --cflags --libs sdl3` -framework OpenGL
|
|
|
|
(define GL-SILENCE-DEPRECATION 1) ; OpenGL is deprecated on macOS
|
|
|
|
(include SDL3/SDL.h)
|
|
(include OpenGL/gl3.h)
|
|
|
|
(define WINDOW-WIDTH 800)
|
|
(define WINDOW-HEIGHT 600)
|
|
|
|
(define TRIANGLE-RADIUS 70.0) ; in window units
|
|
(define SPIN-SPEED 3.0) ; radians per second
|
|
|
|
;;; The vertex shader does the whole transform: spin the unit triangle
|
|
;;; by u_angle, scale it to u_radius, move it to u_center, then convert
|
|
;;; from window coordinates to clip space. That way a frame only has to
|
|
;;; push four uniforms rather than rebuild any geometry.
|
|
(var vertex-shader-src (* const char) "
|
|
#version 330 core
|
|
|
|
layout (location = 0) in vec2 a_pos;
|
|
layout (location = 1) in vec3 a_color;
|
|
|
|
uniform vec2 u_center; // triangle centre, in window units
|
|
uniform vec2 u_viewport; // window size, same units as u_center
|
|
uniform float u_angle; // current spin, in radians
|
|
uniform float u_radius; // triangle size, in window units
|
|
|
|
out vec3 v_color;
|
|
|
|
void main()
|
|
{
|
|
float s = sin(u_angle);
|
|
float c = cos(u_angle);
|
|
vec2 spun = vec2(a_pos.x * c - a_pos.y * s,
|
|
a_pos.x * s + a_pos.y * c);
|
|
vec2 p = spun * u_radius + u_center;
|
|
|
|
// Window coordinates have their origin top-left with y growing
|
|
// downwards; clip space is centred with y growing upwards.
|
|
gl_Position = vec4(p.x / u_viewport.x * 2.0 - 1.0,
|
|
1.0 - p.y / u_viewport.y * 2.0,
|
|
0.0,
|
|
1.0);
|
|
v_color = a_color;
|
|
}
|
|
")
|
|
|
|
(var fragment-shader-src (* const char) "
|
|
#version 330 core
|
|
|
|
in vec3 v_color;
|
|
out vec4 frag_color;
|
|
|
|
void main()
|
|
{
|
|
frag_color = vec4(v_color, 1.0);
|
|
}
|
|
")
|
|
|
|
(fn compile-shader ((kind GLenum) (src (* const char))) GLuint
|
|
(var shader GLuint (glCreateShader kind))
|
|
(glShaderSource shader 1 (& src) NULL)
|
|
(glCompileShader shader)
|
|
|
|
(var ok GLint 0)
|
|
(glGetShaderiv shader GL-COMPILE-STATUS (& ok))
|
|
(if (== ok 0)
|
|
(do
|
|
(var info [char 1024])
|
|
(glGetShaderInfoLog shader 1024 NULL info)
|
|
(SDL-Log "shader compilation failed: %s" info)
|
|
(glDeleteShader shader)
|
|
(return 0)))
|
|
(return shader))
|
|
|
|
(fn make-program () GLuint
|
|
(var vertex-shader GLuint (compile-shader GL-VERTEX-SHADER vertex-shader-src))
|
|
(var fragment-shader GLuint (compile-shader GL-FRAGMENT-SHADER fragment-shader-src))
|
|
(if (c-or (== vertex-shader 0) (== fragment-shader 0))
|
|
(do
|
|
(glDeleteShader vertex-shader)
|
|
(glDeleteShader fragment-shader)
|
|
(return 0)))
|
|
|
|
(var program GLuint (glCreateProgram))
|
|
(glAttachShader program vertex-shader)
|
|
(glAttachShader program fragment-shader)
|
|
(glLinkProgram program)
|
|
|
|
;; The shaders are only needed until the program is linked; the
|
|
;; program holds its own reference until then.
|
|
(glDeleteShader vertex-shader)
|
|
(glDeleteShader fragment-shader)
|
|
|
|
(var ok GLint 0)
|
|
(glGetProgramiv program GL-LINK-STATUS (& ok))
|
|
(if (== ok 0)
|
|
(do
|
|
(var info [char 1024])
|
|
(glGetProgramInfoLog program 1024 NULL info)
|
|
(SDL-Log "program linking failed: %s" info)
|
|
(glDeleteProgram program)
|
|
(return 0)))
|
|
(return program))
|
|
|
|
(pub fn main () int
|
|
(if (! (SDL-Init SDL-INIT-VIDEO))
|
|
(do
|
|
(SDL-Log "SDL_Init failed: %s" (SDL-GetError))
|
|
(return 1)))
|
|
|
|
;; Ask for core profile 3.3 before the window exists: these attributes
|
|
;; are read when the context is created.
|
|
(SDL-GL-SetAttribute SDL-GL-CONTEXT-MAJOR-VERSION 3)
|
|
(SDL-GL-SetAttribute SDL-GL-CONTEXT-MINOR-VERSION 3)
|
|
(SDL-GL-SetAttribute SDL-GL-CONTEXT-PROFILE-MASK SDL-GL-CONTEXT-PROFILE-CORE)
|
|
(SDL-GL-SetAttribute SDL-GL-DOUBLEBUFFER 1)
|
|
|
|
(var window (* SDL-Window)
|
|
(SDL-CreateWindow "Sex + SDL3 + OpenGL"
|
|
WINDOW-WIDTH WINDOW-HEIGHT
|
|
SDL-WINDOW-OPENGL))
|
|
(if (== window NULL)
|
|
(do
|
|
(SDL-Log "SDL_CreateWindow failed: %s" (SDL-GetError))
|
|
(SDL-Quit)
|
|
(return 1)))
|
|
|
|
(var gl-context SDL-GLContext (SDL-GL-CreateContext window))
|
|
(if (== gl-context NULL)
|
|
(do
|
|
(SDL-Log "SDL_GL_CreateContext failed: %s" (SDL-GetError))
|
|
(SDL-DestroyWindow window)
|
|
(SDL-Quit)
|
|
(return 1)))
|
|
|
|
(SDL-GL-MakeCurrent window gl-context)
|
|
(SDL-GL-SetSwapInterval 1)
|
|
|
|
(var program GLuint (make-program))
|
|
(if (== program 0)
|
|
(do
|
|
(SDL-GL-DestroyContext gl-context)
|
|
(SDL-DestroyWindow window)
|
|
(SDL-Quit)
|
|
(return 1)))
|
|
|
|
;; A unit triangle, two position components then three colour
|
|
;; components per vertex. The vertices sit on the unit circle at 90,
|
|
;; 210 and 330 degrees; the shader spins, scales and moves it.
|
|
(var verts [GLfloat 15]
|
|
#( 0.000 1.000 1.00 0.35 0.35
|
|
-0.866 -0.500 0.35 1.00 0.45
|
|
0.866 -0.500 0.40 0.50 1.00))
|
|
|
|
(var vao GLuint 0)
|
|
(var vbo GLuint 0)
|
|
(glGenVertexArrays 1 (& vao))
|
|
(glBindVertexArray vao)
|
|
(glGenBuffers 1 (& vbo))
|
|
(glBindBuffer GL-ARRAY-BUFFER vbo)
|
|
(glBufferData GL-ARRAY-BUFFER (sizeof verts) verts GL-STATIC-DRAW)
|
|
|
|
(var stride GLsizei (cast (* 5 (sizeof GLfloat)) GLsizei))
|
|
(glVertexAttribPointer 0 2 GL-FLOAT GL-FALSE stride (cast 0 (* void)))
|
|
(glEnableVertexAttribArray 0)
|
|
(glVertexAttribPointer 1 3 GL-FLOAT GL-FALSE stride
|
|
(cast (* 2 (sizeof GLfloat)) (* void)))
|
|
(glEnableVertexAttribArray 1)
|
|
|
|
(var u-center GLint (glGetUniformLocation program "u_center"))
|
|
(var u-viewport GLint (glGetUniformLocation program "u_viewport"))
|
|
(var u-angle GLint (glGetUniformLocation program "u_angle"))
|
|
(var u-radius GLint (glGetUniformLocation program "u_radius"))
|
|
|
|
(var running bool true)
|
|
(var angle float 0.0)
|
|
(var last-ticks Uint64 (SDL-GetTicks))
|
|
(var event SDL-Event)
|
|
|
|
(while running
|
|
(while (SDL-PollEvent (& event))
|
|
(switch (. event type)
|
|
(case SDL-EVENT-QUIT
|
|
(= running false))
|
|
(case SDL-EVENT-KEY-DOWN
|
|
(if (== (. event key key) SDLK-ESCAPE)
|
|
(= running false)))))
|
|
|
|
;; Seconds since the previous frame, so the spin rate does not
|
|
;; depend on how fast we happen to be rendering.
|
|
(var now Uint64 (SDL-GetTicks))
|
|
(var dt float (/ (cast (- now last-ticks) float) 1000.0))
|
|
(= last-ticks now)
|
|
|
|
(var mouse-x float 0.0)
|
|
(var mouse-y float 0.0)
|
|
(var buttons SDL-MouseButtonFlags (SDL-GetMouseState (& mouse-x) (& mouse-y)))
|
|
(if (!= 0 (& buttons SDL-BUTTON-LMASK))
|
|
(= angle (+ angle (* SPIN-SPEED dt))))
|
|
|
|
;; The viewport is in pixels, which is not the same as window units
|
|
;; on a HiDPI display; the mouse position is in window units, so the
|
|
;; shader needs that size rather than the pixel one.
|
|
(var pixel-width int 0)
|
|
(var pixel-height int 0)
|
|
(SDL-GetWindowSizeInPixels window (& pixel-width) (& pixel-height))
|
|
(glViewport 0 0 pixel-width pixel-height)
|
|
|
|
(var window-width int 0)
|
|
(var window-height int 0)
|
|
(SDL-GetWindowSize window (& window-width) (& window-height))
|
|
|
|
(glClearColor 0.06 0.06 0.09 1.0)
|
|
(glClear GL-COLOR-BUFFER-BIT)
|
|
|
|
(glUseProgram program)
|
|
(glUniform2f u-center mouse-x mouse-y)
|
|
(glUniform2f u-viewport (cast window-width float) (cast window-height float))
|
|
(glUniform1f u-angle angle)
|
|
(glUniform1f u-radius TRIANGLE-RADIUS)
|
|
|
|
(glBindVertexArray vao)
|
|
(glDrawArrays GL-TRIANGLES 0 3)
|
|
|
|
(SDL-GL-SwapWindow window))
|
|
|
|
(glDeleteVertexArrays 1 (& vao))
|
|
(glDeleteBuffers 1 (& vbo))
|
|
(glDeleteProgram program)
|
|
(SDL-GL-DestroyContext gl-context)
|
|
(SDL-DestroyWindow window)
|
|
(SDL-Quit)
|
|
(return 0))
|