un-private some useful words
parent
d0c34345b1
commit
a8231893ec
|
@ -39,6 +39,8 @@ SLOT: display-list
|
|||
|
||||
GENERIC: draw-scaled-texture ( dim texture -- )
|
||||
|
||||
DEFER: make-texture
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
|
||||
|
@ -61,18 +63,6 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
|
|||
[ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
|
||||
glTexSubImage2D ;
|
||||
|
||||
: make-texture ( image -- id )
|
||||
#! We use glTexSubImage2D to work around the power of 2 texture size
|
||||
#! limitation
|
||||
gen-texture [
|
||||
GL_TEXTURE_BIT [
|
||||
GL_TEXTURE_2D swap glBindTexture
|
||||
non-power-of-2-textures? get
|
||||
[ dup bitmap>> (tex-image) ]
|
||||
[ [ f (tex-image) ] [ (tex-sub-image) ] bi ] if
|
||||
] do-attribs
|
||||
] keep ;
|
||||
|
||||
: init-texture ( -- )
|
||||
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri
|
||||
|
@ -176,6 +166,18 @@ CONSTANT: max-texture-size { 512 512 }
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: make-texture ( image -- id )
|
||||
#! We use glTexSubImage2D to work around the power of 2 texture size
|
||||
#! limitation
|
||||
gen-texture [
|
||||
GL_TEXTURE_BIT [
|
||||
GL_TEXTURE_2D swap glBindTexture
|
||||
non-power-of-2-textures? get
|
||||
[ dup bitmap>> (tex-image) ]
|
||||
[ [ f (tex-image) ] [ (tex-sub-image) ] bi ] if
|
||||
] do-attribs
|
||||
] keep ;
|
||||
|
||||
: <texture> ( image loc -- texture )
|
||||
over dim>> max-texture-size [ <= ] 2all?
|
||||
[ <single-texture> ]
|
||||
|
|
|
@ -7,6 +7,9 @@ IN: noise
|
|||
: <perlin-noise-table> ( -- table )
|
||||
256 iota >byte-array randomize dup append ;
|
||||
|
||||
: with-seed ( seed quot -- )
|
||||
[ <mersenne-twister> ] dip with-random ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: fade ( point -- point' )
|
||||
|
@ -54,9 +57,6 @@ IN: noise
|
|||
v w quot call
|
||||
; inline
|
||||
|
||||
: with-seed ( seed quot -- )
|
||||
[ <mersenne-twister> ] dip with-random ; inline
|
||||
|
||||
: >byte-map ( floats -- bytes )
|
||||
[ 255.0 * >fixnum ] B{ } map-as ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue