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