basis/images/loader/cocoa/cocoa.factor

   1 ! Copyright (C) 2010, 2011 Joe Groff, Slava Pestov.
   2 ! See https://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
  10
  11 SINGLETON: ns-image
  12
  13 FUNCTION: CFDictionaryRef UTTypeCopyDeclaration ( CFStringRef inUTI )
  14
  15 <<
  16
  17 : supported-ns-images ( -- seq )
  18     NSImage -> imageTypes [ CF>string ] NSFastEnumeration-map ;
  19
  20 : supported-ns-images-utt ( -- seq )
  21     NSImage -> imageTypes
  22     [ [ CF>string ] NSFastEnumeration-map ]
  23     [ [ UTTypeCopyDeclaration (plist-NSDictionary>) ] NSFastEnumeration-map ] bi zip ;
  24
  25 : supported-ns-image-extensions ( -- seq )
  26     supported-ns-images-utt
  27     [ "UTTypeTagSpecification" of dup [ "public.filename-extension" of ] when ] assoc-map values concat ;
  28
  29 >>
  30
  31 os macosx? [
  32     os-version first 11 < [
  33         { "png" "tif" "tiff" "gif" "jpg" "jpeg" "bmp" "ico" "webp" }
  34     ] [
  35         supported-ns-image-extensions
  36     ] if [ ns-image register-image-class ] each
  37 ] when
  38
  39 : <CGImage> ( byte-array -- image-rep )
  40     [ NSBitmapImageRep ] dip
  41     <CFData> -> autorelease
  42     -> imageRepWithData:
  43     -> CGImage ;
  44
  45 :: CGImage>image ( image -- image )
  46     image CGImageGetWidth :> w
  47     image CGImageGetHeight :> h
  48     { w h } [
  49         0 0 w h <CGRect> image CGContextDrawImage
  50     ] make-bitmap-image ;
  51
  52 : image>CGImage ( image -- image )
  53     [ bitmap>> ] [ dim>> first2 ] bi 8 pick 4 *
  54     bitmap-color-space bitmap-flags
  55     CGBitmapContextCreate -> autorelease
  56     CGBitmapContextCreateImage ;
  57
  58 M: ns-image stream>image*
  59     drop stream-contents <CGImage> CGImage>image ;
  60
  61 :: save-ns-image ( image path type -- )
  62     [
  63         path f <CFFileSystemURL> &CFRelease
  64         type 1 f CGImageDestinationCreateWithURL &CFRelease
  65         [
  66             image image>CGImage &CFRelease
  67             f CGImageDestinationAddImage
  68         ] [
  69             CGImageDestinationFinalize drop
  70         ] bi
  71     ] with-destructors ;