steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

new accessors

db4
Doug Coleman 2008-08-29 16:42:12 -05:00
parent 9febce42e6
commit 8f84b4ba32
2 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/opengl/opengl-docs.factor
View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax io kernel math quotations USING: help.markup help.syntax io kernel math quotations
opengl.gl assocs vocabs.loader sequences ; opengl.gl assocs vocabs.loader sequences accessors ;
IN: opengl IN: opengl
HELP: gl-color HELP: gl-color
@ -91,17 +91,17 @@ HELP: do-attribs
HELP: sprite HELP: sprite
{ $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:" { $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:"
{ $list { $list
{ { $link sprite-dlist } " - an OpenGL display list ID" } { { $link dlist>> } " - an OpenGL display list ID" }
{ { $link sprite-texture } " - an OpenGL texture ID" } { { $link texture>> } " - an OpenGL texture ID" }
{ { $link sprite-loc } " - top-left corner of the sprite" } { { $link loc>> } " - top-left corner of the sprite" }
{ { $link sprite-dim } " - dimensions of the sprite" } { { $link dim>> } " - dimensions of the sprite" }
{ { $link sprite-dim2 } " - dimensions of the sprite, rounded up to the nearest powers of two" } { { $link dim2>> } " - dimensions of the sprite, rounded up to the nearest powers of two" }
} }
} ; } ;
HELP: gray-texture HELP: gray-texture
{ $values { "sprite" sprite } { "pixmap" "an alien or byte array" } { "id" "an OpenGL texture ID" } } { $values { "sprite" sprite } { "pixmap" "an alien or byte array" } { "id" "an OpenGL texture ID" } }
{ $description "Creates a new OpenGL texture from a 1 byte per pixel image whose dimensions are equal to " { $link sprite-dim2 } "." } ; { $description "Creates a new OpenGL texture from a 1 byte per pixel image whose dimensions are equal to " { $snippet "dim2" } "." } ;
HELP: gen-dlist HELP: gen-dlist
{ $values { "id" integer } } { $values { "id" integer } }

18
basis/opengl/opengl.factor
View File

@ -180,9 +180,9 @@ TUPLE: sprite loc dim dim2 dlist texture ;
: <sprite> ( loc dim dim2 -- sprite ) : <sprite> ( loc dim dim2 -- sprite )
f f sprite boa ; f f sprite boa ;
: sprite-size2 ( sprite -- w h ) sprite-dim2 first2 ; : sprite-size2 ( sprite -- w h ) dim2>> first2 ;
: sprite-width ( sprite -- w ) sprite-dim first ; : sprite-width ( sprite -- w ) dim>> first ;
: gray-texture ( sprite pixmap -- id ) : gray-texture ( sprite pixmap -- id )
gen-texture [ gen-texture [
@ -223,10 +223,10 @@ PRIVATE>
dup top-left dup top-right dup bottom-right bottom-left ; dup top-left dup top-right dup bottom-right bottom-left ;
: draw-sprite ( sprite -- ) : draw-sprite ( sprite -- )
dup sprite-loc gl-translate dup loc>> gl-translate
GL_TEXTURE_2D over sprite-texture glBindTexture GL_TEXTURE_2D over texture>> glBindTexture
init-texture init-texture
GL_QUADS [ sprite-dim2 four-sides ] do-state GL_QUADS [ dim2>> four-sides ] do-state
GL_TEXTURE_2D 0 glBindTexture ; GL_TEXTURE_2D 0 glBindTexture ;
: rect-vertices ( lower-left upper-right -- ) : rect-vertices ( lower-left upper-right -- )
@ -243,14 +243,14 @@ PRIVATE>
] do-matrix ; ] do-matrix ;
: init-sprite ( texture sprite -- ) : init-sprite ( texture sprite -- )
[ set-sprite-texture ] keep swap >>texture
[ make-sprite-dlist ] keep set-sprite-dlist ; dup make-sprite-dlist >>dlist drop ;
: delete-dlist ( id -- ) 1 glDeleteLists ; : delete-dlist ( id -- ) 1 glDeleteLists ;
: free-sprite ( sprite -- ) : free-sprite ( sprite -- )
dup sprite-dlist delete-dlist [ dlist>> delete-dlist ]
sprite-texture delete-texture ; [ texture>> delete-texture ] bi ;
: free-sprites ( sprites -- ) : free-sprites ( sprites -- )
[ nip [ free-sprite ] when* ] assoc-each ; [ nip [ free-sprite ] when* ] assoc-each ;