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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
library/compiler/alien/malloc.factor
View File

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

7
library/ui/freetype/freetype-gl.factor
View File

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