squeeze some TYPED: juice on gpu.*
Joe Groff
parent
3a90df83a6
commit
3bc72151a8
|
|
@ -1,7 +1,7 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors alien alien.c-types arrays byte-arrays
|
||||
combinators destructors gpu kernel locals math opengl opengl.gl
|
||||
ui.gadgets.worlds variants ;
|
||||
typed ui.gadgets.worlds variants ;
|
||||
IN: gpu.buffers
|
||||
|
||||
VARIANT: buffer-upload-pattern
|
||||
|
|
@ -57,10 +57,10 @@ TUPLE: buffer < gpu-object
|
|||
} case ; inline
|
||||
|
||||
: get-buffer-int ( target enum -- value )
|
||||
0 <int> [ glGetBufferParameteriv ] keep *int ;
|
||||
0 <int> [ glGetBufferParameteriv ] keep *int ; inline
|
||||
|
||||
: bind-buffer ( buffer -- target )
|
||||
[ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ;
|
||||
[ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -78,7 +78,7 @@ C: <buffer-range> buffer-range
|
|||
|
||||
UNION: gpu-data-ptr buffer-ptr c-ptr ;
|
||||
|
||||
: buffer-size ( buffer -- size )
|
||||
TYPED: buffer-size ( buffer: buffer -- size: integer )
|
||||
bind-buffer GL_BUFFER_SIZE get-buffer-int ;
|
||||
|
||||
: buffer-ptr>range ( buffer-ptr -- buffer-range )
|
||||
|
|
@ -86,31 +86,42 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
|
|||
2dup [ buffer-size ] dip -
|
||||
buffer-range boa ; inline
|
||||
|
||||
:: allocate-buffer ( buffer size initial-data -- )
|
||||
TYPED:: allocate-buffer ( buffer: buffer size: integer initial-data -- )
|
||||
buffer bind-buffer :> target
|
||||
target size initial-data buffer gl-buffer-usage glBufferData ;
|
||||
|
||||
: <buffer> ( upload usage kind size initial-data -- buffer )
|
||||
TYPED: <buffer> ( upload: buffer-upload-pattern
|
||||
usage: buffer-usage-pattern
|
||||
kind: buffer-kind
|
||||
size: integer
|
||||
initial-data
|
||||
--
|
||||
buffer: buffer )
|
||||
[ [ gen-gl-buffer ] 3dip buffer boa dup ] 2dip allocate-buffer
|
||||
window-resource ;
|
||||
|
||||
: byte-array>buffer ( byte-array upload usage kind -- buffer )
|
||||
TYPED: byte-array>buffer ( byte-array
|
||||
upload: buffer-upload-pattern
|
||||
usage: buffer-usage-pattern
|
||||
kind: buffer-kind
|
||||
--
|
||||
buffer: buffer )
|
||||
[ ] 3curry dip
|
||||
[ byte-length ] [ ] bi <buffer> ;
|
||||
|
||||
:: update-buffer ( buffer-ptr size data -- )
|
||||
TYPED:: update-buffer ( buffer-ptr: buffer-ptr size: integer data -- )
|
||||
buffer-ptr buffer>> :> buffer
|
||||
buffer bind-buffer :> target
|
||||
target buffer-ptr offset>> size data glBufferSubData ;
|
||||
|
||||
:: read-buffer ( buffer-ptr size -- data )
|
||||
TYPED:: read-buffer ( buffer-ptr: buffer-ptr size: integer -- data: byte-array )
|
||||
buffer-ptr buffer>> :> buffer
|
||||
buffer bind-buffer :> target
|
||||
size <byte-array> :> data
|
||||
target buffer-ptr offset>> size data glGetBufferSubData
|
||||
data ;
|
||||
|
||||
:: copy-buffer ( to-buffer-ptr from-buffer-ptr size -- )
|
||||
TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size: integer -- )
|
||||
GL_COPY_WRITE_BUFFER to-buffer-ptr buffer>> glBindBuffer
|
||||
GL_COPY_READ_BUFFER from-buffer-ptr buffer>> glBindBuffer
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ USING: accessors alien.c-types arrays byte-arrays combinators
|
|||
destructors gpu gpu.buffers gpu.private gpu.textures
|
||||
gpu.textures.private images kernel locals math math.rectangles opengl
|
||||
opengl.framebuffers opengl.gl opengl.textures sequences
|
||||
specialized-arrays ui.gadgets.worlds variants ;
|
||||
specialized-arrays typed ui.gadgets.worlds variants ;
|
||||
SPECIALIZED-ARRAY: int
|
||||
SPECIALIZED-ARRAY: uint
|
||||
IN: gpu.framebuffers
|
||||
|
|
@ -22,7 +22,7 @@ TUPLE: renderbuffer < gpu-object
|
|||
|
||||
PRIVATE>
|
||||
|
||||
:: allocate-renderbuffer ( renderbuffer dim -- )
|
||||
TYPED:: allocate-renderbuffer ( renderbuffer: renderbuffer dim -- )
|
||||
GL_RENDERBUFFER renderbuffer handle>> glBindRenderbuffer
|
||||
GL_RENDERBUFFER
|
||||
renderbuffer samples>> dup zero?
|
||||
|
|
@ -30,12 +30,17 @@ PRIVATE>
|
|||
[ renderbuffer texture-gl-internal-format dim first2 glRenderbufferStorageMultisample ]
|
||||
if ;
|
||||
|
||||
:: renderbuffer-dim ( renderbuffer -- dim )
|
||||
TYPED:: renderbuffer-dim ( renderbuffer: renderbuffer -- dim: array )
|
||||
GL_RENDERBUFFER renderbuffer handle>> glBindRenderbuffer
|
||||
GL_RENDERBUFFER_WIDTH get-framebuffer-int
|
||||
GL_RENDERBUFFER_HEIGHT get-framebuffer-int 2array ;
|
||||
|
||||
: <renderbuffer> ( component-order component-type samples dim -- renderbuffer )
|
||||
TYPED: <renderbuffer> ( component-order: component-order
|
||||
component-type: component-type
|
||||
samples
|
||||
dim
|
||||
--
|
||||
renderbuffer )
|
||||
[ [ gen-renderbuffer ] 3dip renderbuffer boa dup ] dip
|
||||
[ allocate-renderbuffer ] [ drop ] if*
|
||||
window-resource ;
|
||||
|
|
@ -121,7 +126,10 @@ TUPLE: framebuffer-rect
|
|||
|
||||
C: <framebuffer-rect> framebuffer-rect
|
||||
|
||||
: framebuffer-attachment-at ( framebuffer attachment-ref -- attachment )
|
||||
TYPED: framebuffer-attachment-at ( framebuffer: framebuffer
|
||||
attachment-ref: attachment-ref
|
||||
--
|
||||
attachment: framebuffer-attachment )
|
||||
{
|
||||
{ default-attachment [ color-attachments>> first ] }
|
||||
{ color-attachment [ swap color-attachments>> nth ] }
|
||||
|
|
@ -288,32 +296,42 @@ M: opengl-3 (clear-integer-color-attachment)
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: <full-framebuffer-rect> ( framebuffer attachment -- framebuffer-rect )
|
||||
TYPED: <full-framebuffer-rect> ( framebuffer: any-framebuffer
|
||||
attachment: attachment-ref
|
||||
--
|
||||
framebuffer-rect: framebuffer-rect )
|
||||
2dup framebuffer-attachment-at
|
||||
{ 0 0 } swap framebuffer-attachment-dim <rect>
|
||||
<framebuffer-rect> ;
|
||||
|
||||
: resize-framebuffer ( framebuffer dim -- )
|
||||
TYPED: resize-framebuffer ( framebuffer: framebuffer dim -- )
|
||||
[ allocate-framebuffer-attachment ] curry each-attachment ;
|
||||
|
||||
:: attach-framebuffer-attachments ( framebuffer -- )
|
||||
GL_DRAW_FRAMEBUFFER framebuffer handle>> glBindFramebuffer
|
||||
framebuffer [ bind-framebuffer-attachment ] each-attachment-target ;
|
||||
framebuffer [ bind-framebuffer-attachment ] each-attachment-target ; inline
|
||||
|
||||
M: framebuffer dispose
|
||||
[ [ delete-framebuffer ] when* f ] change-handle drop ;
|
||||
|
||||
: dispose-framebuffer-attachments ( framebuffer -- )
|
||||
TYPED: dispose-framebuffer-attachments ( framebuffer: framebuffer -- )
|
||||
[ [ dispose ] when* ] each-attachment ;
|
||||
|
||||
: <framebuffer> ( color-attachments depth-attachment stencil-attachment dim -- framebuffer )
|
||||
: <framebuffer> ( color-attachments
|
||||
depth-attachment: framebuffer-attachment
|
||||
stencil-attachment: framebuffer-attachment
|
||||
dim
|
||||
--
|
||||
framebuffer: framebuffer )
|
||||
[ [ 0 ] 3dip framebuffer boa dup ] dip
|
||||
[ resize-framebuffer ] [ drop ] if*
|
||||
gen-framebuffer >>handle
|
||||
dup attach-framebuffer-attachments
|
||||
window-resource ;
|
||||
|
||||
:: clear-framebuffer-attachment ( framebuffer attachment-ref value -- )
|
||||
TYPED:: clear-framebuffer-attachment ( framebuffer: any-framebuffer
|
||||
attachment-ref: attachment-ref
|
||||
value -- )
|
||||
GL_DRAW_FRAMEBUFFER framebuffer framebuffer-handle glBindFramebuffer
|
||||
attachment-ref {
|
||||
{ system-attachment [| side face |
|
||||
|
|
@ -335,9 +353,10 @@ M: framebuffer dispose
|
|||
} match ;
|
||||
|
||||
: clear-framebuffer ( framebuffer alist -- )
|
||||
[ first2 clear-framebuffer-attachment ] with each ;
|
||||
[ first2 clear-framebuffer-attachment ] with each ; inline
|
||||
|
||||
:: read-framebuffer-to ( framebuffer-rect gpu-data-ptr -- )
|
||||
TYPED:: read-framebuffer-to ( framebuffer-rect: framebuffer-rect
|
||||
gpu-data-ptr -- )
|
||||
GL_READ_FRAMEBUFFER framebuffer-rect framebuffer>> framebuffer-handle glBindFramebuffer
|
||||
framebuffer-rect [ framebuffer>> ] [ attachment>> ] bi gl-attachment glReadBuffer
|
||||
framebuffer-rect rect>> [ loc>> first2 ] [ dim>> first2 ] bi
|
||||
|
|
@ -345,9 +364,9 @@ M: framebuffer dispose
|
|||
gpu-data-ptr pixel-pack-buffer [ glReadPixels ] with-gpu-data-ptr ;
|
||||
|
||||
: read-framebuffer ( framebuffer-rect -- byte-array )
|
||||
dup framebuffer-rect-size <byte-array> [ read-framebuffer-to ] keep ;
|
||||
dup framebuffer-rect-size <byte-array> [ read-framebuffer-to ] keep ; inline
|
||||
|
||||
: read-framebuffer-image ( framebuffer-rect -- image )
|
||||
TYPED: read-framebuffer-image ( framebuffer-rect -- image )
|
||||
[ <image> ] dip {
|
||||
[ rect>> dim>> >>dim ]
|
||||
[
|
||||
|
|
@ -357,7 +376,9 @@ M: framebuffer dispose
|
|||
[ read-framebuffer >>bitmap ]
|
||||
} cleave ;
|
||||
|
||||
:: copy-framebuffer ( to-fb-rect from-fb-rect depth? stencil? filter -- )
|
||||
TYPED:: copy-framebuffer ( to-fb-rect: framebuffer-rect
|
||||
from-fb-rect: framebuffer-rect
|
||||
depth? stencil? filter: texture-filter -- )
|
||||
GL_DRAW_FRAMEBUFFER to-fb-rect framebuffer>> framebuffer-handle glBindFramebuffer
|
||||
to-fb-rect [ framebuffer>> ] [ attachment>> ] bi gl-attachment glDrawBuffer
|
||||
GL_READ_FRAMEBUFFER from-fb-rect framebuffer>> framebuffer-handle glBindFramebuffer
|
||||
|
|
|
|||
|
|
@ -120,7 +120,7 @@ ERROR: invalid-uniform-type uniform ;
|
|||
{ ubyte-indexes [ GL_UNSIGNED_BYTE ] }
|
||||
{ ushort-indexes [ GL_UNSIGNED_SHORT ] }
|
||||
{ uint-indexes [ GL_UNSIGNED_INT ] }
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
: gl-primitive-mode ( primitive-mode -- gl-primitive-mode )
|
||||
{
|
||||
|
|
@ -131,7 +131,7 @@ ERROR: invalid-uniform-type uniform ;
|
|||
{ triangles-mode [ GL_TRIANGLES ] }
|
||||
{ triangle-strip-mode [ GL_TRIANGLE_STRIP ] }
|
||||
{ triangle-fan-mode [ GL_TRIANGLE_FAN ] }
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
GENERIC: render-vertex-indexes ( primitive-mode vertex-indexes -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ literals locals math math.parser memoize multiline namespaces
|
|||
opengl opengl.gl opengl.shaders parser quotations sequences
|
||||
specialized-arrays splitting strings tr ui.gadgets.worlds
|
||||
variants vectors vocabs vocabs.loader vocabs.parser words
|
||||
words.constant half-floats ;
|
||||
words.constant half-floats typed ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
SPECIALIZED-ARRAY: int
|
||||
SPECIALIZED-ARRAY: void*
|
||||
|
|
@ -322,13 +322,17 @@ M: vertex-array dispose
|
|||
gen-vertex-array
|
||||
[ glBindVertexArray [ first2 bind-vertex-format ] with each ]
|
||||
[ -rot [ first buffer>> ] map vertex-array boa ] 3bi
|
||||
window-resource ;
|
||||
window-resource ; inline
|
||||
|
||||
: buffer>vertex-array ( vertex-buffer program-instance format -- vertex-array )
|
||||
TYPED: buffer>vertex-array ( vertex-buffer: buffer
|
||||
program-instance: program-instance
|
||||
format: vertex-format
|
||||
--
|
||||
vertex-array: vertex-array )
|
||||
[ swap ] dip
|
||||
[ 0 <buffer-ptr> ] dip 2array 1array <vertex-array> ; inline
|
||||
|
||||
: vertex-array-buffer ( vertex-array -- vertex-buffer )
|
||||
TYPED: vertex-array-buffer ( vertex-array: vertex-array -- vertex-buffer: buffer )
|
||||
vertex-buffers>> first ;
|
||||
|
||||
TUPLE: compile-shader-error shader log ;
|
||||
|
|
@ -406,7 +410,7 @@ DEFER: <shader-instance>
|
|||
|
||||
PRIVATE>
|
||||
|
||||
:: refresh-program ( program -- )
|
||||
TYPED:: refresh-program ( program: program -- )
|
||||
program shaders>> [ refresh-shader-source ] each
|
||||
program instances>> [| world old-instance |
|
||||
old-instance valid-handle? [
|
||||
|
|
@ -426,10 +430,10 @@ PRIVATE>
|
|||
] assoc-each
|
||||
reset-memos ;
|
||||
|
||||
: <shader-instance> ( shader -- instance )
|
||||
TYPED: <shader-instance> ( shader: shader -- instance: shader-instance )
|
||||
[ find-shader-instance dup world get ] keep instances>> set-at ;
|
||||
|
||||
: <program-instance> ( program -- instance )
|
||||
TYPED: <program-instance> ( program: program -- instance: program-instance )
|
||||
[ find-program-instance dup world get ] keep instances>> set-at ;
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors alien.c-types alien.data arrays byte-arrays
|
||||
combinators gpu kernel literals math math.rectangles opengl
|
||||
opengl.gl sequences variants specialized-arrays ;
|
||||
opengl.gl sequences typed variants specialized-arrays ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
FROM: math => float ;
|
||||
SPECIALIZED-ARRAY: int
|
||||
|
|
@ -439,15 +439,15 @@ M: mask-state set-gpu-state*
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: get-viewport-state ( -- viewport-state )
|
||||
TYPED: get-viewport-state ( -- viewport-state: viewport-state )
|
||||
GL_VIEWPORT get-gl-rect <viewport-state> ;
|
||||
|
||||
: get-scissor-state ( -- scissor-state )
|
||||
TYPED: get-scissor-state ( -- scissor-state: scissor-state )
|
||||
GL_SCISSOR_TEST get-gl-bool
|
||||
[ GL_SCISSOR_BOX get-gl-rect ] [ f ] if
|
||||
<scissor-state> ;
|
||||
|
||||
: get-multisample-state ( -- multisample-state )
|
||||
TYPED: get-multisample-state ( -- multisample-state: multisample-state )
|
||||
GL_MULTISAMPLE gl-enabled?
|
||||
GL_SAMPLE_ALPHA_TO_COVERAGE gl-enabled?
|
||||
GL_SAMPLE_ALPHA_TO_ONE gl-enabled?
|
||||
|
|
@ -457,7 +457,7 @@ PRIVATE>
|
|||
] [ f f ] if
|
||||
<multisample-state> ;
|
||||
|
||||
: get-stencil-state ( -- stencil-state )
|
||||
TYPED: get-stencil-state ( -- stencil-state: stencil-state )
|
||||
GL_STENCIL_TEST gl-enabled? [
|
||||
GL_STENCIL_REF get-gl-int
|
||||
GL_STENCIL_VALUE_MASK get-gl-int
|
||||
|
|
@ -477,15 +477,15 @@ PRIVATE>
|
|||
] [ f f ] if
|
||||
<stencil-state> ;
|
||||
|
||||
: get-depth-range-state ( -- depth-range-state )
|
||||
TYPED: get-depth-range-state ( -- depth-range-state: depth-range-state )
|
||||
GL_DEPTH_RANGE 2 get-gl-floats first2 <depth-range-state> ;
|
||||
|
||||
: get-depth-state ( -- depth-state )
|
||||
TYPED: get-depth-state ( -- depth-state: depth-state )
|
||||
GL_DEPTH_TEST gl-enabled?
|
||||
[ GL_DEPTH_FUNC get-gl-int gl-comparison> ] [ f ] if
|
||||
<depth-state> ;
|
||||
|
||||
: get-blend-state ( -- blend-state )
|
||||
TYPED: get-blend-state ( -- blend-state: blend-state )
|
||||
GL_BLEND gl-enabled? [
|
||||
GL_BLEND_COLOR 4 get-gl-floats
|
||||
|
||||
|
|
@ -501,34 +501,34 @@ PRIVATE>
|
|||
] [ f f f ] if
|
||||
<blend-state> ;
|
||||
|
||||
: get-mask-state ( -- mask-state )
|
||||
TYPED: get-mask-state ( -- mask-state: mask-state )
|
||||
GL_COLOR_WRITEMASK 4 get-gl-bools
|
||||
GL_DEPTH_WRITEMASK get-gl-bool
|
||||
GL_STENCIL_WRITEMASK get-gl-int
|
||||
GL_STENCIL_BACK_WRITEMASK get-gl-int
|
||||
<mask-state> ;
|
||||
|
||||
: get-triangle-cull-state ( -- triangle-cull-state )
|
||||
TYPED: get-triangle-cull-state ( -- triangle-cull-state: triangle-cull-state )
|
||||
GL_FRONT_FACE get-gl-int gl-triangle-face>
|
||||
GL_CULL_FACE gl-enabled?
|
||||
[ GL_CULL_FACE_MODE get-gl-int gl-triangle-cull> ]
|
||||
[ f ] if
|
||||
<triangle-cull-state> ;
|
||||
|
||||
: get-triangle-state ( -- triangle-state )
|
||||
TYPED: get-triangle-state ( -- triangle-state: triangle-state )
|
||||
GL_POLYGON_MODE 2 get-gl-ints
|
||||
first2 [ gl-triangle-mode> ] bi@
|
||||
GL_POLYGON_SMOOTH gl-enabled?
|
||||
<triangle-state> ;
|
||||
|
||||
: get-point-state ( -- point-state )
|
||||
TYPED: get-point-state ( -- point-state: point-state )
|
||||
GL_VERTEX_PROGRAM_POINT_SIZE gl-enabled?
|
||||
[ f ] [ GL_POINT_SIZE get-gl-float ] if
|
||||
GL_POINT_SPRITE_COORD_ORIGIN get-gl-int gl-point-sprite-origin>
|
||||
GL_POINT_FADE_THRESHOLD_SIZE get-gl-float
|
||||
<point-state> ;
|
||||
|
||||
: get-line-state ( -- line-state )
|
||||
TYPED: get-line-state ( -- line-state: line-state )
|
||||
GL_LINE_WIDTH get-gl-float
|
||||
GL_LINE_SMOOTH gl-enabled?
|
||||
<line-state> ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
USING: accessors alien.c-types arrays byte-arrays combinators
|
||||
destructors fry gpu gpu.buffers images kernel locals math
|
||||
opengl opengl.gl opengl.textures sequences
|
||||
specialized-arrays ui.gadgets.worlds variants ;
|
||||
specialized-arrays typed ui.gadgets.worlds variants ;
|
||||
FROM: alien.c-types => float ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
IN: gpu.textures
|
||||
|
|
@ -72,9 +72,9 @@ TUPLE: texture-parameters
|
|||
|
||||
GENERIC: texture-object ( texture-data-target -- texture )
|
||||
M: cube-map-face texture-object
|
||||
texture>> ;
|
||||
texture>> ; inline
|
||||
M: texture texture-object
|
||||
;
|
||||
; inline
|
||||
|
||||
: gl-wrap ( wrap -- gl-wrap )
|
||||
{
|
||||
|
|
@ -82,20 +82,20 @@ M: texture texture-object
|
|||
{ clamp-texcoord-to-border [ GL_CLAMP_TO_BORDER ] }
|
||||
{ repeat-texcoord [ GL_REPEAT ] }
|
||||
{ repeat-texcoord-mirrored [ GL_MIRRORED_REPEAT ] }
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
: set-texture-gl-wrap ( target wraps -- )
|
||||
dup sequence? [ 1array ] unless 3 over last pad-tail {
|
||||
[ [ GL_TEXTURE_WRAP_S ] dip first gl-wrap glTexParameteri ]
|
||||
[ [ GL_TEXTURE_WRAP_T ] dip second gl-wrap glTexParameteri ]
|
||||
[ [ GL_TEXTURE_WRAP_R ] dip third gl-wrap glTexParameteri ]
|
||||
} 2cleave ;
|
||||
} 2cleave ; inline
|
||||
|
||||
: gl-mag-filter ( filter -- gl-filter )
|
||||
{
|
||||
{ filter-nearest [ GL_NEAREST ] }
|
||||
{ filter-linear [ GL_LINEAR ] }
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
: gl-min-filter ( filter mipmap-filter -- gl-filter )
|
||||
2array {
|
||||
|
|
@ -105,25 +105,25 @@ M: texture texture-object
|
|||
{ { filter-linear filter-nearest } [ GL_LINEAR_MIPMAP_NEAREST ] }
|
||||
{ { filter-linear filter-linear } [ GL_LINEAR_MIPMAP_LINEAR ] }
|
||||
{ { filter-nearest filter-linear } [ GL_NEAREST_MIPMAP_LINEAR ] }
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
GENERIC: texture-gl-target ( texture -- target )
|
||||
GENERIC: texture-data-gl-target ( texture -- target )
|
||||
|
||||
M: texture-1d texture-gl-target drop GL_TEXTURE_1D ;
|
||||
M: texture-2d texture-gl-target drop GL_TEXTURE_2D ;
|
||||
M: texture-rectangle texture-gl-target drop GL_TEXTURE_RECTANGLE ;
|
||||
M: texture-3d texture-gl-target drop GL_TEXTURE_3D ;
|
||||
M: texture-cube-map texture-gl-target drop GL_TEXTURE_CUBE_MAP ;
|
||||
M: texture-1d-array texture-gl-target drop GL_TEXTURE_1D_ARRAY ;
|
||||
M: texture-2d-array texture-gl-target drop GL_TEXTURE_2D_ARRAY ;
|
||||
M: texture-1d texture-gl-target drop GL_TEXTURE_1D ; inline
|
||||
M: texture-2d texture-gl-target drop GL_TEXTURE_2D ; inline
|
||||
M: texture-rectangle texture-gl-target drop GL_TEXTURE_RECTANGLE ; inline
|
||||
M: texture-3d texture-gl-target drop GL_TEXTURE_3D ; inline
|
||||
M: texture-cube-map texture-gl-target drop GL_TEXTURE_CUBE_MAP ; inline
|
||||
M: texture-1d-array texture-gl-target drop GL_TEXTURE_1D_ARRAY ; inline
|
||||
M: texture-2d-array texture-gl-target drop GL_TEXTURE_2D_ARRAY ; inline
|
||||
|
||||
M: texture-1d texture-data-gl-target drop GL_TEXTURE_1D ;
|
||||
M: texture-2d texture-data-gl-target drop GL_TEXTURE_2D ;
|
||||
M: texture-rectangle texture-data-gl-target drop GL_TEXTURE_RECTANGLE ;
|
||||
M: texture-3d texture-data-gl-target drop GL_TEXTURE_3D ;
|
||||
M: texture-1d-array texture-data-gl-target drop GL_TEXTURE_1D_ARRAY ;
|
||||
M: texture-2d-array texture-data-gl-target drop GL_TEXTURE_2D_ARRAY ;
|
||||
M: texture-1d texture-data-gl-target drop GL_TEXTURE_1D ; inline
|
||||
M: texture-2d texture-data-gl-target drop GL_TEXTURE_2D ; inline
|
||||
M: texture-rectangle texture-data-gl-target drop GL_TEXTURE_RECTANGLE ; inline
|
||||
M: texture-3d texture-data-gl-target drop GL_TEXTURE_3D ; inline
|
||||
M: texture-1d-array texture-data-gl-target drop GL_TEXTURE_1D_ARRAY ; inline
|
||||
M: texture-2d-array texture-data-gl-target drop GL_TEXTURE_2D_ARRAY ; inline
|
||||
M: cube-map-face texture-data-gl-target
|
||||
axis>> {
|
||||
{ -X [ GL_TEXTURE_CUBE_MAP_NEGATIVE_X ] }
|
||||
|
|
@ -132,7 +132,7 @@ M: cube-map-face texture-data-gl-target
|
|||
{ +X [ GL_TEXTURE_CUBE_MAP_POSITIVE_X ] }
|
||||
{ +Y [ GL_TEXTURE_CUBE_MAP_POSITIVE_Y ] }
|
||||
{ +Z [ GL_TEXTURE_CUBE_MAP_POSITIVE_Z ] }
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
: texture-gl-internal-format ( texture -- internal-format )
|
||||
[ component-order>> ] [ component-type>> ] bi image-internal-format ; inline
|
||||
|
|
@ -144,20 +144,20 @@ M: cube-map-face texture-data-gl-target
|
|||
[ ptr>> ] bi
|
||||
] [
|
||||
[ component-order>> ] [ component-type>> ] bi image-data-format f
|
||||
] if* ;
|
||||
] if* ; inline
|
||||
|
||||
:: bind-tdt ( tdt -- texture )
|
||||
tdt texture-object :> texture
|
||||
texture [ texture-gl-target ] [ handle>> ] bi glBindTexture
|
||||
texture ;
|
||||
texture ; inline
|
||||
|
||||
: get-texture-float ( target level enum -- value )
|
||||
0 <float> [ glGetTexLevelParameterfv ] keep *float ;
|
||||
0 <float> [ glGetTexLevelParameterfv ] keep *float ; inline
|
||||
: get-texture-int ( target level enum -- value )
|
||||
0 <int> [ glGetTexLevelParameteriv ] keep *int ;
|
||||
0 <int> [ glGetTexLevelParameteriv ] keep *int ; inline
|
||||
|
||||
: ?product ( x -- y )
|
||||
dup number? [ product ] unless ;
|
||||
dup number? [ product ] unless ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -228,39 +228,39 @@ M:: texture-3d-data-target texture-dim ( tdt level -- dim )
|
|||
3array ;
|
||||
|
||||
: texture-data-size ( tdt level -- size )
|
||||
[ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ;
|
||||
[ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ; inline
|
||||
|
||||
:: read-texture-to ( tdt level gpu-data-ptr -- )
|
||||
TYPED:: read-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
texture [ component-order>> ] [ component-type>> ] bi image-data-format
|
||||
gpu-data-ptr pixel-pack-buffer [ glGetTexImage ] with-gpu-data-ptr ;
|
||||
|
||||
: read-texture ( tdt level -- byte-array )
|
||||
TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
|
||||
2dup texture-data-size <byte-array>
|
||||
[ read-texture-to ] keep ;
|
||||
|
||||
: allocate-texture-image ( tdt level image -- )
|
||||
image>texture-data allocate-texture ;
|
||||
image>texture-data allocate-texture ; inline
|
||||
|
||||
: update-texture-image ( tdt level loc image -- )
|
||||
image>texture-data update-texture ;
|
||||
image>texture-data update-texture ; inline
|
||||
|
||||
: read-texture-image ( tdt level -- image )
|
||||
[ texture-dim ]
|
||||
[ drop texture-object [ component-order>> ] [ component-type>> ] bi f ]
|
||||
[ read-texture ] 2tri
|
||||
image boa ;
|
||||
image boa ; inline
|
||||
|
||||
<PRIVATE
|
||||
: bind-texture ( texture -- gl-target )
|
||||
[ texture-gl-target dup ] [ handle>> ] bi glBindTexture ;
|
||||
[ texture-gl-target dup ] [ handle>> ] bi glBindTexture ; inline
|
||||
PRIVATE>
|
||||
|
||||
: generate-mipmaps ( texture -- )
|
||||
bind-texture glGenerateMipmap ;
|
||||
bind-texture glGenerateMipmap ; inline
|
||||
|
||||
: set-texture-parameters ( texture parameters -- )
|
||||
TYPED: set-texture-parameters ( texture: texture parameters: texture-parameters -- )
|
||||
[ bind-texture ] dip {
|
||||
[ wrap>> set-texture-gl-wrap ]
|
||||
[
|
||||
|
|
@ -286,17 +286,17 @@ PRIVATE>
|
|||
PRIVATE>
|
||||
|
||||
: <texture-1d> ( component-order component-type parameters -- texture )
|
||||
texture-1d <texture> ;
|
||||
texture-1d <texture> ; inline
|
||||
: <texture-2d> ( component-order component-type parameters -- texture )
|
||||
texture-2d <texture> ;
|
||||
texture-2d <texture> ; inline
|
||||
: <texture-3d> ( component-order component-type parameters -- texture )
|
||||
texture-3d <texture> ;
|
||||
texture-3d <texture> ; inline
|
||||
: <texture-cube-map> ( component-order component-type parameters -- texture )
|
||||
texture-cube-map <texture> ;
|
||||
texture-cube-map <texture> ; inline
|
||||
: <texture-rectangle> ( component-order component-type parameters -- texture )
|
||||
texture-rectangle <texture> ;
|
||||
texture-rectangle <texture> ; inline
|
||||
: <texture-1d-array> ( component-order component-type parameters -- texture )
|
||||
texture-1d-array <texture> ;
|
||||
texture-1d-array <texture> ; inline
|
||||
: <texture-2d-array> ( component-order component-type parameters -- texture )
|
||||
texture-2d-array <texture> ;
|
||||
texture-2d-array <texture> ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@ CONSTANT: window-vertexes
|
|||
: <window-vertex-buffer> ( -- buffer )
|
||||
window-vertexes
|
||||
static-upload draw-usage vertex-buffer
|
||||
byte-array>buffer ;
|
||||
byte-array>buffer ; inline
|
||||
|
||||
: <window-vertex-array> ( program-instance -- vertex-array )
|
||||
[ <window-vertex-buffer> ] dip window-vertex buffer>vertex-array ;
|
||||
[ <window-vertex-buffer> ] dip window-vertex buffer>vertex-array ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue