unmaintained/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 combinators.lib macros arrays io.encodings.ascii fry ;
   6 IN: opengl.shaders
   7
   8 : with-gl-shader-source-ptr ( string quot -- )
   9     swap ascii malloc-string [ <void*> swap call ] keep free ; inline
  10
  11 : <gl-shader> ( source kind -- shader )
  12     glCreateShader dup rot
  13     [ 1 swap f glShaderSource ] with-gl-shader-source-ptr
  14     [ glCompileShader ] keep
  15     gl-error ;
  16
  17 : (gl-shader?) ( object -- ? )
  18     dup integer? [ glIsShader c-bool> ] [ drop f ] if ;
  19
  20 : gl-shader-get-int ( shader enum -- value )
  21     0 <int> [ glGetShaderiv ] keep *int ;
  22
  23 : gl-shader-ok? ( shader -- ? )
  24     GL_COMPILE_STATUS gl-shader-get-int c-bool> ;
  25
  26 : <vertex-shader> ( source -- vertex-shader )
  27     GL_VERTEX_SHADER <gl-shader> ; inline
  28
  29 : (vertex-shader?) ( object -- ? )
  30     dup (gl-shader?)
  31     [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ]
  32     [ drop f ] if ;
  33
  34 : <fragment-shader> ( source -- fragment-shader )
  35     GL_FRAGMENT_SHADER <gl-shader> ; inline
  36
  37 : (fragment-shader?) ( object -- ? )
  38     dup (gl-shader?)
  39     [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ]
  40     [ drop f ] if ;
  41
  42 : gl-shader-info-log-length ( shader -- log-length )
  43     GL_INFO_LOG_LENGTH gl-shader-get-int ; inline
  44
  45 : gl-shader-info-log ( shader -- log )
  46     dup gl-shader-info-log-length dup [
  47         1 calloc &free
  48         [ 0 <int> swap glGetShaderInfoLog ] keep
  49         ascii alien>string
  50     ] with-destructors ;
  51
  52 : check-gl-shader ( shader -- shader )
  53     dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ;
  54
  55 : delete-gl-shader ( shader -- ) glDeleteShader ; inline
  56
  57 PREDICATE: gl-shader < integer (gl-shader?) ;
  58 PREDICATE: vertex-shader < gl-shader (vertex-shader?) ;
  59 PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
  60
  61 ! Programs
  62
  63 : <gl-program> ( shaders -- program )
  64     glCreateProgram swap
  65     [ dupd glAttachShader ] each
  66     [ glLinkProgram ] keep
  67     gl-error ;
  68
  69 : (gl-program?) ( object -- ? )
  70     dup integer? [ glIsProgram c-bool> ] [ drop f ] if ;
  71
  72 : gl-program-get-int ( program enum -- value )
  73     0 <int> [ glGetProgramiv ] keep *int ;
  74
  75 : gl-program-ok? ( program -- ? )
  76     GL_LINK_STATUS gl-program-get-int c-bool> ;
  77
  78 : gl-program-info-log-length ( program -- log-length )
  79     GL_INFO_LOG_LENGTH gl-program-get-int ; inline
  80
  81 : gl-program-info-log ( program -- log )
  82     dup gl-program-info-log-length dup [
  83         1 calloc &free
  84         [ 0 <int> swap glGetProgramInfoLog ] keep
  85         ascii alien>string
  86     ] with-destructors ;
  87
  88 : check-gl-program ( program -- program )
  89     dup gl-program-ok? [ dup gl-program-info-log throw ] unless ;
  90
  91 : gl-program-shaders-length ( program -- shaders-length )
  92     GL_ATTACHED_SHADERS gl-program-get-int ; inline
  93
  94 : gl-program-shaders ( program -- shaders )
  95     dup gl-program-shaders-length
  96     dup <uint-array>
  97     0 <int> swap
  98     [ underlying>> glGetAttachedShaders ] { 3 1 } multikeep ;
  99
 100 : delete-gl-program-only ( program -- )
 101     glDeleteProgram ; inline
 102
 103 : detach-gl-program-shader ( program shader -- )
 104     glDetachShader ; inline
 105
 106 : delete-gl-program ( program -- )
 107     dup gl-program-shaders [
 108         2dup detach-gl-program-shader delete-gl-shader
 109     ] each delete-gl-program-only ;
 110
 111 : with-gl-program ( program quot -- )
 112     over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
 113
 114 PREDICATE: gl-program < integer (gl-program?) ;
 115
 116 : <simple-gl-program> ( vertex-shader-source fragment-shader-source -- program )
 117     >r <vertex-shader> check-gl-shader
 118     r> <fragment-shader> check-gl-shader
 119     2array <gl-program> check-gl-program ;
 120