Abstract out images.memory from core-graphics vocab
parent
500d6eddb5
commit
51fdd23248
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.destructors alien.syntax accessors
|
USING: alien alien.c-types alien.destructors alien.syntax accessors
|
||||||
destructors fry kernel math math.bitwise sequences libc colors
|
destructors fry kernel math math.bitwise sequences libc colors
|
||||||
images core-graphics.types core-foundation.utilities ;
|
images images.memory core-graphics.types core-foundation.utilities ;
|
||||||
IN: core-graphics
|
IN: core-graphics
|
||||||
|
|
||||||
! CGImageAlphaInfo
|
! CGImageAlphaInfo
|
||||||
|
@ -110,12 +110,6 @@ FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pnam
|
||||||
: bitmap-flags ( -- flags )
|
: bitmap-flags ( -- flags )
|
||||||
{ kCGImageAlphaPremultipliedFirst kCGBitmapByteOrder32Host } flags ;
|
{ kCGImageAlphaPremultipliedFirst kCGBitmapByteOrder32Host } flags ;
|
||||||
|
|
||||||
: bitmap-size ( dim -- n )
|
|
||||||
product "uint" heap-size * ;
|
|
||||||
|
|
||||||
: malloc-bitmap-data ( dim -- alien )
|
|
||||||
bitmap-size 1 calloc &free ;
|
|
||||||
|
|
||||||
: bitmap-color-space ( -- color-space )
|
: bitmap-color-space ( -- color-space )
|
||||||
CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease ;
|
CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease ;
|
||||||
|
|
||||||
|
@ -124,16 +118,6 @@ FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pnam
|
||||||
bitmap-color-space bitmap-flags CGBitmapContextCreate
|
bitmap-color-space bitmap-flags CGBitmapContextCreate
|
||||||
[ "CGBitmapContextCreate failed" throw ] unless* ;
|
[ "CGBitmapContextCreate failed" throw ] unless* ;
|
||||||
|
|
||||||
: bitmap-data ( bitmap dim -- data )
|
|
||||||
[ CGBitmapContextGetData ] [ bitmap-size ] bi*
|
|
||||||
memory>byte-array ;
|
|
||||||
|
|
||||||
: <bitmap-image> ( bitmap dim -- image )
|
|
||||||
<image>
|
|
||||||
swap >>dim
|
|
||||||
swap >>bitmap
|
|
||||||
little-endian? ARGB BGRA ? >>component-order ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: dummy-context ( -- context )
|
: dummy-context ( -- context )
|
||||||
|
@ -142,7 +126,4 @@ PRIVATE>
|
||||||
] initialize-alien ;
|
] initialize-alien ;
|
||||||
|
|
||||||
: make-bitmap-image ( dim quot -- image )
|
: make-bitmap-image ( dim quot -- image )
|
||||||
[
|
'[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap ; inline
|
||||||
[ [ [ malloc-bitmap-data ] keep <CGBitmapContext> &CGContextRelease ] keep ] dip
|
|
||||||
[ nip call ] [ drop [ bitmap-data ] keep <bitmap-image> ] 3bi
|
|
||||||
] with-destructors ; inline
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1,31 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors alien.c-types destructors fry images kernel
|
||||||
|
libc math sequences ;
|
||||||
|
IN: images.memory
|
||||||
|
|
||||||
|
! Some code shared by core-graphics and cairo for constructing
|
||||||
|
! images from off-screen graphics contexts. There is probably
|
||||||
|
! no reason to call it directly.
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: bitmap-size ( dim -- n ) product "uint" heap-size * ;
|
||||||
|
|
||||||
|
: malloc-bitmap-data ( dim -- alien ) bitmap-size 1 calloc &free ;
|
||||||
|
|
||||||
|
: bitmap-data ( alien dim -- data ) bitmap-size memory>byte-array ;
|
||||||
|
|
||||||
|
: <bitmap-image> ( alien dim -- image )
|
||||||
|
[ bitmap-data ] keep
|
||||||
|
<image>
|
||||||
|
swap >>dim
|
||||||
|
swap >>bitmap
|
||||||
|
little-endian? ARGB BGRA ? >>component-order ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: make-memory-bitmap ( dim quot -- image )
|
||||||
|
'[
|
||||||
|
[ malloc-bitmap-data ] keep _ [ <bitmap-image> ] 2bi
|
||||||
|
] with-destructors ; inline
|
Loading…
Reference in New Issue