New with-malloc combinator

slava 2006-07-04 21:24:15 +00:00
parent 5d475b64b1
commit 7610aa1587
2 changed files with 6 additions and 5 deletions

View File

@ -11,3 +11,7 @@ FUNCTION: void* realloc ( void* ptr, ulong size ) ;
FUNCTION: void memcpy ( void* dst, void* src, ulong size ) ;
: check-ptr [ "Out of memory" throw ] unless* ;
: with-malloc ( size quot -- | quot: alien -- )
swap 1 calloc dup check-ptr
[ swap call ] keep free ; inline

View File

@ -117,9 +117,6 @@ C: font ( handle -- font )
load-glyph dup
FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ;
: with-locked-block ( size quot -- | quot: address -- )
swap 1 calloc [ alien-address swap call ] keep free ; inline
: copy-pixel ( bit tex -- bit tex )
255 f pick set-alien-unsigned-1 1+
f pick alien-unsigned-1
@ -145,8 +142,8 @@ C: font ( handle -- font )
#! Given a glyph bitmap, copy it to a texture with the given
#! width/height (which must be powers of two).
tuck sprite-size2 * 2 * [
[ copy-bitmap ] keep <alien> gray-texture
] with-locked-block ;
alien-address [ copy-bitmap ] keep <alien> gray-texture
] with-malloc ;
: glyph-texture-loc ( glyph font -- loc )
over glyph-hori-bearing-x ft-floor -rot