Abstract out images.memory from core-graphics vocab

basis/core-graphics/core-graphics.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.destructors alien.syntax accessors
 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
 
 ! CGImageAlphaInfo
@@ -110,12 +110,6 @@ FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pnam
 : bitmap-flags ( -- 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 )
     CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease ;
 
@@ -124,16 +118,6 @@ FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pnam
     bitmap-color-space bitmap-flags CGBitmapContextCreate
     [ "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>
 
 : dummy-context ( -- context )
@@ -142,7 +126,4 @@ PRIVATE>
     ] initialize-alien ;
 
 : 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

basis/images/memory/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/images/memory/memory.factor

@@ -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