extra/gpu/buffers/buffers.factor

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