un-private some useful words
parent
d0c34345b1
commit
a8231893ec
|
@ -39,6 +39,8 @@ SLOT: display-list
|
||||||
|
|
||||||
GENERIC: draw-scaled-texture ( dim texture -- )
|
GENERIC: draw-scaled-texture ( dim texture -- )
|
||||||
|
|
||||||
|
DEFER: make-texture
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
|
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
|
[ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
|
||||||
glTexSubImage2D ;
|
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 ( -- )
|
: init-texture ( -- )
|
||||||
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
|
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
|
||||||
GL_TEXTURE_2D GL_TEXTURE_MIN_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>
|
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 )
|
: <texture> ( image loc -- texture )
|
||||||
over dim>> max-texture-size [ <= ] 2all?
|
over dim>> max-texture-size [ <= ] 2all?
|
||||||
[ <single-texture> ]
|
[ <single-texture> ]
|
||||||
|
|
|
@ -7,6 +7,9 @@ IN: noise
|
||||||
: <perlin-noise-table> ( -- table )
|
: <perlin-noise-table> ( -- table )
|
||||||
256 iota >byte-array randomize dup append ;
|
256 iota >byte-array randomize dup append ;
|
||||||
|
|
||||||
|
: with-seed ( seed quot -- )
|
||||||
|
[ <mersenne-twister> ] dip with-random ; inline
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: fade ( point -- point' )
|
: fade ( point -- point' )
|
||||||
|
@ -54,9 +57,6 @@ IN: noise
|
||||||
v w quot call
|
v w quot call
|
||||||
; inline
|
; inline
|
||||||
|
|
||||||
: with-seed ( seed quot -- )
|
|
||||||
[ <mersenne-twister> ] dip with-random ; inline
|
|
||||||
|
|
||||||
: >byte-map ( floats -- bytes )
|
: >byte-map ( floats -- bytes )
|
||||||
[ 255.0 * >fixnum ] B{ } map-as ;
|
[ 255.0 * >fixnum ] B{ } map-as ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue