basis/opengl/shaders/shaders.factor

   1 ! Copyright (C) 2008 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel opengl.gl alien.c-types continuations namespaces
   4 assocs alien alien.strings libc opengl math sequences combinators
   5 macros arrays io.encodings.ascii fry specialized-arrays.uint
   6 destructors accessors ;
   7 IN: opengl.shaders
   8
   9 : with-gl-shader-source-ptr ( string quot -- )
  10     swap ascii malloc-string [ <void*> swap call ] keep free ; inline
  11
  12 : <gl-shader> ( source kind -- shader )
  13     glCreateShader dup rot
  14     [ 1 swap f glShaderSource ] with-gl-shader-source-ptr
  15     [ glCompileShader ] keep
  16     gl-error ;
  17
  18 : (gl-shader?) ( object -- ? )
  19     dup integer? [ glIsShader c-bool> ] [ drop f ] if ;
  20
  21 : gl-shader-get-int ( shader enum -- value )
  22     0 <int> [ glGetShaderiv ] keep *int ;
  23
  24 : gl-shader-ok? ( shader -- ? )
  25     GL_COMPILE_STATUS gl-shader-get-int c-bool> ;
  26
  27 : <vertex-shader> ( source -- vertex-shader )
  28     GL_VERTEX_SHADER <gl-shader> ; inline
  29
  30 : (vertex-shader?) ( object -- ? )
  31     dup (gl-shader?)
  32     [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ]
  33     [ drop f ] if ;
  34
  35 : <fragment-shader> ( source -- fragment-shader )
  36     GL_FRAGMENT_SHADER <gl-shader> ; inline
  37
  38 : (fragment-shader?) ( object -- ? )
  39     dup (gl-shader?)
  40     [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ]
  41     [ drop f ] if ;
  42
  43 : gl-shader-info-log-length ( shader -- log-length )
  44     GL_INFO_LOG_LENGTH gl-shader-get-int ; inline
  45
  46 : gl-shader-info-log ( shader -- log )
  47     dup gl-shader-info-log-length dup [
  48         1 calloc &free
  49         [ 0 <int> swap glGetShaderInfoLog ] keep
  50         ascii alien>string
  51     ] with-destructors ;
  52
  53 : check-gl-shader ( shader -- shader )
  54     dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
  55
  56 : delete-gl-shader ( shader -- ) glDeleteShader ; inline
  57
  58 PREDICATE: gl-shader < integer (gl-shader?) ;
  59 PREDICATE: vertex-shader < gl-shader (vertex-shader?) ;
  60 PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
  61
  62 ! Programs
  63
  64 : <gl-program> ( shaders -- program )
  65     glCreateProgram swap
  66     [ dupd glAttachShader ] each
  67     [ glLinkProgram ] keep
  68     gl-error ;
  69
  70 : (gl-program?) ( object -- ? )
  71     dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
  72
  73 : gl-program-get-int ( program enum -- value )
  74     0 <int> [ glGetProgramiv ] keep *int ;
  75
  76 : gl-program-ok? ( program -- ? )
  77     GL_LINK_STATUS gl-program-get-int c-bool> ;
  78
  79 : gl-program-info-log-length ( program -- log-length )
  80     GL_INFO_LOG_LENGTH gl-program-get-int ; inline
  81
  82 : gl-program-info-log ( program -- log )
  83     dup gl-program-info-log-length dup [
  84         1 calloc &free
  85         [ 0 <int> swap glGetProgramInfoLog ] keep
  86         ascii alien>string
  87     ] with-destructors ;
  88
  89 : check-gl-program ( program -- program )
  90     dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
  91
  92 : gl-program-shaders-length ( program -- shaders-length )
  93     GL_ATTACHED_SHADERS gl-program-get-int ; inline
  94
  95 ! On some macosx-x86-64 graphics drivers, glGetAttachedShaders tries to treat the
  96 ! shaders parameter as a ulonglong array rather than a GLuint array as documented.
  97 ! We hack around this by allocating a buffer twice the size and sifting out the zero
  98 ! values
  99
 100 : gl-program-shaders ( program -- shaders )
 101     dup gl-program-shaders-length 2 *
 102     0 <int>
 103     over <uint-array>
 104     [ glGetAttachedShaders ] keep [ zero? not ] filter ;
 105
 106 : delete-gl-program-only ( program -- )
 107     glDeleteProgram ; inline
 108
 109 : detach-gl-program-shader ( program shader -- )
 110     glDetachShader ; inline
 111
 112 : delete-gl-program ( program -- )
 113     dup gl-program-shaders [
 114         2dup detach-gl-program-shader delete-gl-shader
 115     ] each delete-gl-program-only ;
 116
 117 : with-gl-program ( program quot -- )
 118     over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
 119
 120 PREDICATE: gl-program < integer (gl-program?) ;
 121
 122 : <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
 123     [ <vertex-shader> check-gl-shader ]
 124     [ <fragment-shader> check-gl-shader ] bi*
 125     2array <gl-program> check-gl-program ;
 126