extra/gpu/buffers/buffers.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: accessors alien alien.c-types alien.data arrays byte-arrays
   3 combinators destructors gpu kernel locals math opengl opengl.gl
   4 typed ui.gadgets.worlds variants ;
   5 IN: gpu.buffers
   6
   7 VARIANT: buffer-upload-pattern
   8     stream-upload static-upload dynamic-upload ;
   9
  10 VARIANT: buffer-usage-pattern
  11     draw-usage read-usage copy-usage ;
  12
  13 VARIANT: buffer-access-mode
  14     read-access write-access read-write-access ;
  15
  16 VARIANT: buffer-kind
  17     vertex-buffer index-buffer
  18     pixel-unpack-buffer pixel-pack-buffer
  19     transform-feedback-buffer ;
  20
  21 TUPLE: buffer < gpu-object
  22     { upload-pattern buffer-upload-pattern }
  23     { usage-pattern buffer-usage-pattern }
  24     { kind buffer-kind } ;
  25
  26 <PRIVATE
  27
  28 : gl-buffer-usage ( buffer -- usage )
  29     [ upload-pattern>> ] [ usage-pattern>> ] bi 2array {
  30         { { stream-upload draw-usage } [ GL_STREAM_DRAW ] }
  31         { { stream-upload read-usage } [ GL_STREAM_READ ] }
  32         { { stream-upload copy-usage } [ GL_STREAM_COPY ] }
  33
  34         { { static-upload draw-usage } [ GL_STATIC_DRAW ] }
  35         { { static-upload read-usage } [ GL_STATIC_READ ] }
  36         { { static-upload copy-usage } [ GL_STATIC_COPY ] }
  37
  38         { { dynamic-upload draw-usage } [ GL_DYNAMIC_DRAW ] }
  39         { { dynamic-upload read-usage } [ GL_DYNAMIC_READ ] }
  40         { { dynamic-upload copy-usage } [ GL_DYNAMIC_COPY ] }
  41     } case ; inline
  42
  43 : gl-access ( access -- gl-access )
  44     {
  45         { read-access [ GL_READ_ONLY ] }
  46         { write-access [ GL_WRITE_ONLY ] }
  47         { read-write-access [ GL_READ_WRITE ] }
  48     } case ; inline
  49
  50 : gl-target ( kind -- target )
  51     {
  52         { vertex-buffer [ GL_ARRAY_BUFFER ] }
  53         { index-buffer [ GL_ELEMENT_ARRAY_BUFFER ] }
  54         { pixel-unpack-buffer [ GL_PIXEL_UNPACK_BUFFER ] }
  55         { pixel-pack-buffer [ GL_PIXEL_PACK_BUFFER ] }
  56         { transform-feedback-buffer [ GL_TRANSFORM_FEEDBACK_BUFFER ] }
  57     } case ; inline
  58
  59 : get-buffer-int ( target enum -- value )
  60     0 int <ref> [ glGetBufferParameteriv ] keep int deref ; inline
  61
  62 : bind-buffer ( buffer -- target )
  63     [ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ; inline
  64
  65 PRIVATE>
  66
  67 M: buffer dispose
  68     [ [ delete-gl-buffer ] when* f ] change-handle drop ;
  69
  70 TUPLE: buffer-ptr
  71     { buffer buffer read-only }
  72     { offset integer read-only } ;
  73 C: <buffer-ptr> buffer-ptr
  74
  75 TUPLE: buffer-range < buffer-ptr
  76     { size integer read-only } ;
  77 C: <buffer-range> buffer-range
  78
  79 UNION: gpu-data-ptr buffer-ptr c-ptr ;
  80
  81 TYPED: buffer-size ( buffer: buffer -- size: integer )
  82     bind-buffer GL_BUFFER_SIZE get-buffer-int ;
  83
  84 : buffer-ptr>range ( buffer-ptr -- buffer-range )
  85     [ buffer>> ] [ offset>> ] bi
  86     2dup [ buffer-size ] dip -
  87     buffer-range boa ; inline
  88
  89 :: allocate-buffer ( buffer size initial-data -- )
  90     buffer bind-buffer :> target
  91     target size initial-data buffer gl-buffer-usage glBufferData ; inline
  92
  93 : allocate-byte-array ( buffer byte-array -- )
  94     [ byte-length ] [ ] bi allocate-buffer ; inline
  95
  96 TYPED: <buffer> ( upload: buffer-upload-pattern
  97                   usage: buffer-usage-pattern
  98                   kind: buffer-kind
  99                   size: integer
 100                   initial-data
 101                   --
 102                   buffer: buffer )
 103     [ [ gen-gl-buffer ] 3dip buffer boa dup ] 2dip allocate-buffer
 104     window-resource ;
 105
 106 TYPED: byte-array>buffer ( byte-array
 107                            upload: buffer-upload-pattern
 108                            usage: buffer-usage-pattern
 109                            kind: buffer-kind
 110                            --
 111                            buffer: buffer )
 112     [ ] 3curry dip
 113     [ byte-length ] [ ] bi <buffer> ;
 114
 115 TYPED:: update-buffer ( buffer-ptr: buffer-ptr size: integer data -- )
 116     buffer-ptr buffer>> :> buffer
 117     buffer bind-buffer :> target
 118     target buffer-ptr offset>> size data glBufferSubData ;
 119
 120 TYPED:: read-buffer ( buffer-ptr: buffer-ptr size: integer -- data: byte-array )
 121     buffer-ptr buffer>> :> buffer
 122     buffer bind-buffer :> target
 123     size <byte-array> :> data
 124     target buffer-ptr offset>> size data glGetBufferSubData
 125     data ;
 126
 127 TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size: integer -- )
 128     GL_COPY_WRITE_BUFFER to-buffer-ptr buffer>> glBindBuffer
 129     GL_COPY_READ_BUFFER from-buffer-ptr buffer>> glBindBuffer
 130
 131     GL_COPY_READ_BUFFER GL_COPY_WRITE_BUFFER
 132     from-buffer-ptr offset>> to-buffer-ptr offset>>
 133     size glCopyBufferSubData ;
 134
 135 : (grow-buffer-size) ( target-size old-size -- new-size )
 136     [ 2dup > ] [ 2 * ] while nip ; inline
 137
 138 TYPED: grow-buffer ( buffer: buffer target-size: integer -- )
 139     over buffer-size 2dup >
 140     [ (grow-buffer-size) f allocate-buffer ] [ 3drop ] if ; inline
 141
 142 :: with-mapped-buffer ( ..a buffer access quot: ( ..a alien -- ..b ) -- ..b )
 143     buffer bind-buffer :> target
 144     target access gl-access glMapBuffer
 145
 146     quot call
 147
 148     target glUnmapBuffer drop ; inline
 149
 150 :: with-mapped-buffer-array ( ..a buffer access c-type quot: ( ..a array -- ..b ) -- ..b )
 151     buffer buffer-size c-type heap-size /i :> len
 152     buffer access [ len c-type <c-direct-array> quot call ] with-mapped-buffer ; inline
 153
 154 :: with-bound-buffer ( ..a buffer target quot: ( ..a -- ..b ) -- ..b )
 155     target gl-target buffer glBindBuffer
 156     quot call ; inline
 157
 158 : with-buffer-ptr ( ..a buffer-ptr target quot: ( ..a c-ptr -- ..b ) -- ..b )
 159     [ [ offset>> <alien> ] [ buffer>> handle>> ] bi ] 2dip
 160     with-bound-buffer ; inline
 161
 162 : with-gpu-data-ptr ( ..a gpu-data-ptr target quot: ( ..a c-ptr -- ..b ) -- ..b )
 163     pick buffer-ptr?
 164     [ with-buffer-ptr ]
 165     [ [ gl-target 0 glBindBuffer ] dip call ] if ; inline
 166