Debugging Core Text, get colored text working and fix memory manageme…

…nt issue

basis/cocoa/cocoa-tests.factor

@@ -1,7 +1,7 @@
 IN: cocoa.tests
 USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
 compiler kernel namespaces cocoa.classes tools.test memory
-compiler.units math ;
+compiler.units math core-graphics.types ;
 
 CLASS: {
     { +superclass+ "NSObject" }
@@ -15,15 +15,15 @@ CLASS: {
 
 : test-foo
     Foo -> alloc -> init
-    dup 1.0 2.0 101.0 102.0 <NSRect> -> foo:
+    dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
     -> release ;
 
 test-foo
 
-[ 1.0 ] [ "x" get NSRect-x ] unit-test
-[ 2.0 ] [ "x" get NSRect-y ] unit-test
-[ 101.0 ] [ "x" get NSRect-w ] unit-test
-[ 102.0 ] [ "x" get NSRect-h ] unit-test
+[ 1.0 ] [ "x" get CGRect-x ] unit-test
+[ 2.0 ] [ "x" get CGRect-y ] unit-test
+[ 101.0 ] [ "x" get CGRect-w ] unit-test
+[ 102.0 ] [ "x" get CGRect-h ] unit-test
 
 CLASS: {
     { +superclass+ "NSObject" }
@@ -41,18 +41,18 @@ Bar [
     -> release
 ] compile-call
 
-[ 1.0 ] [ "x" get NSRect-x ] unit-test
-[ 2.0 ] [ "x" get NSRect-y ] unit-test
-[ 101.0 ] [ "x" get NSRect-w ] unit-test
-[ 102.0 ] [ "x" get NSRect-h ] unit-test
+[ 1.0 ] [ "x" get CGRect-x ] unit-test
+[ 2.0 ] [ "x" get CGRect-y ] unit-test
+[ 101.0 ] [ "x" get CGRect-w ] unit-test
+[ 102.0 ] [ "x" get CGRect-h ] unit-test
 
 ! Make sure that we can add methods
 CLASS: {
     { +superclass+ "NSObject" }
     { +name+ "Bar" }
 } {
     "bar"
-    "NSRect"
+    "CGRect"
     { "id" "SEL" }
     [ 2drop test-foo "x" get ]
 } {

basis/cocoa/enumeration/enumeration.factor

@@ -8,12 +8,11 @@ IN: cocoa.enumeration
 : NS-EACH-BUFFER-SIZE 16 ; inline
 
 : with-enumeration-buffers ( quot -- )
-    [
-        [
-            "NSFastEnumerationState" malloc-object &free
-            NS-EACH-BUFFER-SIZE "id" heap-size * malloc-object &free
-            NS-EACH-BUFFER-SIZE
-        ] dip call
+    '[
+        "NSFastEnumerationState" malloc-object &free
+        NS-EACH-BUFFER-SIZE "id" malloc-array &free
+        NS-EACH-BUFFER-SIZE
+        @
     ] with-destructors ; inline
 
 :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )

basis/cocoa/plists/plists-tests.factor

@@ -0,0 +1,10 @@
+IN: cocoa.plists.tests
+USING: tools.test cocoa.plists colors kernel hashtables
+core-foundation.utilities core-foundation destructors
+assocs cocoa.enumeration ;
+
+[
+    [ V{ } ] [ H{ } >cf &CFRelease [ ] NSFastEnumeration-map ] unit-test
+    [ V{ "A" } ] [ { "A" } >cf &CFRelease plist> ] unit-test
+    [ H{ { "A" "B" } } ] [ "B" "A" associate >cf &CFRelease plist> ] unit-test
+] with-destructors

basis/cocoa/plists/plists.factor

@@ -29,10 +29,10 @@ DEFER: plist>
     dup -> length <byte-array> [ -> getBytes: ] keep ;
 
 : (plist-NSArray>) ( NSArray -- vector )
-    [ plist> ] NSFastEnumeration-map ;    
+    [ plist> ] NSFastEnumeration-map ;
 
 : (plist-NSDictionary>) ( NSDictionary -- hashtable )
-    dup [ [ -> valueForKey: ] keep swap [ plist> ] bi@ 2array ] with
+    dup [ tuck -> valueForKey: [ plist> ] bi@ 2array ] with
     NSFastEnumeration-map >hashtable ;
 
 : (read-plist) ( NSData -- id )

basis/colors/colors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2009 Slava Pestov.
 ! Copyright (C) 2008 Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors ;
+USING: kernel accessors combinators ;
 IN: colors
 
 TUPLE: color ;
@@ -18,6 +18,9 @@ M: color red>> ( color -- red   ) >rgba red>> ;
 M: color green>> ( color -- green ) >rgba green>> ;
 M: color blue>> ( color -- blue  ) >rgba blue>> ;
 
+: >rgba-components ( object -- r g b a )
+    >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; inline
+
 CONSTANT: black T{ rgba f 0.0 0.0 0.0 1.0 }
 CONSTANT: blue T{ rgba f 0.0 0.0 1.0 1.0 }
 CONSTANT: cyan T{ rgba f 0 0.941 0.941 1 }

basis/core-foundation/dictionaries/dictionaries.factor

@@ -27,6 +27,6 @@ FUNCTION: void* CFDictionaryGetValue (
     [ kCFAllocatorDefault ] dip
     unzip [ >void*-array ] bi@
     [ [ underlying>> ] bi@ ] [ nip length ] 2bi
-    &: kCFTypeDictionaryCallBacks
-    &: kCFTypeDictionaryValueCallbacks
+    &: kCFTypeDictionaryKeyCallBacks
+    &: kCFTypeDictionaryValueCallBacks
     CFDictionaryCreate ;

basis/core-graphics/core-graphics.factor

@@ -1,8 +1,8 @@
 ! 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 math sequences libc
-core-graphics.types ;
+destructors fry kernel math sequences libc colors
+core-graphics.types core-foundation.utilities ;
 IN: core-graphics
 
 ! CGImageAlphaInfo
@@ -25,6 +25,18 @@ kCGImageAlphaNoneSkipFirst ;
 : kCGBitmapByteOrder16Big ( -- n ) 3 12 shift ; inline
 : kCGBitmapByteOrder32Big ( -- n ) 4 12 shift ; inline
 
+FUNCTION: CGColorRef CGColorCreateGenericRGB (
+   CGFloat red,
+   CGFloat green,
+   CGFloat blue,
+   CGFloat alpha
+) ;
+
+: <CGColor> ( color -- CGColor )
+    >rgba-components CGColorCreateGenericRGB ;
+
+M: color (>cf) <CGColor> ;
+
 FUNCTION: CGColorSpaceRef CGColorSpaceCreateDeviceRGB ( ) ;
 
 FUNCTION: CGContextRef CGBitmapContextCreate (

basis/core-graphics/types/types.factor

@@ -69,6 +69,7 @@ C-STRUCT: CGAffineTransform
     { "CGFloat" "tx" }
     { "CGFloat" "ty" } ;
 
+TYPEDEF: void* CGColorRef
 TYPEDEF: void* CGColorSpaceRef
 TYPEDEF: void* CGContextRef
 TYPEDEF: uint CGBitmapInfo

basis/core-text/core-text-tests.factor

@@ -3,11 +3,12 @@
 USING: tools.test core-text core-foundation
 core-foundation.dictionaries destructors
 arrays kernel generalizations math accessors
-combinators hashtables ;
+core-foundation.utilities
+combinators hashtables colors ;
 IN: core-text.tests
 
-: test-font ( name -- object )
-    kCTFontFamilyNameAttribute associate <CTFont> ;
+: test-font ( name -- font )
+    [ >cf &CFRelease 0.0 f CTFontCreateWithName ] with-destructors ;
 
 [ ] [ "Helvetica" test-font CFRelease ] unit-test
 
@@ -20,7 +21,7 @@ IN: core-text.tests
 
 : test-typographic-bounds ( string font -- ? )
     [
-        test-font &CFRelease <CTLine> &CFRelease
+        test-font &CFRelease white <CTLine> &CFRelease
         line-typographic-bounds {
             [ width>> float? ]
             [ ascent>> float? ]

basis/core-text/core-text.factor

@@ -3,7 +3,7 @@
 USING: arrays alien alien.c-types alien.syntax kernel
 destructors words parser accessors fry words hashtables
 sequences memoize assocs math math.functions locals init
-core-foundation core-foundation.strings
+namespaces colors core-foundation core-foundation.strings
 core-foundation.attributed-strings core-foundation.utilities
 core-graphics core-graphics.types ;
 IN: core-text
@@ -69,13 +69,6 @@ FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
    CGAffineTransform* matrix
 ) ;
 
-: <CTFont> ( attrs -- font )
-    [
-        >cf &CFRelease
-        CTFontDescriptorCreateWithAttributes &CFRelease
-        0.0 f CTFontCreateWithFontDescriptor
-    ] with-destructors ;
-
 C-GLOBAL: kCTFontAttributeName
 C-GLOBAL: kCTKernAttributeName
 C-GLOBAL: kCTLigatureAttributeName
@@ -105,9 +98,12 @@ FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
    uint32_t symTraitMask
 ) ;
 
-: <CTLine> ( string font -- line )
+: <CTLine> ( string font color -- line )
     [
-        kCTFontAttributeName associate <CFAttributedString> &CFRelease
+        [
+            kCTForegroundColorAttributeName set
+            kCTFontAttributeName set
+        ] H{ } make-assoc <CFAttributedString> &CFRelease
         CTLineCreateWithAttributedString
     ] with-destructors ;
 
@@ -132,17 +128,14 @@ TUPLE: line string font line bounds dim bitmap age disposed ;
 : <line> ( string font -- line )
     [
         CFRetain |CFRelease
-        2dup <CTLine> |CFRelease
+        2dup white <CTLine> |CFRelease
         dup line-typographic-bounds
         dup bounds>dim 3dup [ draw-line ] with-bitmap-context
         0 f line boa
     ] with-destructors ;
 
 M: line dispose*
-    [
-        [ font>> &CFRelease drop ]
-        [ line>> &CFRelease drop ] bi
-    ] with-destructors ;
+    [ font>> ] [ line>> ] bi 2array dispose-each ;
 
 <PRIVATE
 

basis/opengl/opengl.factor

@@ -10,12 +10,9 @@ generalizations locals fry specialized-arrays.float
 specialized-arrays.uint ;
 IN: opengl
 
-: color>raw ( object -- r g b a )
-    >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; inline
+: gl-color ( color -- ) >rgba-components glColor4d ; inline
 
-: gl-color ( color -- ) color>raw glColor4d ; inline
-
-: gl-clear-color ( color -- ) color>raw glClearColor ;
+: gl-clear-color ( color -- ) >rgba-components glClearColor ;
 
 : gl-clear ( color -- )
     gl-clear-color GL_COLOR_BUFFER_BIT glClear ;

basis/ui/cocoa/text/text.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors alien core-graphics.types core-text kernel
-hashtables namespaces sequences ui.gadgets.worlds ui.render
-opengl opengl.gl destructors combinators core-foundation
-core-foundation.strings io.styles memoize math ;
+hashtables namespaces sequences ui.gadgets.worlds ui.text
+ui.text.private opengl opengl.gl destructors combinators core-foundation
+core-foundation.strings io.styles memoize math math.vectors ;
 IN: ui.cocoa.text
 
 SINGLETON: core-text-renderer
@@ -34,7 +34,7 @@ CONSTANT: font-names
     [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
     CTFontCreateCopyWithSymbolicTraits
     dup [ [ CFRelease ] dip ] [ drop ] if ;
-    
+
 MEMO: cache-font ( font -- open-font )
     [
         [
@@ -46,14 +46,8 @@ MEMO: cache-font ( font -- open-font )
 M: core-text-renderer open-font
     dup alien? [ cache-font ] unless ;
 
-: string-dim ( open-font string -- dim )
-    swap cached-line dim>> ;
-
-M: core-text-renderer string-width ( open-font string -- w )
-    string-dim first ;
-
-M: core-text-renderer string-height ( open-font string -- h )
-    [ " " ] when-empty string-dim second ;
+M: core-text-renderer string-dim
+    [ " " string-dim { 0 1 } v* ] [ swap cached-line dim>> ] if-empty ;
 
 TUPLE: line-texture line texture age disposed ;
 
@@ -82,7 +76,13 @@ M: core-text-renderer draw-string ( font string loc -- )
     [ swap open-font line-texture draw-line-texture ] with-translation ;
 
 M: core-text-renderer x>offset ( x font string -- n )
-    swap open-font cached-line line>> swap 0 <CGPoint> CTLineGetStringIndexForPosition ;
+    [ 2drop 0 ] [
+        swap open-font cached-line line>>
+        swap 0 <CGPoint> CTLineGetStringIndexForPosition
+    ] if-empty ;
+
+M: core-text-renderer offset>x ( n font string -- x )
+    swap open-font cached-line line>> swap f CTLineGetOffsetForStringIndex ;
 
 M: core-text-renderer free-fonts ( fonts -- )
     values dispose-each ;

basis/ui/freetype/freetype.factor

@@ -3,7 +3,7 @@
 USING: alien alien.accessors alien.c-types arrays io kernel libc
 math math.vectors namespaces opengl opengl.gl opengl.sprites assocs
 sequences io.files io.styles continuations freetype
-ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
+ui.gadgets.worlds ui.text ui.text.private ui.backend byte-arrays accessors
 locals specialized-arrays.direct.uchar ;
 IN: ui.freetype
 
@@ -222,4 +222,7 @@ M: freetype-renderer x>offset ( x font string -- n )
     [ run-char-widths [ <= ] with find drop ] keep swap
     [ ] [ length ] ?if ;
 
+M:: freetype-renderer offset>x ( n font string -- x )
+    font open-font string n head string-width ;
+
 freetype-renderer font-renderer set-global

basis/ui/gadgets/editors/editors.factor

@@ -6,8 +6,8 @@ math.vectors sorting colors combinators assocs math.order fry
 calendar alarms continuations ui.clipboards ui.commands
 ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme
-ui.gadgets.menus ui.gadgets.wrappers ui.render ui.gestures
-math.geometry.rect ;
+ui.gadgets.menus ui.gadgets.wrappers ui.render ui.text
+ui.gestures math.geometry.rect ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget
@@ -132,10 +132,8 @@ M: editor ungraft*
 : unfocus-editor ( editor -- )
     [ stop-blinking ] [ f >>focused? relayout-1 ] bi ;
 
-: offset>x ( col# line# editor -- x )
-    [ editor-line ] keep font>> spin head text-width ;
-
-: loc>x ( loc editor -- x ) [ first2 swap ] dip offset>x ;
+: loc>x ( loc editor -- x )
+    [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x ;
 
 : line>y ( lines# editor -- y )
     line-height * ;
@@ -224,7 +222,7 @@ M: editor ungraft*
 
 : draw-selected-line ( start end n -- )
     [ start/end-on-line ] keep
-    tuck [ editor get offset>x ] 2bi@
+    tuck [ swap 2array editor get loc>x ] 2bi@
     (draw-selection) ;
 
 : draw-selection ( -- )

basis/ui/gadgets/labels/labels.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hashtables io kernel math namespaces
 make opengl sequences strings splitting ui.gadgets
-ui.gadgets.tracks ui.gadgets.theme ui.render colors models ;
+ui.gadgets.tracks ui.gadgets.theme ui.render
+ui.text colors models ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.

basis/ui/gadgets/tables/tables.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays colors fry io.styles kernel math
 math.geometry.rect math.order math.vectors namespaces opengl
 sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar
-ui.gadgets.worlds ui.gadgets.theme ui.gestures ui.render
+ui.gadgets.worlds ui.gadgets.theme ui.gestures ui.render ui.text
 ui.gadgets.menus models math.ranges sequences combinators ;
 IN: ui.gadgets.tables
 

basis/ui/gadgets/worlds/worlds-docs.factor

@@ -1,5 +1,6 @@
-USING: ui.gadgets ui.render ui.gestures ui.backend help.markup
-help.syntax models opengl opengl.sprites strings ;
+USING: ui.gadgets ui.render ui.text ui.text.private
+ui.gestures ui.backend help.markup help.syntax
+models opengl opengl.sprites strings ;
 IN: ui.gadgets.worlds
 
 HELP: user-input