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