New alien.destructors vocab defines a functor which generalizes &CFRelease; flesh...

diff --git a/basis/alien/destructors/authors.txt b/basis/alien/destructors/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
+++ b/basis/alien/destructors/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file

diff --git a/basis/alien/destructors/destructors-tests.factor b/basis/alien/destructors/destructors-tests.factor
new file mode 100644 (file)
index 0000000..4f43445
--- /dev/null
+++ b/basis/alien/destructors/destructors-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test alien.destructors ;
+IN: alien.destructors.tests

diff --git a/basis/alien/destructors/destructors.factor b/basis/alien/destructors/destructors.factor
new file mode 100644 (file)
index 0000000..cf72212
--- /dev/null
+++ b/basis/alien/destructors/destructors.factor
@@ -0,0 +1,27 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: functors destructors accessors kernel lexer words ;
+IN: alien.destructors
+
+FUNCTOR: define-destructor ( F -- )
+
+F IS ${F}
+F-destructor DEFINES ${F}-destructor
+&F DEFINES &${F}
+|F DEFINES |${F}
+
+WHERE
+
+TUPLE: F-destructor alien disposed ;
+
+M: F-destructor dispose* alien>> F execute ;
+
+: &F ( alien -- alien )
+    dup f F-destructor boa &dispose drop ; inline
+
+: |F ( alien -- alien )
+    dup f F-destructor boa |dispose drop ; inline
+
+;FUNCTOR
+
+: DESTRUCTOR: scan define-destructor ; parsing
\ No newline at end of file

diff --git a/basis/alien/destructors/summary.txt b/basis/alien/destructors/summary.txt
new file mode 100644 (file)
index 0000000..301655b
--- /dev/null
+++ b/basis/alien/destructors/summary.txt
@@ -0,0 +1 @@
+Functor for defining destructors which call a C function to dispose of resources

diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor
index ec83ba7a8bd5f5f7ba04d4296d09681d7a2ed5e0..617f9ecad80214c5c600e789a78fbe477c710103 100644 (file)
--- a/basis/core-foundation/core-foundation.factor
+++ b/basis/core-foundation/core-foundation.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax destructors accessors kernel ;
+USING: alien.syntax alien.destructors accessors kernel ;
 IN: core-foundation
 
 TYPEDEF: void* CFTypeRef
@@ -20,12 +20,4 @@ FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
 
 FUNCTION: void CFRelease ( CFTypeRef cf ) ;
 
-TUPLE: CFRelease-destructor alien disposed ;
-
-M: CFRelease-destructor dispose* alien>> CFRelease ;
-
-: &CFRelease ( alien -- alien )
-    dup f CFRelease-destructor boa &dispose drop ; inline
-
-: |CFRelease ( alien -- alien )
-    dup f CFRelease-destructor boa |dispose drop ; inline
+DESTRUCTOR: CFRelease
\ No newline at end of file

diff --git a/basis/core-graphics/core-graphics-tests.factor b/basis/core-graphics/core-graphics-tests.factor
new file mode 100644 (file)
index 0000000..848e6aa
--- /dev/null
+++ b/basis/core-graphics/core-graphics-tests.factor
@@ -0,0 +1,6 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test core-graphics kernel ;
+IN: core-graphics.tests
+
+[ ] [ 100 200 [ drop ] with-bitmap-context ] unit-test
\ No newline at end of file

diff --git a/basis/core-graphics/core-graphics.factor b/basis/core-graphics/core-graphics.factor
index a215e11d4f267f91f48a48d95ccfbe5e465c6c95..ce3b0f967e09db66b3645600f4caa24ad43684aa 100644 (file)
--- a/basis/core-graphics/core-graphics.factor
+++ b/basis/core-graphics/core-graphics.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax math ;
+USING: alien.syntax alien.c-types alien.destructors math
+locals fry sequences destructors kernel ;
 IN: core-graphics
 
 TYPEDEF: void* CGColorSpaceRef
@@ -42,6 +43,12 @@ FUNCTION: CGContextRef CGBitmapContextCreate (
 
 FUNCTION: void CGColorSpaceRelease ( CGColorSpaceRef ref ) ;
 
+DESTRUCTOR: CGColorSpaceRelease
+
+FUNCTION: void CGContextRelease ( CGContextRef ref ) ;
+
+DESTRUCTOR: CGContextRelease
+
 FUNCTION: void CGContextSetRGBStrokeColor (
    CGContextRef c,
    CGFloat red,
@@ -62,4 +69,17 @@ FUNCTION: void CGContextSetTextPosition (
    CGContextRef c,
    CGFloat x,
    CGFloat y
-) ;
\ No newline at end of file
+) ;
+
+:: <CGBitmapContext> ( data w h -- context )
+    [
+        data w h 8 w 4 *
+        CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease
+        kCGImageAlphaPremultipliedLast CGBitmapContextCreate
+    ] with-destructors ;
+
+: with-bitmap-context ( w h quot -- data )
+    '[
+        [ * "uint" <c-array> ] 2keep
+        [ <CGBitmapContext> &CGContextRelease @ ] [ 2drop ] 3bi
+    ] with-destructors ; inline
\ No newline at end of file

diff --git a/basis/core-text/core-text-tests.factor b/basis/core-text/core-text-tests.factor
index 294f85abc5ee3721cb77b4cbfefe4e063b7186c0..ce943a371d10b05e78867ac939958e80b7cf21cf 100644 (file)
--- a/basis/core-text/core-text-tests.factor
+++ b/basis/core-text/core-text-tests.factor
@@ -1,4 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test core-text ;
+USING: tools.test core-text core-foundation ;
 IN: core-text.tests
+
+[ ] [ "Helvetica" 12 <CTFont> CFRelease ] unit-test
\ No newline at end of file

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index 42faa615bcc9388d7bf585422e2da7afd8a33dbe..f75e972fb58b1315a2496e91781c665789882821 100644 (file)
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -1,10 +1,43 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax core-foundation.attributed-strings ;
+USING: alien alien.c-types alien.syntax kernel destructors
+parser accessors fry words
+core-foundation core-foundation.strings
+core-foundation.attributed-strings ;
 IN: core-text
 
 TYPEDEF: void* CTLineRef
+TYPEDEF: void* CTFontRef
+
+FUNCTION: CTFontRef CTFontCreateWithName (
+   CFStringRef name,
+   CGFloat size,
+   CGAffineTransform* matrix
+) ;
+
+: <CTFont> ( name size -- font )
+    [
+        [ <CFString> &CFRelease ] dip f CTFontCreateWithName
+    ] with-destructors ;
+
+<<
+
+: C-GLOBAL:
+    CREATE-WORD
+    dup name>> '[ _ f dlsym *void* ]
+    (( -- value )) define-declared ; parsing
+
+>>
+
+C-GLOBAL: kCTFontAttributeName
+C-GLOBAL: kCTKernAttributeName
+C-GLOBAL: kCTLigatureAttributeName
+C-GLOBAL: kCTForegroundColorAttributeName
+C-GLOBAL: kCTParagraphStyleAttributeName
+C-GLOBAL: kCTUnderlineStyleAttributeName
+C-GLOBAL: kCTVerticalFormsAttributeName
+C-GLOBAL: kCTGlyphInfoAttributeName
 
 FUNCTION: CTLineRef CTLineCreateWithAttributedString ( CFAttributedStringRef string ) ;
 
-FUNCTION: void CTLineDraw ( CTLineRef line, CGContextRef context ) ;
\ No newline at end of file
+FUNCTION: void CTLineDraw ( CTLineRef line, CGContextRef context ) ;