basis/core-graphics/core-graphics.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types alien.destructors alien.syntax accessors
   4 destructors fry kernel math math.bitwise sequences libc colors
   5 images core-graphics.types core-foundation.utilities ;
   6 IN: core-graphics
   7
   8 ! CGImageAlphaInfo
   9 C-ENUM:
  10 kCGImageAlphaNone
  11 kCGImageAlphaPremultipliedLast
  12 kCGImageAlphaPremultipliedFirst
  13 kCGImageAlphaLast
  14 kCGImageAlphaFirst
  15 kCGImageAlphaNoneSkipLast
  16 kCGImageAlphaNoneSkipFirst ;
  17
  18 : kCGBitmapAlphaInfoMask ( -- n ) HEX: 1f ; inline
  19 : kCGBitmapFloatComponents ( -- n ) 1 8 shift ; inline
  20
  21 : kCGBitmapByteOrderMask ( -- n ) HEX: 7000 ; inline
  22 : kCGBitmapByteOrderDefault ( -- n ) 0 12 shift ; inline
  23 : kCGBitmapByteOrder16Little ( -- n ) 1 12 shift ; inline
  24 : kCGBitmapByteOrder32Little ( -- n ) 2 12 shift ; inline
  25 : kCGBitmapByteOrder16Big ( -- n ) 3 12 shift ; inline
  26 : kCGBitmapByteOrder32Big ( -- n ) 4 12 shift ; inline
  27
  28 : kCGBitmapByteOrder16Host ( -- n )
  29     little-endian?
  30     kCGBitmapByteOrder16Little
  31     kCGBitmapByteOrder16Big ? ; foldable
  32
  33 : kCGBitmapByteOrder32Host ( -- n )
  34     little-endian?
  35     kCGBitmapByteOrder32Little
  36     kCGBitmapByteOrder32Big ? ; foldable
  37
  38 FUNCTION: CGColorRef CGColorCreateGenericRGB (
  39    CGFloat red,
  40    CGFloat green,
  41    CGFloat blue,
  42    CGFloat alpha
  43 ) ;
  44
  45 : <CGColor> ( color -- CGColor )
  46     >rgba-components CGColorCreateGenericRGB ;
  47
  48 M: color (>cf) <CGColor> ;
  49
  50 FUNCTION: CGColorSpaceRef CGColorSpaceCreateDeviceRGB ( ) ;
  51
  52 FUNCTION: CGContextRef CGBitmapContextCreate (
  53    void* data,
  54    size_t width,
  55    size_t height,
  56    size_t bitsPerComponent,
  57    size_t bytesPerRow,
  58    CGColorSpaceRef colorspace,
  59    CGBitmapInfo bitmapInfo
  60 ) ;
  61
  62 FUNCTION: void CGColorSpaceRelease ( CGColorSpaceRef ref ) ;
  63
  64 DESTRUCTOR: CGColorSpaceRelease
  65
  66 FUNCTION: void CGContextRelease ( CGContextRef ref ) ;
  67
  68 DESTRUCTOR: CGContextRelease
  69
  70 FUNCTION: void CGContextSetRGBStrokeColor (
  71    CGContextRef c,
  72    CGFloat red,
  73    CGFloat green,
  74    CGFloat blue,
  75    CGFloat alpha
  76 ) ;
  77
  78 FUNCTION: void CGContextSetRGBFillColor (
  79    CGContextRef c,
  80    CGFloat red,
  81    CGFloat green,
  82    CGFloat blue,
  83    CGFloat alpha
  84 ) ;
  85
  86 FUNCTION: void CGContextSetTextPosition (
  87    CGContextRef c,
  88    CGFloat x,
  89    CGFloat y
  90 ) ;
  91
  92 FUNCTION: void CGContextFillRect (
  93    CGContextRef c,
  94    CGRect rect
  95 ) ;
  96
  97 FUNCTION: void CGContextSetShouldSmoothFonts (
  98    CGContextRef c,
  99    bool shouldSmoothFonts
 100 ) ;
 101
 102 FUNCTION: void* CGBitmapContextGetData ( CGContextRef c ) ;
 103
 104 CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
 105
 106 FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
 107
 108 <PRIVATE
 109
 110 : bitmap-flags ( -- flags )
 111     { kCGImageAlphaPremultipliedFirst kCGBitmapByteOrder32Host } flags ;
 112
 113 : bitmap-size ( dim -- n )
 114     product "uint" heap-size * ;
 115
 116 : malloc-bitmap-data ( dim -- alien )
 117     bitmap-size 1 calloc &free ;
 118
 119 : bitmap-color-space ( -- color-space )
 120     CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease ;
 121
 122 : <CGBitmapContext> ( data dim -- context )
 123     [ first2 8 ] [ first 4 * ] bi
 124     bitmap-color-space bitmap-flags CGBitmapContextCreate
 125     [ "CGBitmapContextCreate failed" throw ] unless* ;
 126
 127 : bitmap-data ( bitmap dim -- data )
 128     [ CGBitmapContextGetData ] [ bitmap-size ] bi*
 129     memory>byte-array ;
 130
 131 : <bitmap-image> ( bitmap dim -- image )
 132     <image>
 133         swap >>dim
 134         swap >>bitmap
 135         little-endian? ARGB BGRA ? >>component-order ;
 136
 137 PRIVATE>
 138
 139 : dummy-context ( -- context )
 140     \ dummy-context [
 141         [ 4 malloc { 1 1 } <CGBitmapContext> ] with-destructors
 142     ] initialize-alien ;
 143
 144 : make-bitmap-image ( dim quot -- image )
 145     [
 146         [ [ [ malloc-bitmap-data ] keep <CGBitmapContext> &CGContextRelease ] keep ] dip
 147         [ nip call ] [ drop [ bitmap-data ] keep <bitmap-image> ] 3bi
 148     ] with-destructors ; inline