More work on Core Text binding

db4
Slava Pestov 2009-01-19 22:30:32 -06:00
parent fd7a47613e
commit 12d693f3fb
7 changed files with 76 additions and 43 deletions

View File

@ -1,29 +0,0 @@
USING: math help.markup help.syntax ;
IN: cocoa.types
HELP: <NSRect>
{ $values { "x" real } { "y" real } { "w" real } { "h" real } { "rect" "an " { $snippet "NSRect" } } }
{ $description "Allocates a new " { $snippet "NSRect" } " in the Factor heap." } ;
HELP: <NSPoint>
{ $values { "x" real } { "y" real } { "point" "an " { $snippet "NSPoint" } } }
{ $description "Allocates a new " { $snippet "NSPoint" } " in the Factor heap." } ;
HELP: <NSSize>
{ $values { "w" real } { "h" real } { "size" "an " { $snippet "NSSize" } } }
{ $description "Allocates a new " { $snippet "NSSize" } " in the Factor heap." } ;
ARTICLE: "cocoa-types" "Cocoa types"
"The Cocoa binding defines some common C structs:"
{ $code
"NSRect"
"NSPoint"
"NSSize"
}
"Some words for working with the above:"
{ $subsection <NSRect> }
{ $subsection <NSPoint> }
{ $subsection <NSSize> } ;
IN: cocoa.types
ABOUT: "cocoa-types"

View File

@ -3,4 +3,4 @@
USING: tools.test core-graphics kernel byte-arrays ;
IN: core-graphics.tests
[ t ] [ 100 200 [ drop ] with-bitmap-context byte-array? ] unit-test
[ t ] [ { 100 200 } [ drop ] with-bitmap-context byte-array? ] unit-test

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.destructors alien.syntax
destructors fry kernel locals math sequences
destructors fry kernel math sequences
core-graphics.types ;
IN: core-graphics
@ -69,15 +69,15 @@ FUNCTION: void CGContextSetTextPosition (
FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
:: <CGBitmapContext> ( data w h -- context )
: <CGBitmapContext> ( data dim -- context )
[
data w h 8 w 4 *
[ first2 8 ] keep first 4 *
CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease
kCGImageAlphaPremultipliedLast CGBitmapContextCreate
] with-destructors ;
: with-bitmap-context ( w h quot -- data )
: with-bitmap-context ( dim quot -- data )
'[
[ * "uint" <c-array> ] 2keep
[ <CGBitmapContext> &CGContextRelease @ ] [ 2drop ] 3bi
[ product "uint" <c-array> ] keep
[ <CGBitmapContext> &CGContextRelease @ ] [ drop ] 2bi
] with-destructors ; inline

View File

@ -8,6 +8,9 @@ IN: core-graphics.types
: <CGFloat> ( x -- alien )
cell 4 = [ <float> ] [ <double> ] if ; inline
: *CGFloat ( alien -- x )
cell 4 = [ *float ] [ *double ] if ; inline
C-STRUCT: CGPoint
{ "CGFloat" "x" }
{ "CGFloat" "y" } ;

View File

@ -2,14 +2,33 @@
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test core-text core-foundation
core-foundation.dictionaries destructors
arrays kernel ;
arrays kernel generalizations math accessors
combinators ;
IN: core-text.tests
[ ] [ "Helvetica" 12 <CTFont> CFRelease ] unit-test
: test-font ( -- object )
"Helvetica" 12 <CTFont> ;
[ ] [ test-font CFRelease ] unit-test
[ ] [
[
kCTFontAttributeName "Helvetica" 64 <CTFont> &CFRelease 2array 1array
kCTFontAttributeName test-font &CFRelease 2array 1array
<CFDictionary> &CFRelease drop
] with-destructors
] unit-test
] unit-test
: test-typographic-bounds ( string -- ? )
[
test-font &CFRelease <CTLine> &CFRelease
line-typographic-bounds {
[ width>> float? ]
[ ascent>> float? ]
[ descent>> float? ]
[ leading>> float? ]
} cleave and and and
] with-destructors ;
[ t ] [ "Hello world" test-typographic-bounds ] unit-test
[ t ] [ "日本語" test-typographic-bounds ] unit-test

View File

@ -1,9 +1,10 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel destructors
parser accessors fry words
USING: arrays alien alien.c-types alien.syntax kernel destructors
parser accessors fry words hashtables sequences math math.functions locals
core-foundation core-foundation.strings
core-foundation.attributed-strings ;
core-foundation.attributed-strings
core-graphics core-graphics.types ;
IN: core-text
TYPEDEF: void* CTLineRef
@ -49,3 +50,42 @@ FUNCTION: CFIndex CTLineGetStringIndexForPosition ( CTLineRef line, CGPoint posi
FUNCTION: double CTLineGetTypographicBounds ( CTLineRef line, CGFloat* ascent, CGFloat* descent, CGFloat* leading ) ;
FUNCTION: CGRect CTLineGetImageBounds ( CTLineRef line, CGContextRef context ) ;
: <CTLine> ( string font -- line )
[
kCTFontAttributeName associate <CFAttributedString> &CFRelease
CTLineCreateWithAttributedString
] with-destructors ;
TUPLE: typographic-bounds width ascent descent leading ;
: line-typographic-bounds ( line -- typographic-bounds )
0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
[ CTLineGetTypographicBounds ] 3keep [ *CGFloat ] tri@
typographic-bounds boa ;
TUPLE: line string font line bounds dim bitmap disposed ;
: bounds>dim ( bounds -- dim )
[ width>> ] [ [ ascent>> ] [ descent>> ] bi + ] bi
[ ceiling >fixnum ]
bi@ 2array ;
:: draw-line ( line bounds context -- )
context 0.0 bounds descent>> CGContextSetTextPosition
line context CTLineDraw ;
: <line> ( string font -- line )
[
CFRetain |CFRelease
2dup <CTLine> |CFRelease
dup line-typographic-bounds
dup bounds>dim 3dup [ draw-line ] with-bitmap-context
f line boa
] with-destructors ;
M: line dispose*
[
[ font>> &CFRelease drop ]
[ line>> &CFRelease drop ] bi
] with-destructors ;