glmain.sc.txt

#!/usr/bin/env scopes

define clibs
    load-library "libGL.so"
    load-library "libSDL2-2.0.so"
    import-c "clibs.h" "
        #include <stdint.h>
        #include <stdio.h>
        #include <SDL2/SDL.h>
        #include <SDL2/SDL_syswm.h>
        #include \"src/glad.c\"

        void SDL__VERSION (SDL_version *val) {
            SDL_VERSION(val);
        }

        int SDL__WINDOWPOS_CENTERED = SDL_WINDOWPOS_CENTERED;
        int SDL__WINDOWPOS_UNDEFINED = SDL_WINDOWPOS_UNDEFINED;

        FILE *get_stdout () {
            return stdout;
        }
        FILE *get_stderr () {
            return stderr;
        }
        "
        list 
            \ "-I" (compiler-dir .. "/clang/lib/clang/4.0.1/include")
            \ "-I" "."
            \ "-I" "./include"

using clibs filter "^(SDL(.+)|gl(.+)|GL(.+)|f?printf|fflush|get_std(.+))$"

define SDL_WINDOWPOS_CENTERED (@ SDL__WINDOWPOS_CENTERED)
define SDL_WINDOWPOS_UNDEFINED (@ SDL__WINDOWPOS_UNDEFINED)
define stdout get_stdout
define stderr get_stderr

fn sdl-ok (result)
    if (none? result)
        compiler-error! "int expected"
    assert (SDL_TRUE == result)

SDL_Init
    | SDL_INIT_AUDIO
        SDL_INIT_VIDEO
        SDL_INIT_GAMECONTROLLER
        #SDL_INIT_JOYSTICK

SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1

SDL_GL_SetAttribute SDL_GL_STENCIL_SIZE 8
SDL_GL_SetAttribute SDL_GL_DEPTH_SIZE 24

SDL_GL_SetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 4
SDL_GL_SetAttribute SDL_GL_CONTEXT_MINOR_VERSION 5
#if IS_OSX
    SDL_GL_SetAttribute
        SDL_GL_CONTEXT_PROFILE_MASK 
        SDL_GL_CONTEXT_PROFILE_CORE

let resizable = true

let window =
    SDL_CreateWindow "OpenGL"
        SDL_WINDOWPOS_UNDEFINED
        SDL_WINDOWPOS_UNDEFINED
        \ 640 480
        | SDL_WINDOW_OPENGL
            SDL_WINDOW_SHOWN
            ? resizable (u32 SDL_WINDOW_RESIZABLE) 0:u32

let context = (SDL_GL_CreateContext window)
SDL_GL_SetSwapInterval 1
SDL_GL_MakeCurrent window context

do
    let result = (gladLoadGL)
    assert (result != 0) "failed to load GL core functions"

fn print-gl-info ()
    fn print-info (sym)
        let idx ok = (@ clibs sym)
        assert ok sym
        let s = (glGetString idx)
        printf "%s: %s\n" (cast rawstring (Symbol->string sym)) s

    print-info 'GL_VENDOR
    print-info 'GL_RENDERER
    print-info 'GL_VERSION
    print-info 'GL_SHADING_LANGUAGE_VERSION

print-gl-info;

fn hook-gl-debug ()
    fn gl-debug-source (source)
        match source
            GL_DEBUG_SOURCE_API                "API"
            GL_DEBUG_SOURCE_WINDOW_SYSTEM      "Window System"
            GL_DEBUG_SOURCE_SHADER_COMPILER    "Shader Compiler"
            GL_DEBUG_SOURCE_THIRD_PARTY        "Third Party"
            GL_DEBUG_SOURCE_APPLICATION        "Application"
            GL_DEBUG_SOURCE_OTHER              "Other"        
            else                               "?"

    fn gl-debug-type (type_)
        match type_
            GL_DEBUG_TYPE_ERROR                "Error"
            GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR  "Deprecated"
            GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR   "Undefined Behavior"
            GL_DEBUG_TYPE_PORTABILITY          "Portability"
            GL_DEBUG_TYPE_PERFORMANCE          "Performance"
            GL_DEBUG_TYPE_OTHER                "Other"
            else                               "?"

    fn gl-debug-severity (severity)
        match severity
            GL_DEBUG_SEVERITY_HIGH             "High"
            GL_DEBUG_SEVERITY_MEDIUM           "Medium"
            GL_DEBUG_SEVERITY_LOW              "Low"
            GL_DEBUG_SEVERITY_NOTIFICATION     "Notification"
            else                               "?"

    fn gl-debug-callback (source type_ id_ severity length message userparams)
        #void <- (GLenum GLenum GLuint GLenum GLsizei GLchar* void*)
        fflush (stdout)
        fprintf (stderr) "%s:%s:%x:%s:%s\n"
            cast rawstring (gl-debug-source source)
            cast rawstring (gl-debug-type type_)
            id_ 
            cast rawstring (gl-debug-severity severity)
            message
        fflush (stderr)
        if (type_ == GL_DEBUG_TYPE_ERROR)
            abort!;
        return;

    glDebugMessageCallback gl-debug-callback null
    # turn off all notifications
    glDebugMessageControl GL_DONT_CARE GL_DONT_CARE
        \ GL_DEBUG_SEVERITY_NOTIFICATION 0 null GL_FALSE
    glEnable GL_DEBUG_OUTPUT
    
hook-gl-debug;

fn draw ()
    glViewport 0 0 640 480
    glClearColor 0.0 0.0 1.0 1.0
    glClear
        | GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT GL_STENCIL_BUFFER_BIT

fn swap ()
    glBindFramebuffer GL_FRAMEBUFFER 0
    SDL_GL_SwapWindow window

global quit = false
var event = (SDL_Event)
fn handle_events ()
    if ((SDL_PollEvent event) != 0)
        if (event.type == SDL_QUIT)
            quit = true
        handle_events;

fn mainloop ()
    if (not quit)
        handle_events;
        draw;
        swap;
        mainloop;

mainloop;

SDL_GL_DeleteContext context
SDL_DestroyWindow window

SDL_Quit;
print "done."