Split off opengl.textures from opengl.texture-cache; use image tuples instead of texture-info
Slava Pestov
parent
5d2c60dacd
commit
ea2a3d6758
|
|
@ -1,12 +1,11 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays alien alien.c-types alien.syntax kernel
|
||||
destructors accessors fry words hashtables strings
|
||||
sequences memoize assocs math math.functions locals init
|
||||
namespaces combinators fonts colors cache core-foundation
|
||||
core-foundation.strings core-foundation.attributed-strings
|
||||
core-foundation.utilities core-graphics core-graphics.types
|
||||
core-text.fonts core-text.utilities ;
|
||||
USING: arrays alien alien.c-types alien.syntax kernel destructors
|
||||
accessors fry words hashtables strings sequences memoize assocs math
|
||||
math.functions locals init namespaces combinators fonts colors cache
|
||||
images endian core-foundation core-foundation.strings
|
||||
core-foundation.attributed-strings core-foundation.utilities
|
||||
core-graphics core-graphics.types core-text.fonts core-text.utilities ;
|
||||
IN: core-text
|
||||
|
||||
TYPEDEF: void* CTLineRef
|
||||
|
|
@ -47,7 +46,7 @@ ERROR: not-a-string object ;
|
|||
CTLineCreateWithAttributedString
|
||||
] with-destructors ;
|
||||
|
||||
TUPLE: line font line metrics dim bitmap disposed ;
|
||||
TUPLE: line font line metrics image disposed ;
|
||||
|
||||
: compute-line-metrics ( line -- line-metrics )
|
||||
0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
|
||||
|
|
@ -78,6 +77,13 @@ TUPLE: line font line metrics dim bitmap disposed ;
|
|||
: set-text-position ( context metrics -- )
|
||||
[ 0 ] dip descent>> ceiling CGContextSetTextPosition ;
|
||||
|
||||
: <line-image> ( dim bitmap -- image )
|
||||
<image>
|
||||
swap >>bitmap
|
||||
swap >>dim
|
||||
BGRA >>component-order
|
||||
native-endianness >>byte-order ;
|
||||
|
||||
:: <line> ( font string -- line )
|
||||
[
|
||||
[let* | open-font [ font cache-font CFRetain |CFRelease ]
|
||||
|
|
@ -92,7 +98,7 @@ TUPLE: line font line metrics dim bitmap disposed ;
|
|||
[ [ line ] dip CTLineDraw ]
|
||||
} cleave
|
||||
] with-bitmap-context
|
||||
[ open-font line metrics dim ] dip
|
||||
[ open-font line metrics dim ] dip <line-image>
|
||||
]
|
||||
f line boa
|
||||
] with-destructors ;
|
||||
|
|
|
|||
|
|
@ -30,23 +30,14 @@ HELP: gl-rect
|
|||
{ $values { "dim" "a pair of integers" } }
|
||||
{ $description "Draws the outline of a rectangle with the top-left corner at the origin and the given dimensions." } ;
|
||||
|
||||
HELP: gen-texture
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ;
|
||||
|
||||
HELP: gen-gl-buffer
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ;
|
||||
|
||||
HELP: delete-texture
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ;
|
||||
|
||||
HELP: delete-gl-buffer
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glDeleteBuffers } " to handle the common case of deleting a single buffer ID." } ;
|
||||
|
||||
{ gen-texture delete-texture } related-words
|
||||
{ gen-gl-buffer delete-gl-buffer } related-words
|
||||
|
||||
HELP: bind-texture-unit
|
||||
|
|
@ -61,10 +52,6 @@ HELP: do-attribs
|
|||
{ $values { "bits" integer } { "quot" quotation } }
|
||||
{ $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ;
|
||||
|
||||
HELP: make-texture
|
||||
{ $values { "dim" "a pair of integers" } { "pixmap" c-ptr } { "format" "an OpenGL texture format, for example " { $link GL_UNSIGNED_BYTE } } { "type" "an OpenGL texture type, for example " { $link GL_RGBA } } { "id" "an OpenGL texture ID" } }
|
||||
{ $description "Creates a new OpenGL texture from a pixmap image whose dimensions are equal to " { $snippet "dim" } "." } ;
|
||||
|
||||
HELP: gen-dlist
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glGenLists } " to handle the common case of generating a single display list ID." } ;
|
||||
|
|
@ -81,7 +68,6 @@ HELP: with-translation
|
|||
{ $values { "loc" "a pair of integers" } { "quot" quotation } }
|
||||
{ $description "Calls the quotation with a translation by " { $snippet "loc" } " pixels applied to the current " { $link GL_MODELVIEW } " matrix, restoring the matrix when the quotation is done." } ;
|
||||
|
||||
|
||||
ARTICLE: "gl-utilities" "OpenGL utility words"
|
||||
"The " { $vocab-link "opengl" } " vocabulary implements some utility words to give OpenGL a more Factor-like feel."
|
||||
$nl
|
||||
|
|
@ -90,7 +76,6 @@ $nl
|
|||
"Wrappers:"
|
||||
{ $subsection gl-color }
|
||||
{ $subsection gl-translate }
|
||||
{ $subsection gen-texture }
|
||||
{ $subsection bind-texture-unit }
|
||||
"Combinators:"
|
||||
{ $subsection do-enabled }
|
||||
|
|
|
|||
|
|
@ -106,31 +106,9 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
|||
: gl-fill-rect ( dim -- )
|
||||
fill-rect-vertices (gl-fill-rect) ;
|
||||
|
||||
: init-texture ( -- )
|
||||
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameterf
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameterf ;
|
||||
|
||||
: rect-texture-coords ( -- )
|
||||
float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
|
||||
|
||||
: do-attribs ( bits quot -- )
|
||||
swap glPushAttrib call glPopAttrib ; inline
|
||||
|
||||
: draw-textured-rect ( dim texture -- )
|
||||
GL_TEXTURE_2D [
|
||||
GL_TEXTURE_BIT [
|
||||
GL_TEXTURE_COORD_ARRAY [
|
||||
COLOR: white gl-color
|
||||
GL_TEXTURE_2D swap glBindTexture
|
||||
init-texture rect-texture-coords
|
||||
fill-rect-vertices (gl-fill-rect)
|
||||
GL_TEXTURE_2D 0 glBindTexture
|
||||
] do-enabled-client-state
|
||||
] do-attribs
|
||||
] do-enabled ;
|
||||
|
||||
: circle-steps ( steps -- angles )
|
||||
dup length v/n 2 pi * v*n ;
|
||||
|
||||
|
|
@ -161,18 +139,12 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
|||
: (gen-gl-object) ( quot -- id )
|
||||
[ 1 0 <uint> ] dip keep *uint ; inline
|
||||
|
||||
: gen-texture ( -- id )
|
||||
[ glGenTextures ] (gen-gl-object) ;
|
||||
|
||||
: gen-gl-buffer ( -- id )
|
||||
[ glGenBuffers ] (gen-gl-object) ;
|
||||
|
||||
: (delete-gl-object) ( id quot -- )
|
||||
[ 1 swap <uint> ] dip call ; inline
|
||||
|
||||
: delete-texture ( id -- )
|
||||
[ glDeleteTextures ] (delete-gl-object) ;
|
||||
|
||||
: delete-gl-buffer ( id -- )
|
||||
[ glDeleteBuffers ] (delete-gl-object) ;
|
||||
|
||||
|
|
@ -207,22 +179,6 @@ MACRO: set-draw-buffers ( buffers -- )
|
|||
: gl-look-at ( eye focus up -- )
|
||||
[ first3 ] tri@ gluLookAt ;
|
||||
|
||||
:: make-texture ( dim pixmap format type -- id )
|
||||
gen-texture [
|
||||
GL_TEXTURE_BIT [
|
||||
GL_TEXTURE_2D swap glBindTexture
|
||||
GL_TEXTURE_2D
|
||||
0
|
||||
GL_RGBA
|
||||
dim first2
|
||||
0
|
||||
format
|
||||
type
|
||||
pixmap
|
||||
glTexImage2D
|
||||
] do-attribs
|
||||
] keep ;
|
||||
|
||||
: gen-dlist ( -- id ) 1 glGenLists ;
|
||||
|
||||
: make-dlist ( type quot -- id )
|
||||
|
|
|
|||
|
|
@ -1,29 +1,9 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs cache colors.constants destructors fry
|
||||
kernel opengl opengl.gl combinators ;
|
||||
opengl.textures kernel ;
|
||||
IN: opengl.texture-cache
|
||||
|
||||
TUPLE: texture texture display-list disposed ;
|
||||
|
||||
: make-texture-display-list ( dim texture -- dlist )
|
||||
GL_COMPILE [ draw-textured-rect ] make-dlist ;
|
||||
|
||||
TUPLE: texture-info dim bitmap format type ;
|
||||
|
||||
C: <texture-info> texture-info
|
||||
|
||||
: <texture> ( info -- texture )
|
||||
[
|
||||
{ [ dim>> ] [ bitmap>> ] [ format>> ] [ type>> ] }
|
||||
cleave make-texture
|
||||
] [ dim>> ] bi
|
||||
over make-texture-display-list f texture boa ;
|
||||
|
||||
M: texture dispose*
|
||||
[ texture>> delete-texture ]
|
||||
[ display-list>> delete-dlist ] bi ;
|
||||
|
||||
TUPLE: texture-cache renderer cache disposed ;
|
||||
|
||||
: <texture-cache> ( renderer -- cache )
|
||||
|
|
@ -31,7 +11,7 @@ TUPLE: texture-cache renderer cache disposed ;
|
|||
swap >>renderer
|
||||
<cache-assoc> >>cache ;
|
||||
|
||||
GENERIC: render-texture ( key renderer -- texture-info )
|
||||
GENERIC: render-texture ( key renderer -- image )
|
||||
|
||||
: get-texture ( key texture-cache -- texture )
|
||||
dup check-disposed
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
IN: opengl.textures
|
||||
USING: help.markup help.syntax opengl.gl math alien ;
|
||||
|
||||
HELP: gen-texture
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ;
|
||||
|
||||
HELP: delete-texture
|
||||
{ $values { "id" integer } }
|
||||
{ $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ;
|
||||
|
||||
HELP: make-texture
|
||||
{ $values { "dim" "a pair of integers" } { "pixmap" c-ptr } { "format" "an OpenGL texture format, for example " { $link GL_UNSIGNED_BYTE } } { "type" "an OpenGL texture type, for example " { $link GL_RGBA } } { "id" "an OpenGL texture ID" } }
|
||||
{ $description "Creates a new OpenGL texture from a pixmap image whose dimensions are equal to " { $snippet "dim" } "." } ;
|
||||
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test opengl.textures ;
|
||||
IN: opengl.textures.tests
|
||||
|
|
@ -0,0 +1,81 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs cache colors.constants destructors fry
|
||||
kernel opengl opengl.gl combinators images endian
|
||||
specialized-arrays.float locals sequences ;
|
||||
IN: opengl.textures
|
||||
|
||||
: init-texture ( -- )
|
||||
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameterf
|
||||
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameterf ;
|
||||
|
||||
: rect-texture-coords ( -- )
|
||||
float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
|
||||
|
||||
: gen-texture ( -- id )
|
||||
[ glGenTextures ] (gen-gl-object) ;
|
||||
|
||||
:: make-texture ( dim pixmap format type -- id )
|
||||
gen-texture [
|
||||
GL_TEXTURE_BIT [
|
||||
GL_TEXTURE_2D swap glBindTexture
|
||||
GL_TEXTURE_2D
|
||||
0
|
||||
GL_RGBA
|
||||
dim first2
|
||||
0
|
||||
format
|
||||
type
|
||||
pixmap
|
||||
glTexImage2D
|
||||
] do-attribs
|
||||
] keep ;
|
||||
|
||||
: draw-textured-rect ( dim texture -- )
|
||||
GL_TEXTURE_2D [
|
||||
GL_TEXTURE_BIT [
|
||||
GL_TEXTURE_COORD_ARRAY [
|
||||
COLOR: white gl-color
|
||||
GL_TEXTURE_2D swap glBindTexture
|
||||
init-texture rect-texture-coords
|
||||
fill-rect-vertices (gl-fill-rect)
|
||||
GL_TEXTURE_2D 0 glBindTexture
|
||||
] do-enabled-client-state
|
||||
] do-attribs
|
||||
] do-enabled ;
|
||||
|
||||
: delete-texture ( id -- )
|
||||
[ glDeleteTextures ] (delete-gl-object) ;
|
||||
|
||||
TUPLE: texture texture display-list disposed ;
|
||||
|
||||
: make-texture-display-list ( dim texture -- dlist )
|
||||
GL_COMPILE [ draw-textured-rect ] make-dlist ;
|
||||
|
||||
GENERIC: component-order>format ( component-order -- format )
|
||||
|
||||
M: RGBA component-order>format drop GL_RGBA ;
|
||||
M: BGRA component-order>format drop GL_BGRA_EXT ;
|
||||
|
||||
: byte-order>type ( byte-order -- format )
|
||||
native-endianness eq?
|
||||
GL_UNSIGNED_INT_8_8_8_8_REV
|
||||
GL_UNSIGNED_BYTE
|
||||
? ;
|
||||
|
||||
: <texture> ( image -- texture )
|
||||
[
|
||||
{
|
||||
[ dim>> ]
|
||||
[ bitmap>> ]
|
||||
[ component-order>> component-order>format ]
|
||||
[ byte-order>> byte-order>type ]
|
||||
} cleave make-texture
|
||||
] [ dim>> ] bi
|
||||
over make-texture-display-list f texture boa ;
|
||||
|
||||
M: texture dispose*
|
||||
[ texture>> delete-texture ]
|
||||
[ display-list>> delete-dlist ] bi ;
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces cache images accessors assocs kernel
|
||||
opengl opengl.gl opengl.texture-cache ui.gadgets.worlds ;
|
||||
USING: namespaces cache images images.loader accessors assocs kernel
|
||||
opengl opengl.gl opengl.textures opengl.texture-cache ui.gadgets.worlds ;
|
||||
IN: ui.images
|
||||
|
||||
TUPLE: image-name path ;
|
||||
|
|
@ -17,17 +17,16 @@ image-cache [ <cache-assoc> ] initialize
|
|||
PRIVATE>
|
||||
|
||||
: cached-image ( image-name -- image )
|
||||
path>> image-cache get [ <image> ] cache ;
|
||||
path>> image-cache get [ load-image ] cache ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SINGLETON: image-renderer
|
||||
|
||||
M: image-renderer render-texture
|
||||
drop
|
||||
cached-image
|
||||
[ dim>> ] [ bitmap>> ] bi
|
||||
GL_RGBA GL_UNSIGNED_BYTE <texture-info> ;
|
||||
drop cached-image ;
|
||||
|
||||
SLOT: images
|
||||
|
||||
: image-texture-cache ( world -- texture-cache )
|
||||
[ [ image-renderer <texture-cache> ] unless* ] change-images
|
||||
|
|
|
|||
|
|
@ -14,13 +14,12 @@ M: core-text-renderer init-text-rendering
|
|||
core-text-renderer <texture-cache> >>text-handle drop ;
|
||||
|
||||
M: core-text-renderer string-dim
|
||||
[ " " string-dim { 0 1 } v* ] [ cached-line dim>> ] if-empty ;
|
||||
[ " " string-dim { 0 1 } v* ]
|
||||
[ cached-line image>> dim>> ]
|
||||
if-empty ;
|
||||
|
||||
M: core-text-renderer render-texture
|
||||
drop first2 cached-line
|
||||
[ dim>> ] [ bitmap>> ] bi
|
||||
GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV
|
||||
<texture-info> ;
|
||||
drop first2 cached-line image>> ;
|
||||
|
||||
M: core-text-renderer finish-text-rendering
|
||||
text-handle>> purge-texture-cache
|
||||
|
|
|
|||
Loading…
Reference in New Issue