Merge up with Joe's earlier change that added s3tc
Erik Charlebois
commit
6a039cdc76
|
|
@ -554,9 +554,6 @@ M: ulonglong-2-rep rep-component-type drop ulonglong ;
|
|||
M: float-4-rep rep-component-type drop float ;
|
||||
M: double-2-rep rep-component-type drop double ;
|
||||
|
||||
: rep-length ( rep -- n )
|
||||
16 swap rep-component-type heap-size /i ; foldable
|
||||
|
||||
: (unsigned-interval) ( bytes -- from to ) [ 0 ] dip 8 * 2^ 1 - ; foldable
|
||||
: unsigned-interval ( c-type -- from to ) heap-size (unsigned-interval) ; foldable
|
||||
: (signed-interval) ( bytes -- from to ) 8 * 1 - 2^ [ neg ] [ 1 - ] bi ; foldable
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors sequences classes.tuple
|
||||
classes.tuple.private arrays math math.private slots.private
|
||||
|
|
@ -50,7 +50,10 @@ DEFER: record-literal-allocation
|
|||
if* ;
|
||||
|
||||
M: #push escape-analysis*
|
||||
[ out-d>> first ] [ literal>> ] bi record-literal-allocation ;
|
||||
dup literal>> layout-up-to-date?
|
||||
[ [ out-d>> first ] [ literal>> ] bi record-literal-allocation ]
|
||||
[ out-d>> unknown-allocations ]
|
||||
if ;
|
||||
|
||||
: record-unknown-allocation ( #call -- )
|
||||
[ in-d>> add-escaping-values ]
|
||||
|
|
|
|||
|
|
@ -79,14 +79,6 @@ M: callable splicing-nodes splicing-body ;
|
|||
: inline-math-method ( #call word -- ? )
|
||||
dupd inlining-math-method eliminate-dispatch ;
|
||||
|
||||
: inlining-math-partial ( #call word -- class/f quot/f )
|
||||
[ "derived-from" word-prop first inlining-math-method ]
|
||||
[ nip 1quotation ] 2bi
|
||||
[ = not ] [ drop ] 2bi and ;
|
||||
|
||||
: inline-math-partial ( #call word -- ? )
|
||||
dupd inlining-math-partial eliminate-dispatch ;
|
||||
|
||||
! Method body inlining
|
||||
SYMBOL: history
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: fry assocs arrays byte-arrays strings accessors sequences
|
||||
kernel slots classes.algebra classes.tuple classes.tuple.private
|
||||
words math math.private combinators sequences.private namespaces
|
||||
slots.private classes compiler.tree.propagation.info ;
|
||||
combinators.short-circuit words math math.private combinators
|
||||
sequences.private namespaces slots.private classes
|
||||
compiler.tree.propagation.info ;
|
||||
IN: compiler.tree.propagation.slots
|
||||
|
||||
! Propagation of immutable slots and array lengths
|
||||
|
|
@ -52,8 +53,18 @@ UNION: fixed-length-sequence array byte-array string ;
|
|||
dup [ read-only>> ] when ;
|
||||
|
||||
: literal-info-slot ( slot object -- info/f )
|
||||
2dup class read-only-slot?
|
||||
[ swap slot <literal-info> ] [ 2drop f ] if ;
|
||||
#! literal-info-slot makes an unsafe call to 'slot'.
|
||||
#! Check that the layout is up to date to avoid accessing the
|
||||
#! wrong slot during a compilation unit where reshaping took
|
||||
#! place. This could happen otherwise because the "slots" word
|
||||
#! property would reflect the new layout, but instances in the
|
||||
#! heap would use the old layout since instances are updated
|
||||
#! immediately after compilation.
|
||||
{
|
||||
[ class read-only-slot? ]
|
||||
[ nip layout-up-to-date? ]
|
||||
[ swap slot <literal-info> ]
|
||||
} 2&& ;
|
||||
|
||||
: length-accessor? ( slot info -- ? )
|
||||
[ 1 = ] [ length>> ] bi* and ;
|
||||
|
|
|
|||
|
|
@ -169,6 +169,19 @@ M: uint-scalar-rep rep-size drop 4 ;
|
|||
M: longlong-scalar-rep rep-size drop 8 ;
|
||||
M: ulonglong-scalar-rep rep-size drop 8 ;
|
||||
|
||||
GENERIC: rep-length ( rep -- n ) foldable
|
||||
|
||||
M: char-16-rep rep-length drop 16 ;
|
||||
M: uchar-16-rep rep-length drop 16 ;
|
||||
M: short-8-rep rep-length drop 8 ;
|
||||
M: ushort-8-rep rep-length drop 8 ;
|
||||
M: int-4-rep rep-length drop 4 ;
|
||||
M: uint-4-rep rep-length drop 4 ;
|
||||
M: longlong-2-rep rep-length drop 2 ;
|
||||
M: ulonglong-2-rep rep-length drop 2 ;
|
||||
M: float-4-rep rep-length drop 4 ;
|
||||
M: double-2-rep rep-length drop 2 ;
|
||||
|
||||
GENERIC: rep-component-type ( rep -- n )
|
||||
|
||||
! Methods defined in alien.c-types
|
||||
|
|
|
|||
|
|
@ -2251,7 +2251,7 @@ CONSTANT: GL_LUMINANCE_ALPHA_INTEGER_EXT HEX: 8D9D
|
|||
GL-FUNCTION: void glClearColorIiEXT { } ( GLint r, GLint g, GLint b, GLint a ) ;
|
||||
GL-FUNCTION: void glClearColorIuiEXT { } ( GLuint r, GLuint g, GLuint b, GLuint a ) ;
|
||||
|
||||
! GL_EXT_texture_compression_s3tc
|
||||
! GL_EXT_texture_compression_s3tc, GL_EXT_texture_compression_dxt1
|
||||
|
||||
CONSTANT: GL_COMPRESSED_RGB_S3TC_DXT1_EXT HEX: 83F0
|
||||
CONSTANT: GL_COMPRESSED_RGBA_S3TC_DXT1_EXT HEX: 83F1
|
||||
|
|
|
|||
|
|
@ -746,3 +746,21 @@ TUPLE: g < a-g ;
|
|||
[ ] [ "IN: classes.tuple.tests MIXIN: a-g TUPLE: g ;" eval( -- ) ] unit-test
|
||||
|
||||
[ t ] [ g new layout-of "g" get layout-of eq? ] unit-test
|
||||
|
||||
! Joe Groff discovered this bug
|
||||
DEFER: factor-crashes-anymore
|
||||
|
||||
[ ] [
|
||||
"IN: classes.tuple.tests
|
||||
TUPLE: unsafe-slot-access ;
|
||||
CONSTANT: unsafe-slot-access' T{ unsafe-slot-access }" eval( -- )
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: classes.tuple.tests
|
||||
USE: accessors
|
||||
TUPLE: unsafe-slot-access { x read-only initial: 31337 } ;
|
||||
: factor-crashes-anymore ( -- x ) unsafe-slot-access' x>> ;" eval( -- )
|
||||
] unit-test
|
||||
|
||||
[ 31337 ] [ factor-crashes-anymore ] unit-test
|
||||
|
|
|
|||
|
|
@ -32,6 +32,10 @@ M: tuple class layout-of 2 slot { word } declare ; inline
|
|||
: tuple-size ( tuple -- size )
|
||||
layout-of 3 slot { fixnum } declare ; inline
|
||||
|
||||
: layout-up-to-date? ( object -- ? )
|
||||
dup tuple?
|
||||
[ [ layout-of ] [ class tuple-layout ] bi eq? ] [ drop t ] if ;
|
||||
|
||||
: check-tuple ( object -- tuple )
|
||||
dup tuple? [ not-a-tuple ] unless ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -88,6 +88,13 @@ HELP: <texture-rectangle>
|
|||
{ $description "Creates a new rectangle texture. The new texture starts out with no image data; " { $link allocate-texture } " or " { $link allocate-texture-image } " must be used to allocate memory for the texture." }
|
||||
{ $notes "Rectangle textures require OpenGL 3.1 or the " { $snippet "GL_ARB_texture_rectangle" } " extension." } ;
|
||||
|
||||
HELP: allocate-compressed-texture
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer } { "dim" "an " { $link integer } " or sequence of " { $link integer } "s" } { "compressed-data" compressed-texture-data }
|
||||
}
|
||||
{ $description "Allocates a new block of GPU memory for the " { $snippet "level" } "th level of detail of a " { $link texture-data-target } ". The new data is initialized with compressed texture data from the given " { $link compressed-texture-data } " object." }
|
||||
{ $notes "Using a " { $link buffer-ptr } " as the " { $snippet "ptr" } " of a " { $snippet "compressed-texture-data" } " object requires OpenGL 2.1 or later or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
|
||||
|
||||
HELP: allocate-texture
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer } { "dim" "an " { $link integer } " or sequence of " { $link integer } "s" } { "data" { $maybe texture-data } }
|
||||
|
|
@ -101,7 +108,7 @@ HELP: allocate-texture-image
|
|||
}
|
||||
{ $description "Allocates a new block of GPU memory for the " { $snippet "level" } "th level of detail of a " { $link texture-data-target } " and initializes it with the contents of an " { $link image } "." } ;
|
||||
|
||||
{ allocate-texture allocate-texture-image } related-words
|
||||
{ allocate-compressed-texture allocate-texture allocate-texture-image } related-words
|
||||
|
||||
HELP: clamp-texcoord-to-border
|
||||
{ $class-description "This " { $link texture-wrap } " value clamps texture coordinates to a texture's border." } ;
|
||||
|
|
@ -140,6 +147,21 @@ HELP: image>texture-data
|
|||
}
|
||||
{ $description "Constructs a " { $link texture-data } " tuple referencing the pixel data from an " { $link image } "." } ;
|
||||
|
||||
HELP: read-compressed-texture
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer }
|
||||
{ "byte-array" byte-array }
|
||||
}
|
||||
{ $description "Reads the entire compressed image for the " { $snippet "level" } "th level of detail of a texture into a new " { $link byte-array } ". The format of the data in the byte array is determined by the " { $link compressed-texture-format } " of the data originally allocated by " { $link allocate-compressed-texture } " for the texture." } ;
|
||||
|
||||
HELP: read-compressed-texture-to
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer }
|
||||
{ "gpu-data-ptr" byte-array }
|
||||
}
|
||||
{ $description "Reads the entire compressed image for the " { $snippet "level" } "th level of detail of a texture into the CPU or GPU memory referenced by " { $link gpu-data-ptr } ". The format of the written data is determined by the " { $link compressed-texture-format } " of the data originally allocated by " { $link allocate-compressed-texture } " for the texture." }
|
||||
{ $notes "Reading texture data into a GPU " { $snippet "buffer-ptr" } " requires OpenGL 2.1 or later or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
|
||||
|
||||
HELP: read-texture
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer }
|
||||
|
|
@ -158,10 +180,10 @@ HELP: read-texture-to
|
|||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer } { "gpu-data-ptr" gpu-data-ptr }
|
||||
}
|
||||
{ $description "Reads the entire image for the " { $snippet "level" } "th level of detail of a texture into the CPU or GPU memory referenced by " { $link gpu-data-ptr } ". The format of the data in the byte array is determined by the " { $link component-order } " and " { $link component-type } " of the texture." }
|
||||
{ $description "Reads the entire image for the " { $snippet "level" } "th level of detail of a texture into the CPU or GPU memory referenced by " { $link gpu-data-ptr } ". The format of the written data is determined by the " { $link component-order } " and " { $link component-type } " of the texture." }
|
||||
{ $notes "Reading texture data into a GPU " { $snippet "buffer-ptr" } " requires OpenGL 2.1 or later or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
|
||||
|
||||
{ read-texture read-texture-image read-texture-to } related-words
|
||||
{ read-compressed-texture read-compressed-texture-to read-texture read-texture-image read-texture-to } related-words
|
||||
|
||||
HELP: repeat-texcoord
|
||||
{ $class-description "This " { $link texture-wrap } " value causes the texture image to be repeated through texture coordinate space." } ;
|
||||
|
|
@ -256,6 +278,13 @@ HELP: texture-dim
|
|||
}
|
||||
{ $description "Returns the dimensions of the memory allocated for the " { $snippet "level" } "th level of detail of the given " { $link texture-data-target } "." } ;
|
||||
|
||||
HELP: compressed-texture-data-size
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer }
|
||||
{ "size" integer }
|
||||
}
|
||||
{ $description "Returns the size in bytes of the memory allocated for the compressed texture data making up the " { $snippet "level" } "th level of detail of the given " { $link texture-data-target } "." } ;
|
||||
|
||||
HELP: texture-filter
|
||||
{ $class-description { $snippet "texture-filter" } " values are used in a " { $link texture-parameters } " tuple to determine how a texture should be sampled between pixels or between levels of detail. " { $link filter-linear } " selects linear filtering, while " { $link filter-nearest } " selects nearest-neighbor sampling." } ;
|
||||
|
||||
|
|
@ -277,6 +306,13 @@ HELP: texture-rectangle
|
|||
{ $class-description "A two-dimensional rectangle " { $link texture } " object. Textures of this type are dimensioned by pairs of integers in calls to " { $link allocate-texture } " and " { $link update-texture } ". Rectangle textures differ from normal 2D textures (" { $link texture-2d } ") in that texture coordinates map directly to pixel coordinates when they are sampled from shader code, rather than being normalized into the 0.0 to 1.0 range as with other texture types. Also, rectangle textures do not support mipmapping or texture wrapping." }
|
||||
{ $notes "Rectangle textures require OpenGL 3.1 or the " { $snippet "GL_ARB_texture_rectangle" } " extension." } ;
|
||||
|
||||
HELP: update-compressed-texture
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer } { "loc" "an " { $link integer } " or sequence of integers" } { "dim" "an " { $link integer } " or sequence of integers" } { "compressed-data" texture-data }
|
||||
}
|
||||
{ $description "Updates the linear, rectangular, or cubic subregion of a compressed " { $link texture-data-target } " bounded by " { $snippet "loc" } " and " { $snippet "dim" } " with the data referenced by the given " { $link compressed-texture-data } " tuple. The given level of detail of the texture must have been previously allocated for compressed data with " { $link allocate-compressed-texture } "." }
|
||||
{ $notes "Using a " { $link buffer-ptr } " as the " { $snippet "ptr" } " of a " { $snippet "compressed-texture-data" } " object requires OpenGL 2.1 or later or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
|
||||
|
||||
HELP: update-texture
|
||||
{ $values
|
||||
{ "tdt" texture-data-target } { "level" integer } { "loc" "an " { $link integer } " or sequence of integers" } { "dim" "an " { $link integer } " or sequence of integers" } { "data" texture-data }
|
||||
|
|
@ -290,22 +326,59 @@ HELP: update-texture-image
|
|||
}
|
||||
{ $description "Updates the linear, rectangular, or cubic subregion of a " { $link texture-data-target } " bounded by " { $snippet "loc" } " and " { $snippet "dim" } " with new image data from an " { $link image } " object." } ;
|
||||
|
||||
{ update-texture update-texture-image } related-words
|
||||
{ update-compressed-texture update-texture update-texture-image } related-words
|
||||
|
||||
HELP: compressed-texture-format
|
||||
{ $class-description { $snippet "compressed-texture-format" } " values are used as part of a " { $link compressed-texture-data } " tuple to specify the binary format of texture data being given to " { $link allocate-compressed-texture } " or " { $link update-compressed-texture } ". The following compressed formats are available:"
|
||||
{ $list
|
||||
{ { $link DXT1-RGB } }
|
||||
{ { $link DXT1-RGBA } }
|
||||
{ { $link DXT3 } }
|
||||
{ { $link DXT5 } }
|
||||
{ { $link RGTC1 } }
|
||||
{ { $link RGTC1-SIGNED } }
|
||||
{ { $link RGTC2 } }
|
||||
{ { $link RGTC2-SIGNED } }
|
||||
} }
|
||||
{ $notes "The " { $snippet "DXT1" } " formats require either the " { $snippet "GL_EXT_texture_compression_s3tc" } " or " { $snippet "GL_EXT_texture_compression_dxt1" } " extension. The other " { $snippet "DXT" } " formats require the " { $snippet "GL_EXT_texture_compression_s3tc" } " extension. The " { $snippet "RGTC" } " formats require OpenGL 3.0 or later or the " { $snippet "GL_EXT_texture_compression_rgtc" } " extension." } ;
|
||||
|
||||
HELP: compressed-texture-data
|
||||
{ $class-description { $snippet "compressed-texture-data" } " tuples are used to feed compressed texture data to " { $link allocate-compressed-texture } " and " { $link update-compressed-texture } "."
|
||||
{ $list
|
||||
{ "The " { $snippet "ptr" } " slot references either CPU memory (as a " { $link byte-array } " or " { $link alien } ") or a GPU " { $link buffer-ptr } " that contains the image data." }
|
||||
{ "The " { $snippet "format" } " slot determines the " { $link compressed-texture-format } " of the referenced data." }
|
||||
{ "The " { $snippet "length" } " slot determines the size in bytes of the referenced data." }
|
||||
} }
|
||||
{ $notes "Using a " { $link buffer-ptr } " as the " { $snippet "ptr" } " of a " { $snippet "texture-data" } " object requires OpenGL 2.1 or later or the " { $snippet "GL_ARB_pixel_buffer_object" } " extension." } ;
|
||||
|
||||
{ compressed-texture-data <compressed-texture-data> } related-words
|
||||
|
||||
ARTICLE: "gpu.textures" "Texture objects"
|
||||
"The " { $vocab-link "gpu.textures" } " vocabulary provides words for creating, allocating, updating, and reading GPU texture objects."
|
||||
{ $subsections
|
||||
texture
|
||||
texture-data
|
||||
allocate-texture
|
||||
update-texture
|
||||
texture-dim
|
||||
read-texture
|
||||
read-texture-to
|
||||
}
|
||||
"Words are also provided to interface textures with the " { $vocab-link "images" } " library:"
|
||||
"Words are also provided to use " { $link image } " objects from the " { $vocab-link "images" } " library as data sources and destinations for texture data:"
|
||||
{ $subsections
|
||||
allocate-texture-image
|
||||
update-texture-image
|
||||
read-texture-image
|
||||
}
|
||||
;
|
||||
"Compressed texture data can also be supplied and read:"
|
||||
{ $subsections
|
||||
compressed-texture-format
|
||||
compressed-texture-data
|
||||
allocate-compressed-texture
|
||||
update-compressed-texture
|
||||
compressed-texture-data-size
|
||||
read-compressed-texture
|
||||
read-compressed-texture-to
|
||||
} ;
|
||||
|
||||
ABOUT: "gpu.textures"
|
||||
|
|
|
|||
|
|
@ -49,6 +49,18 @@ C: <texture-data> texture-data
|
|||
UNION: ?texture-data texture-data POSTPONE: f ;
|
||||
UNION: ?float-array float-array POSTPONE: f ;
|
||||
|
||||
VARIANT: compressed-texture-format
|
||||
DXT1-RGB DXT1-RGBA DXT3 DXT5
|
||||
RGTC1 RGTC1-SIGNED RGTC2 RGTC2-SIGNED ;
|
||||
|
||||
TUPLE: compressed-texture-data
|
||||
{ ptr read-only }
|
||||
{ format compressed-texture-format read-only }
|
||||
{ length integer read-only } ;
|
||||
|
||||
C: <compressed-texture-data> compressed-texture-data
|
||||
UNION: ?compressed-texture-data compressed-texture-data POSTPONE: f ;
|
||||
|
||||
VARIANT: texture-wrap
|
||||
clamp-texcoord-to-edge clamp-texcoord-to-border repeat-texcoord repeat-texcoord-mirrored ;
|
||||
VARIANT: texture-filter
|
||||
|
|
@ -76,6 +88,18 @@ M: cube-map-face texture-object
|
|||
M: texture texture-object
|
||||
; inline
|
||||
|
||||
: gl-compressed-texture-format ( format -- gl-format )
|
||||
{
|
||||
{ DXT1-RGB [ GL_COMPRESSED_RGB_S3TC_DXT1_EXT ] }
|
||||
{ DXT1-RGBA [ GL_COMPRESSED_RGBA_S3TC_DXT1_EXT ] }
|
||||
{ DXT3 [ GL_COMPRESSED_RGBA_S3TC_DXT3_EXT ] }
|
||||
{ DXT5 [ GL_COMPRESSED_RGBA_S3TC_DXT5_EXT ] }
|
||||
{ RGTC1 [ GL_COMPRESSED_RED_RGTC1 ] }
|
||||
{ RGTC1-SIGNED [ GL_COMPRESSED_SIGNED_RED_RGTC1 ] }
|
||||
{ RGTC2 [ GL_COMPRESSED_RG_RGTC2 ] }
|
||||
{ RGTC2-SIGNED [ GL_COMPRESSED_SIGNED_RG_RGTC2 ] }
|
||||
} case ; inline
|
||||
|
||||
: gl-wrap ( wrap -- gl-wrap )
|
||||
{
|
||||
{ clamp-texcoord-to-edge [ GL_CLAMP_TO_EDGE ] }
|
||||
|
|
@ -159,49 +183,77 @@ M: cube-map-face texture-data-gl-target
|
|||
: ?product ( x -- y )
|
||||
dup number? [ product ] unless ; inline
|
||||
|
||||
:: (allocate-texture) ( tdt level dim data dim-quot teximage-quot -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level texture texture-gl-internal-format
|
||||
dim dim-quot call 0 texture data texture-data-gl-args
|
||||
pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline
|
||||
|
||||
:: (allocate-compressed-texture) ( tdt level dim compressed-data dim-quot teximage-quot -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level compressed-data format>> gl-compressed-texture-format
|
||||
dim dim-quot call 0 compressed-data [ length>> ] [ ptr>> ] bi
|
||||
pixel-unpack-buffer teximage-quot with-gpu-data-ptr ; inline
|
||||
|
||||
:: (update-texture) ( tdt level loc dim data dim-quot texsubimage-quot -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
loc dim dim-quot bi@
|
||||
texture data texture-data-gl-args
|
||||
pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline
|
||||
|
||||
:: (update-compressed-texture) ( tdt level loc dim compressed-data dim-quot texsubimage-quot -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
loc dim dim-quot bi@
|
||||
compressed-data [ format>> gl-compressed-texture-format ] [ length>> ] [ ptr>> ] tri
|
||||
pixel-unpack-buffer texsubimage-quot with-gpu-data-ptr ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
GENERIC# allocate-texture 3 ( tdt level dim data -- )
|
||||
|
||||
M:: texture-1d-data-target allocate-texture ( tdt level dim data -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level texture texture-gl-internal-format
|
||||
dim 0 texture data texture-data-gl-args
|
||||
pixel-unpack-buffer [ glTexImage1D ] with-gpu-data-ptr ;
|
||||
M: texture-1d-data-target allocate-texture ( tdt level dim data -- )
|
||||
[ ] [ glTexImage1D ] (allocate-texture) ;
|
||||
|
||||
M:: texture-2d-data-target allocate-texture ( tdt level dim data -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level texture texture-gl-internal-format
|
||||
dim first2 0 texture data texture-data-gl-args
|
||||
pixel-unpack-buffer [ glTexImage2D ] with-gpu-data-ptr ;
|
||||
M: texture-2d-data-target allocate-texture ( tdt level dim data -- )
|
||||
[ first2 ] [ glTexImage2D ] (allocate-texture) ;
|
||||
|
||||
M:: texture-3d-data-target allocate-texture ( tdt level dim data -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level texture texture-gl-internal-format
|
||||
dim first3 0 texture data texture-data-gl-args
|
||||
pixel-unpack-buffer [ glTexImage3D ] with-gpu-data-ptr ;
|
||||
M: texture-3d-data-target allocate-texture ( tdt level dim data -- )
|
||||
[ first3 ] [ glTexImage3D ] (allocate-texture) ;
|
||||
|
||||
GENERIC# allocate-compressed-texture 3 ( tdt level dim compressed-data -- )
|
||||
|
||||
M: texture-1d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
|
||||
[ ] [ glCompressedTexImage1D ] (allocate-compressed-texture) ;
|
||||
|
||||
M: texture-2d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
|
||||
[ first2 ] [ glCompressedTexImage2D ] (allocate-compressed-texture) ;
|
||||
|
||||
M: texture-3d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- )
|
||||
[ first3 ] [ glCompressedTexImage3D ] (allocate-compressed-texture) ;
|
||||
|
||||
GENERIC# update-texture 4 ( tdt level loc dim data -- )
|
||||
|
||||
M:: texture-1d-data-target update-texture ( tdt level loc dim data -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
loc dim texture data texture-data-gl-args
|
||||
pixel-unpack-buffer [ glTexSubImage1D ] with-gpu-data-ptr ;
|
||||
M: texture-1d-data-target update-texture ( tdt level loc dim data -- )
|
||||
[ ] [ glTexSubImage1D ] (update-texture) ;
|
||||
|
||||
M:: texture-2d-data-target update-texture ( tdt level loc dim data -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
loc dim [ first2 ] bi@
|
||||
texture data texture-data-gl-args
|
||||
pixel-unpack-buffer [ glTexSubImage2D ] with-gpu-data-ptr ;
|
||||
M: texture-2d-data-target update-texture ( tdt level loc dim data -- )
|
||||
[ first2 ] [ glTexSubImage2D ] (update-texture) ;
|
||||
|
||||
M:: texture-3d-data-target update-texture ( tdt level loc dim data -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
loc dim [ first3 ] bi@
|
||||
texture data texture-data-gl-args
|
||||
pixel-unpack-buffer [ glTexSubImage3D ] with-gpu-data-ptr ;
|
||||
M: texture-3d-data-target update-texture ( tdt level loc dim data -- )
|
||||
[ first3 ] [ glTexSubImage3D ] (update-texture) ;
|
||||
|
||||
GENERIC# update-compressed-texture 4 ( tdt level loc dim compressed-data -- )
|
||||
|
||||
M: texture-1d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
|
||||
[ ] [ glCompressedTexSubImage1D ] (update-compressed-texture) ;
|
||||
|
||||
M: texture-2d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
|
||||
[ first2 ] [ glCompressedTexSubImage2D ] (update-compressed-texture) ;
|
||||
|
||||
M: texture-3d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- )
|
||||
[ first3 ] [ glCompressedTexSubImage3D ] (update-compressed-texture) ;
|
||||
|
||||
: image>texture-data ( image -- dim texture-data )
|
||||
{ [ dim>> ] [ bitmap>> ] [ component-order>> ] [ component-type>> ] } cleave
|
||||
|
|
@ -211,13 +263,13 @@ GENERIC# texture-dim 1 ( tdt level -- dim )
|
|||
|
||||
M:: texture-1d-data-target texture-dim ( tdt level -- dim )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level GL_TEXTURE_WIDTH get-texture-int ;
|
||||
tdt texture-data-gl-target level GL_TEXTURE_WIDTH get-texture-int ; inline
|
||||
|
||||
M:: texture-2d-data-target texture-dim ( tdt level -- dim )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
[ GL_TEXTURE_WIDTH get-texture-int ] [ GL_TEXTURE_HEIGHT get-texture-int ] 2bi
|
||||
2array ;
|
||||
2array ; inline
|
||||
|
||||
M:: texture-3d-data-target texture-dim ( tdt level -- dim )
|
||||
tdt bind-tdt :> texture
|
||||
|
|
@ -225,7 +277,11 @@ M:: texture-3d-data-target texture-dim ( tdt level -- dim )
|
|||
[ GL_TEXTURE_WIDTH get-texture-int ]
|
||||
[ GL_TEXTURE_HEIGHT get-texture-int ]
|
||||
[ GL_TEXTURE_DEPTH get-texture-int ] 2tri
|
||||
3array ;
|
||||
3array ; inline
|
||||
|
||||
: compressed-texture-data-size ( tdt level -- size )
|
||||
[ [ bind-tdt drop ] [ texture-data-gl-target ] bi ] dip
|
||||
GL_TEXTURE_COMPRESSED_IMAGE_SIZE get-texture-int ; inline
|
||||
|
||||
: texture-data-size ( tdt level -- size )
|
||||
[ texture-dim ?product ] [ drop texture-object bytes-per-pixel ] 2bi * ; inline
|
||||
|
|
@ -237,9 +293,18 @@ TYPED:: read-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -
|
|||
gpu-data-ptr pixel-pack-buffer [ glGetTexImage ] with-gpu-data-ptr ;
|
||||
|
||||
TYPED: read-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
|
||||
2dup texture-data-size <byte-array>
|
||||
2dup texture-data-size (byte-array)
|
||||
[ read-texture-to ] keep ;
|
||||
|
||||
TYPED:: read-compressed-texture-to ( tdt: texture-data-target level: integer gpu-data-ptr -- )
|
||||
tdt bind-tdt :> texture
|
||||
tdt texture-data-gl-target level
|
||||
gpu-data-ptr pixel-pack-buffer [ glGetCompressedTexImage ] with-gpu-data-ptr ;
|
||||
|
||||
TYPED: read-compressed-texture ( tdt: texture-data-target level: integer -- byte-array: byte-array )
|
||||
2dup compressed-texture-data-size (byte-array)
|
||||
[ read-compressed-texture-to ] keep ;
|
||||
|
||||
: allocate-texture-image ( tdt level image -- )
|
||||
image>texture-data allocate-texture ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -178,9 +178,9 @@ terrain-world H{
|
|||
[
|
||||
{ 0 2 3 3 } vshuffle terrain-height-at PLAYER-HEIGHT +
|
||||
-1/0. swap -1/0. -1/0. float-4-boa
|
||||
] keep vmax ;
|
||||
] keep vmax ; inline
|
||||
|
||||
:: collide ( world player -- )
|
||||
TYPED:: collide ( world: terrain-world player: player -- )
|
||||
world terrain-segment>> :> segment
|
||||
player location>> :> location
|
||||
segment location (collide) :> location'
|
||||
|
|
|
|||
Loading…
Reference in New Issue