| 
									
										
										
										
											2009-01-16 18:44:46 -05:00
										 |  |  | ! Copyright (C) 2009 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2009-02-20 21:53:51 -05:00
										 |  |  | USING: alien alien.c-types alien.destructors alien.syntax accessors | 
					
						
							| 
									
										
										
										
											2009-01-29 23:07:51 -05:00
										 |  |  | destructors fry kernel math math.bitwise sequences libc colors | 
					
						
							| 
									
										
										
										
											2009-02-27 00:29:39 -05:00
										 |  |  | images images.memory core-graphics.types core-foundation.utilities ;
 | 
					
						
							| 
									
										
										
										
											2009-01-16 18:44:46 -05:00
										 |  |  | IN: core-graphics | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! CGImageAlphaInfo | 
					
						
							|  |  |  | C-ENUM: | 
					
						
							|  |  |  | kCGImageAlphaNone | 
					
						
							|  |  |  | kCGImageAlphaPremultipliedLast | 
					
						
							|  |  |  | kCGImageAlphaPremultipliedFirst | 
					
						
							|  |  |  | kCGImageAlphaLast | 
					
						
							|  |  |  | kCGImageAlphaFirst | 
					
						
							|  |  |  | kCGImageAlphaNoneSkipLast | 
					
						
							|  |  |  | kCGImageAlphaNoneSkipFirst ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : kCGBitmapAlphaInfoMask ( -- n ) HEX: 1f ; inline
 | 
					
						
							|  |  |  | : kCGBitmapFloatComponents ( -- n ) 1 8 shift ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : kCGBitmapByteOrderMask ( -- n ) HEX: 7000 ; inline
 | 
					
						
							|  |  |  | : kCGBitmapByteOrderDefault ( -- n ) 0 12 shift ; inline
 | 
					
						
							|  |  |  | : kCGBitmapByteOrder16Little ( -- n ) 1 12 shift ; inline
 | 
					
						
							|  |  |  | : kCGBitmapByteOrder32Little ( -- n ) 2 12 shift ; inline
 | 
					
						
							|  |  |  | : kCGBitmapByteOrder16Big ( -- n ) 3 12 shift ; inline
 | 
					
						
							|  |  |  | : kCGBitmapByteOrder32Big ( -- n ) 4 12 shift ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-29 23:07:51 -05:00
										 |  |  | : kCGBitmapByteOrder16Host ( -- n )
 | 
					
						
							|  |  |  |     little-endian? | 
					
						
							|  |  |  |     kCGBitmapByteOrder16Little | 
					
						
							|  |  |  |     kCGBitmapByteOrder16Big ? ; foldable
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : kCGBitmapByteOrder32Host ( -- n )
 | 
					
						
							|  |  |  |     little-endian? | 
					
						
							|  |  |  |     kCGBitmapByteOrder32Little | 
					
						
							|  |  |  |     kCGBitmapByteOrder32Big ? ; foldable
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-21 20:34:42 -05:00
										 |  |  | FUNCTION: CGColorRef CGColorCreateGenericRGB (
 | 
					
						
							|  |  |  |    CGFloat red, | 
					
						
							|  |  |  |    CGFloat green, | 
					
						
							|  |  |  |    CGFloat blue, | 
					
						
							|  |  |  |    CGFloat alpha | 
					
						
							|  |  |  | ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <CGColor> ( color -- CGColor )
 | 
					
						
							|  |  |  |     >rgba-components CGColorCreateGenericRGB ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: color (>cf) <CGColor> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-16 18:44:46 -05:00
										 |  |  | FUNCTION: CGColorSpaceRef CGColorSpaceCreateDeviceRGB ( ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTION: CGContextRef CGBitmapContextCreate (
 | 
					
						
							|  |  |  |    void* data, | 
					
						
							|  |  |  |    size_t width, | 
					
						
							|  |  |  |    size_t height, | 
					
						
							|  |  |  |    size_t bitsPerComponent, | 
					
						
							|  |  |  |    size_t bytesPerRow, | 
					
						
							|  |  |  |    CGColorSpaceRef colorspace, | 
					
						
							|  |  |  |    CGBitmapInfo bitmapInfo | 
					
						
							|  |  |  | ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTION: void CGColorSpaceRelease ( CGColorSpaceRef ref ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-16 23:37:56 -05:00
										 |  |  | DESTRUCTOR: CGColorSpaceRelease | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTION: void CGContextRelease ( CGContextRef ref ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | DESTRUCTOR: CGContextRelease | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-16 18:44:46 -05:00
										 |  |  | FUNCTION: void CGContextSetRGBStrokeColor (
 | 
					
						
							|  |  |  |    CGContextRef c, | 
					
						
							|  |  |  |    CGFloat red, | 
					
						
							|  |  |  |    CGFloat green, | 
					
						
							|  |  |  |    CGFloat blue, | 
					
						
							|  |  |  |    CGFloat alpha | 
					
						
							|  |  |  | ) ;
 | 
					
						
							|  |  |  |    | 
					
						
							|  |  |  | FUNCTION: void CGContextSetRGBFillColor (
 | 
					
						
							|  |  |  |    CGContextRef c, | 
					
						
							|  |  |  |    CGFloat red, | 
					
						
							|  |  |  |    CGFloat green, | 
					
						
							|  |  |  |    CGFloat blue, | 
					
						
							|  |  |  |    CGFloat alpha | 
					
						
							| 
									
										
										
										
											2009-01-16 20:11:48 -05:00
										 |  |  | ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTION: void CGContextSetTextPosition (
 | 
					
						
							|  |  |  |    CGContextRef c, | 
					
						
							|  |  |  |    CGFloat x, | 
					
						
							|  |  |  |    CGFloat y | 
					
						
							| 
									
										
										
										
											2009-01-16 23:37:56 -05:00
										 |  |  | ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-29 23:07:51 -05:00
										 |  |  | FUNCTION: void CGContextFillRect (
 | 
					
						
							|  |  |  |    CGContextRef c, | 
					
						
							|  |  |  |    CGRect rect | 
					
						
							|  |  |  | ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTION: void CGContextSetShouldSmoothFonts (
 | 
					
						
							|  |  |  |    CGContextRef c, | 
					
						
							|  |  |  |    bool shouldSmoothFonts | 
					
						
							|  |  |  | ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-21 00:06:23 -05:00
										 |  |  | FUNCTION: void* CGBitmapContextGetData ( CGContextRef c ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-24 02:21:10 -05:00
										 |  |  | CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-21 00:06:23 -05:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-29 23:07:51 -05:00
										 |  |  | : bitmap-flags ( -- flags )
 | 
					
						
							|  |  |  |     { kCGImageAlphaPremultipliedFirst kCGBitmapByteOrder32Host } flags ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : bitmap-color-space ( -- color-space )
 | 
					
						
							|  |  |  |     CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-20 21:53:51 -05:00
										 |  |  | : <CGBitmapContext> ( data dim -- context )
 | 
					
						
							|  |  |  |     [ first2 8 ] [ first 4 * ] bi
 | 
					
						
							| 
									
										
										
										
											2009-01-29 23:07:51 -05:00
										 |  |  |     bitmap-color-space bitmap-flags CGBitmapContextCreate | 
					
						
							| 
									
										
										
										
											2009-01-21 00:06:23 -05:00
										 |  |  |     [ "CGBitmapContextCreate failed" throw ] unless* ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							| 
									
										
										
										
											2009-01-16 23:37:56 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-20 21:53:51 -05:00
										 |  |  | : dummy-context ( -- context )
 | 
					
						
							|  |  |  |     \ dummy-context [ | 
					
						
							|  |  |  |         [ 4 malloc { 1 1 } <CGBitmapContext> ] with-destructors | 
					
						
							|  |  |  |     ] initialize-alien ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-13 20:11:07 -05:00
										 |  |  | : make-bitmap-image ( dim quot -- image )
 | 
					
						
							| 
									
										
										
										
											2009-02-28 02:31:51 -05:00
										 |  |  |     '[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap | 
					
						
							|  |  |  |     ARGB >>component-order ; inline
 |