Merge remote-tracking branch 'upstream/master'

basis/core-graphics/core-graphics.factor

@@ -99,6 +99,20 @@ FUNCTION: void CGContextSetShouldSmoothFonts (
    bool shouldSmoothFonts
 ) ;
 
+FUNCTION: void CGContextDrawImage (
+   CGContextRef c,
+   CGRect rect,
+   CGImageRef image
+) ;
+
+FUNCTION: size_t CGImageGetWidth (
+   CGImageRef image
+) ;
+
+FUNCTION: size_t CGImageGetHeight (
+   CGImageRef image
+) ;
+
 FUNCTION: void* CGBitmapContextGetData ( CGContextRef c ) ;
 
 CONSTANT: kCGLRendererGenericFloatID HEX: 00020400

basis/core-graphics/types/types.factor

@@ -76,6 +76,8 @@ STRUCT: CGAffineTransform
 TYPEDEF: void* CGColorRef
 TYPEDEF: void* CGColorSpaceRef
 TYPEDEF: void* CGContextRef
+TYPEDEF: void* CGImageRef
+
 TYPEDEF: uint CGBitmapInfo
 
 TYPEDEF: int CGLError

basis/images/cocoa/cocoa.factor

@@ -1,7 +1,9 @@
-! (c)2010 Joe Groff bsd license
+! Copyright (C) 2010, 2011 Joe Groff, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.data cocoa cocoa.classes cocoa.messages
-combinators core-foundation.data core-graphics.types fry images
+combinators core-foundation.data core-graphics
-images.loader io kernel math sequences ;
+core-graphics.types fry locals images images.loader io kernel
+math sequences ;
 IN: images.cocoa
 
 SINGLETON: ns-image
@@ -44,23 +46,18 @@ ERROR: ns-image-planar-images-not-supported ;
 
 PRIVATE>
 
-: load-image-rep ( -- image-rep )
+: <CGImage> ( byte-array -- image-rep )
-    NSBitmapImageRep contents <CFData> -> autorelease -> imageRepWithData:
+    [ NSBitmapImageRep ] dip
-    NSColorSpace -> genericRGBColorSpace
+    <CFData> -> autorelease
-    NSColorRenderingIntentDefault
+    -> imageRepWithData:
-    -> bitmapImageRepByConvertingToColorSpace:renderingIntent: ;
+    -> CGImage ;
 
-: image-rep>image ( image-rep -- image )
+:: CGImage>image ( image -- image )
-    image new swap {
+    image CGImageGetWidth :> w
-        [ -> size CGSize>dim [ >integer ] map >>dim ]
+    image CGImageGetHeight :> h
-        [ -> bitmapData ]
+    { w h } [
-        [ -> bytesPerPlane memory>byte-array >>bitmap ]
+        0 0 w h <CGRect> image CGContextDrawImage
-    } cleave
+    ] make-bitmap-image ;
-        RGBA >>component-order
-        ubyte-components >>component-type
-        t >>premultiplied-alpha?
-        f >>upside-down? ;
 
 M: ns-image stream>image
-    drop
+    drop stream-contents <CGImage> CGImage>image ;
-    [ load-image-rep ] with-input-stream image-rep>image ;