1 ! Copyright (C) 2010, 2011 Joe Groff, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.syntax assocs cocoa cocoa.classes
4 cocoa.enumeration cocoa.plists.private core-foundation
5 core-foundation.data core-foundation.dictionaries
6 core-foundation.strings core-foundation.urls core-graphics
7 core-graphics.private core-graphics.types destructors
8 images.loader io kernel math sequences system system-info ;
9 IN: images.loader.cocoa
13 FUNCTION: CFDictionaryRef UTTypeCopyDeclaration ( CFStringRef inUTI )
17 : supported-ns-images ( -- seq )
18 NSImage -> imageTypes [ CF>string ] NSFastEnumeration-map ;
20 : supported-ns-images-utt ( -- seq )
22 [ [ CF>string ] NSFastEnumeration-map ]
23 [ [ UTTypeCopyDeclaration (plist-NSDictionary>) ] NSFastEnumeration-map ] bi zip ;
25 : supported-ns-image-extensions ( -- seq )
26 supported-ns-images-utt
27 [ "UTTypeTagSpecification" of dup [ "public.filename-extension" of ] when ] assoc-map values concat ;
32 os-version first 11 < [
33 { "png" "tif" "tiff" "gif" "jpg" "jpeg" "bmp" "ico" "webp" }
35 supported-ns-image-extensions
36 ] if [ ns-image register-image-class ] each
39 : <CGImage> ( byte-array -- image-rep )
40 [ NSBitmapImageRep ] dip
41 <CFData> -> autorelease
45 :: CGImage>image ( image -- image )
46 image CGImageGetWidth :> w
47 image CGImageGetHeight :> h
49 0 0 w h <CGRect> image CGContextDrawImage
52 : image>CGImage ( image -- image )
53 [ bitmap>> ] [ dim>> first2 ] bi 8 pick 4 *
54 bitmap-color-space bitmap-flags
55 CGBitmapContextCreate -> autorelease
56 CGBitmapContextCreateImage ;
58 M: ns-image stream>image*
59 drop stream-contents <CGImage> CGImage>image ;
61 :: save-ns-image ( image path type -- )
63 path f <CFFileSystemURL> &CFRelease
64 type 1 f CGImageDestinationCreateWithURL &CFRelease
66 image image>CGImage &CFRelease
67 f CGImageDestinationAddImage
69 CGImageDestinationFinalize drop