un-private some useful words

db4
Joe Groff 2009-05-07 19:46:42 -05:00
parent d0c34345b1
commit a8231893ec
2 changed files with 17 additions and 15 deletions

View File

@ -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> ]

View File

@ -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 ;