Add foreground and background color slots to font tuple

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index fd8adc4e78d26441162caddf2fd29010015ee796..9f1e77758c5452cb593fd9634aaac46265f78e41 100644 (file)
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -1,73 +1,15 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays alien alien.c-types alien.syntax kernel
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays alien alien.c-types alien.syntax kernel

-destructors words parser accessors fry words hashtables
+destructors accessors fry words hashtables

 sequences memoize assocs math math.functions locals init
 sequences memoize assocs math math.functions locals init

-namespaces combinators colors core-foundation
+namespaces combinators fonts colors core-foundation

 core-foundation.strings core-foundation.attributed-strings
 core-foundation.strings core-foundation.attributed-strings

-core-foundation.utilities core-graphics core-graphics.types ;
+core-foundation.utilities core-graphics core-graphics.types
+core-text.fonts core-text.utilities ;

 IN: core-text
 
 TYPEDEF: void* CTLineRef
 IN: core-text
 
 TYPEDEF: void* CTLineRef

-TYPEDEF: void* CTFontRef
-TYPEDEF: void* CTFontDescriptorRef
-
-<<
-
-: C-GLOBAL:
-    CREATE-WORD
-    dup name>> '[ _ f dlsym *void* ]
-    (( -- value )) define-declared ; parsing
-
->>
-
-! CTFontSymbolicTraits
-: kCTFontItalicTrait ( -- n ) 0 2^ ; inline
-: kCTFontBoldTrait ( -- n ) 1 2^ ; inline
-: kCTFontExpandedTrait ( -- n ) 5 2^ ; inline
-: kCTFontCondensedTrait ( -- n ) 6 2^ ; inline
-: kCTFontMonoSpaceTrait ( -- n ) 10 2^ ; inline
-: kCTFontVerticalTrait ( -- n ) 11 2^ ; inline
-: kCTFontUIOptimizedTrait ( -- n ) 12 2^ ; inline
-
-C-GLOBAL: kCTFontSymbolicTrait
-C-GLOBAL: kCTFontWeightTrait
-C-GLOBAL: kCTFontWidthTrait
-C-GLOBAL: kCTFontSlantTrait
-
-C-GLOBAL: kCTFontNameAttribute
-C-GLOBAL: kCTFontDisplayNameAttribute
-C-GLOBAL: kCTFontFamilyNameAttribute
-C-GLOBAL: kCTFontStyleNameAttribute
-C-GLOBAL: kCTFontTraitsAttribute
-C-GLOBAL: kCTFontVariationAttribute
-C-GLOBAL: kCTFontSizeAttribute
-C-GLOBAL: kCTFontMatrixAttribute
-C-GLOBAL: kCTFontCascadeListAttribute
-C-GLOBAL: kCTFontCharacterSetAttribute
-C-GLOBAL: kCTFontLanguagesAttribute
-C-GLOBAL: kCTFontBaselineAdjustAttribute
-C-GLOBAL: kCTFontMacintoshEncodingsAttribute
-C-GLOBAL: kCTFontFeaturesAttribute
-C-GLOBAL: kCTFontFeatureSettingsAttribute
-C-GLOBAL: kCTFontFixedAdvanceAttribute
-C-GLOBAL: kCTFontOrientationAttribute
-
-FUNCTION: CTFontDescriptorRef CTFontDescriptorCreateWithAttributes (
-   CFDictionaryRef attributes
-) ;
-
-FUNCTION: CTFontRef CTFontCreateWithName (
-   CFStringRef name,
-   CGFloat size,
-   CGAffineTransform* matrix
-) ;
-
-FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
-   CTFontDescriptorRef descriptor,
-   CGFloat size,
-   CGAffineTransform* matrix
-) ;

 
 C-GLOBAL: kCTFontAttributeName
 C-GLOBAL: kCTKernAttributeName
 
 C-GLOBAL: kCTFontAttributeName
 C-GLOBAL: kCTKernAttributeName


@@ -90,15 +32,7 @@ FUNCTION: double CTLineGetTypographicBounds ( CTLineRef line, CGFloat* ascent, C
 
 FUNCTION: CGRect CTLineGetImageBounds ( CTLineRef line, CGContextRef context ) ;
 
 
 FUNCTION: CGRect CTLineGetImageBounds ( CTLineRef line, CGContextRef context ) ;
 

-FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
-   CTFontRef font,
-   CGFloat size,
-   CGAffineTransform* matrix,
-   uint32_t symTraitValue,
-   uint32_t symTraitMask
-) ;
-
-: <CTLine> ( string font color -- line )
+: <CTLine> ( string open-font color -- line )

     [
         [
             kCTForegroundColorAttributeName set
     [
         [
             kCTForegroundColorAttributeName set


@@ -121,21 +55,21 @@ TUPLE: typographic-bounds width ascent descent leading ;
     [ ceiling >fixnum ]
     bi@ 2array ;
 
     [ ceiling >fixnum ]
     bi@ 2array ;
 

-:: <line> ( string font foreground background -- line )
+:: <line> ( string font -- line )

     [
     [

-        [let* | font [ font CFRetain |CFRelease ]
-                line [ string font foreground <CTLine> |CFRelease ]
+        [let* | open-font [ font cache-font CFRetain |CFRelease ]
+                line [ string open-font font foreground>> <CTLine> |CFRelease ]

                 bounds [ line line-typographic-bounds ]
                 dim [ bounds bounds>dim ] |
             dim [
                 {
                 bounds [ line line-typographic-bounds ]
                 dim [ bounds bounds>dim ] |
             dim [
                 {

-                    [ background >rgba-components CGContextSetRGBFillColor ]
+                    [ font background>> >rgba-components CGContextSetRGBFillColor ]

                     [ 0 0 dim first2 <CGRect> CGContextFillRect ]
                     [ 0 bounds descent>> CGContextSetTextPosition ]
                     [ line swap CTLineDraw ]
                 } cleave
             ] with-bitmap-context
                     [ 0 0 dim first2 <CGRect> CGContextFillRect ]
                     [ 0 bounds descent>> CGContextSetTextPosition ]
                     [ line swap CTLineDraw ]
                 } cleave
             ] with-bitmap-context

-            [ font line bounds dim ] dip 0 0 f
+            [ open-font line bounds dim ] dip 0 0 f

         ]
         line boa
     ] with-destructors ;
         ]
         line boa
     ] with-destructors ;


@@ -151,7 +85,7 @@ M: line dispose* [ font>> CFRelease ] [ line>> CFRelease ] bi ;
 SYMBOL: cached-lines
 
 : cached-line ( string font -- line )
 SYMBOL: cached-lines
 
 : cached-line ( string font -- line )

-    black white 4array cached-lines get [ first4 <line> ] cache ;
+    cached-lines get [ <line> ] 2cache ;

 
 CONSTANT: max-line-age 10
 
 
 CONSTANT: max-line-age 10
 

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

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

diff --git a/basis/core-text/fonts/fonts.factor b/basis/core-text/fonts/fonts.factor
new file mode 100644 (file)
index 0000000..2cc533a
--- /dev/null
+++ b/basis/core-text/fonts/fonts.factor
@@ -0,0 +1,102 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.syntax assocs core-foundation
+core-foundation.strings core-text.utilities destructors init
+kernel math memoize ;
+IN: core-text.fonts
+
+TYPEDEF: void* CTFontRef
+TYPEDEF: void* CTFontDescriptorRef
+
+! CTFontSymbolicTraits
+: kCTFontItalicTrait ( -- n ) 0 2^ ; inline
+: kCTFontBoldTrait ( -- n ) 1 2^ ; inline
+: kCTFontExpandedTrait ( -- n ) 5 2^ ; inline
+: kCTFontCondensedTrait ( -- n ) 6 2^ ; inline
+: kCTFontMonoSpaceTrait ( -- n ) 10 2^ ; inline
+: kCTFontVerticalTrait ( -- n ) 11 2^ ; inline
+: kCTFontUIOptimizedTrait ( -- n ) 12 2^ ; inline
+
+C-GLOBAL: kCTFontSymbolicTrait
+C-GLOBAL: kCTFontWeightTrait
+C-GLOBAL: kCTFontWidthTrait
+C-GLOBAL: kCTFontSlantTrait
+
+C-GLOBAL: kCTFontNameAttribute
+C-GLOBAL: kCTFontDisplayNameAttribute
+C-GLOBAL: kCTFontFamilyNameAttribute
+C-GLOBAL: kCTFontStyleNameAttribute
+C-GLOBAL: kCTFontTraitsAttribute
+C-GLOBAL: kCTFontVariationAttribute
+C-GLOBAL: kCTFontSizeAttribute
+C-GLOBAL: kCTFontMatrixAttribute
+C-GLOBAL: kCTFontCascadeListAttribute
+C-GLOBAL: kCTFontCharacterSetAttribute
+C-GLOBAL: kCTFontLanguagesAttribute
+C-GLOBAL: kCTFontBaselineAdjustAttribute
+C-GLOBAL: kCTFontMacintoshEncodingsAttribute
+C-GLOBAL: kCTFontFeaturesAttribute
+C-GLOBAL: kCTFontFeatureSettingsAttribute
+C-GLOBAL: kCTFontFixedAdvanceAttribute
+C-GLOBAL: kCTFontOrientationAttribute
+
+FUNCTION: CTFontDescriptorRef CTFontDescriptorCreateWithAttributes (
+   CFDictionaryRef attributes
+) ;
+
+FUNCTION: CTFontRef CTFontCreateWithName (
+   CFStringRef name,
+   CGFloat size,
+   CGAffineTransform* matrix
+) ;
+
+FUNCTION: CTFontRef CTFontCreateWithFontDescriptor (
+   CTFontDescriptorRef descriptor,
+   CGFloat size,
+   CGAffineTransform* matrix
+) ;
+
+FUNCTION: CTFontRef CTFontCreateCopyWithSymbolicTraits (
+   CTFontRef font,
+   CGFloat size,
+   CGAffineTransform* matrix,
+   uint32_t symTraitValue,
+   uint32_t symTraitMask
+) ;
+
+CONSTANT: font-names
+    H{
+        { "monospace" "Monaco" }
+        { "sans-serif" "Lucida Grande" }
+        { "serif" "Times" }
+    }
+
+: font-name ( string -- string' )
+    font-names at-default ;
+
+: (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
+
+: (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
+
+: font-traits ( font -- n )
+    [ 0 ] dip
+    [ bold?>> [ (bold) ] when ]
+    [ italic?>> [ (italic) ] when ] bi ;
+
+: apply-font-traits ( font style -- font' )
+    [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
+    CTFontCreateCopyWithSymbolicTraits
+    dup [ [ CFRelease ] dip ] [ drop ] if ;
+
+MEMO: (cache-font) ( font -- open-font )
+    [
+        [
+            [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
+            f CTFontCreateWithName
+        ] keep apply-font-traits
+    ] with-destructors ;
+
+: cache-font ( font -- open-font )
+    clone f >>foreground f >>background (cache-font) ;
+
+[ \ (cache-font) reset-memoized ] "core-text.fonts" add-init-hook

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

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

diff --git a/basis/core-text/utilities/utilities.factor b/basis/core-text/utilities/utilities.factor
new file mode 100644 (file)
index 0000000..59c033f
--- /dev/null
+++ b/basis/core-text/utilities/utilities.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: words parser alien alien.c-types kernel fry ;
+IN: core-text.utilities
+
+: C-GLOBAL:
+    CREATE-WORD
+    dup name>> '[ _ f dlsym *void* ]
+    (( -- value )) define-declared ; parsing

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

diff --git a/basis/fonts/fonts-docs.factor b/basis/fonts/fonts-docs.factor
new file mode 100644 (file)
index 0000000..bfd67d8
--- /dev/null
+++ b/basis/fonts/fonts-docs.factor
@@ -0,0 +1,39 @@
+! Copyright (C) 2009 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel colors ;
+IN: fonts
+
+HELP: <font>
+{ $values { "font" font } }
+{ $description "Creates a new font." } ;
+
+HELP: font
+{ $class-description "The class of fonts." } ;
+
+HELP: font-with-background
+{ $values
+     { "font" font } { "color" color }
+     { "font'" font }
+}
+{ $description "Creates a new font equal to the given font, except with a different " { $slot "background" } " slot." } ;
+
+HELP: font-with-foreground
+{ $values
+     { "font" font } { "color" color }
+     { "font'" font }
+}
+{ $description "Creates a new font equal to the given font, except with a different " { $slot "foreground" } " slot." } ;
+
+ARTICLE: "fonts" "Fonts"
+"The " { $vocab-link "fonts" } " vocabulary implements a data type for fonts that other vocabularies, for example " { $link "ui" } ", can use. A font combines a font name, size, style, and color information into a single object."
+{ $subsection font }
+{ $subsection <font> }
+"Modifying fonts:"
+{ $subsection font-with-foreground }
+{ $subsection font-with-background }
+"Useful constants:"
+{ $subsection monospace-font }
+{ $subsection sans-serif-font }
+{ $subsection serif-font } ;
+
+ABOUT: "fonts"

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

diff --git a/basis/fonts/fonts.factor b/basis/fonts/fonts.factor
new file mode 100644 (file)
index 0000000..4cec03b
--- /dev/null
+++ b/basis/fonts/fonts.factor
@@ -0,0 +1,47 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel colors accessors combinators ;
+IN: fonts
+
+TUPLE: font name size bold? italic? foreground background ;
+
+: <font> ( -- font )
+    font new
+        black >>foreground
+        white >>background ; inline
+
+: font-with-foreground ( font color -- font' )
+    [ clone ] dip >>foreground ; inline
+
+: font-with-background ( font color -- font' )
+    [ clone ] dip >>background ; inline
+
+: reverse-video-font ( font -- font )
+    clone dup
+    [ foreground>> ] [ background>> ] bi
+    [ >>background ] [ >>foreground ] bi* ;
+
+: derive-font ( base font -- font' )
+    [ clone ] dip over {
+        [ [ name>> ] either? >>name ]
+        [ [ size>> ] either? >>size ]
+        [ [ bold?>> ] either? >>bold? ]
+        [ [ italic?>> ] either? >>italic? ]
+        [ [ foreground>> ] either? >>foreground ]
+        [ [ background>> ] either? >>background ]
+    } 2cleave ;
+
+: serif-font ( -- font )
+    <font>
+        "serif" >>name
+        12 >>size ; foldable
+
+: sans-serif-font ( -- font )
+    <font>
+        "sans-serif" >>name
+        12 >>size ; foldable
+
+: monospace-font ( -- font )
+    <font>
+        "monospace" >>name
+        12 >>size ; foldable
\ No newline at end of file

diff --git a/basis/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor
index 4a5f683ae0a3711b8a544edd5d5bcfc9d468687c..a17642ca45125928bf453211d9edf62eb7ce23a2 100644 (file)
--- a/basis/ui/gadgets/editors/editors-docs.factor
+++ b/basis/ui/gadgets/editors/editors-docs.factor
@@ -1,6 +1,6 @@
 USING: documents help.markup help.syntax ui.gadgets
 ui.gadgets.scrollers models strings ui.commands
 USING: documents help.markup help.syntax ui.gadgets
 ui.gadgets.scrollers models strings ui.commands

-ui.text colors ;
+ui.text colors fonts ;

 IN: ui.gadgets.editors
 
 HELP: editor
 IN: ui.gadgets.editors
 
 HELP: editor

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 4699cdc5e664ac8e062a45ac55f51b15e8e7c982..32e124afd7fdcdb24c176c2e218ea36343de5379 100755 (executable)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -7,7 +7,7 @@ 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.text ui.gestures math.geometry.rect
 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.text ui.gestures math.geometry.rect

-splitting unicode.categories ;
+splitting unicode.categories fonts ;

 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget


@@ -534,8 +534,8 @@ TUPLE: multiline-editor < editor ;
 
 : join-lines ( string -- string' )
     "\n" split
 
 : join-lines ( string -- string' )
     "\n" split

-    [ rest-slice [ [ blank? ] trim-left-slice ] change-each ]
-    [ but-last-slice [ [ blank? ] trim-right-slice ] change-each ]
+    [ rest-slice [ [ blank? ] trim-head-slice ] change-each ]
+    [ but-last-slice [ [ blank? ] trim-tail-slice ] change-each ]

     [ " " join ]
     tri ;
 
     [ " " join ]
     tri ;
 

diff --git a/basis/ui/gadgets/grid-lines/grid-lines-docs.factor b/basis/ui/gadgets/grid-lines/grid-lines-docs.factor
index 0838f1ded773c04052dcab04aec0ff09e2cf2a19..73eaca13f0eaab4f1e759344ffa9159307f161f8 100644 (file)
--- a/basis/ui/gadgets/grid-lines/grid-lines-docs.factor
+++ b/basis/ui/gadgets/grid-lines/grid-lines-docs.factor
@@ -1,6 +1,7 @@
 USING: ui.gadgets help.markup help.syntax ui.gadgets.grids
 USING: ui.gadgets help.markup help.syntax ui.gadgets.grids

-ui.render ;
+ui.render colors ;

 IN: ui.gadgets.grid-lines
 
 HELP: grid-lines
 IN: ui.gadgets.grid-lines
 
 HELP: grid-lines

-{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is a color specifier stored in the " { $snippet "color" } " slot." } ;
+{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is an instance of " { $link color } ", stored in the " { $snippet "color" } " slot." }
+{ $notes "See " { $link "colors" } "." } ;

diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor
index ea7394b6f380fb3aa13bd9864d8a7e1dfebff577..5f7ceecfb52f77af7f36561c04b6360170a0deea 100644 (file)
--- a/basis/ui/gadgets/labels/labels.factor
+++ b/basis/ui/gadgets/labels/labels.factor
@@ -2,12 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hashtables io kernel math namespaces
 make opengl sequences strings splitting ui.gadgets
 ! 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
+ui.gadgets.tracks fonts ui.render

 ui.text colors models ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
 ui.text colors models ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.

-TUPLE: label < gadget text font color ;
+TUPLE: label < gadget text font ;

 
 : label-string ( label -- string )
     text>> dup string? [ "\n" join ] unless ; inline
 
 : label-string ( label -- string )
     text>> dup string? [ "\n" join ] unless ; inline


@@ -16,8 +16,7 @@ TUPLE: label < gadget text font color ;
     [ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline
 
 : label-theme ( gadget -- gadget )
     [ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline
 
 : label-theme ( gadget -- gadget )

-    sans-serif-font >>font
-    black >>color ; inline
+    sans-serif-font >>font ; inline

 
 : new-label ( string class -- label )
     new-gadget
 
 : new-label ( string class -- label )
     new-gadget


@@ -31,8 +30,7 @@ M: label pref-dim*
     [ font>> ] [ text>> ] bi text-dim ;
 
 M: label draw-gadget*
     [ font>> ] [ text>> ] bi text-dim ;
 
 M: label draw-gadget*

-    [ color>> gl-color ]
-    [ [ font>> ] [ text>> ] bi origin get draw-text ] bi ;
+    [ font>> ] [ text>> ] bi origin get draw-text ;

 
 M: label gadget-text* label-string % ;
 
 
 M: label gadget-text* label-string % ;
 


@@ -46,12 +44,10 @@ M: label-control model-changed
         swap >>model ;
 
 : text-theme ( gadget -- gadget )
         swap >>model ;
 
 : text-theme ( gadget -- gadget )

-    black >>color

     monospace-font >>font ;
 
 : reverse-video-theme ( label -- label )
     monospace-font >>font ;
 
 : reverse-video-theme ( label -- label )

-    white >>color
-    black solid-interior ;
+    sans-serif-font reverse-video-font >>font ;

 
 GENERIC: >label ( obj -- gadget )
 M: string >label <label> ;
 
 GENERIC: >label ( obj -- gadget )
 M: string >label <label> ;

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index a8ef603de3ae1bde23be31b47fb2a9a52faeff93..b0f2a9f86a4299fd7887b950984efe29f80265b7 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -4,12 +4,12 @@ USING: arrays hashtables io kernel namespaces sequences
 io.styles strings quotations math opengl combinators memoize
 math.vectors sorting splitting assocs classes.tuple models
 continuations destructors accessors math.geometry.rect fry
 io.styles strings quotations math opengl combinators memoize
 math.vectors sorting splitting assocs classes.tuple models
 continuations destructors accessors math.geometry.rect fry

-ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+fonts ui.gadgets ui.gadgets.borders ui.gadgets.buttons

 ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
 ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 ui.text ui.gadgets.presentations ui.gadgets.grids
 ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
 ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 ui.text ui.gadgets.presentations ui.gadgets.grids

-ui.gadgets.grid-lines ;
+ui.gadgets.grid-lines colors ;

 IN: ui.gadgets.panes
 
 TUPLE: pane < pack
 IN: ui.gadgets.panes
 
 TUPLE: pane < pack


@@ -179,44 +179,36 @@ M: pane-stream make-span-stream
 
 ! Character styles
 
 
 ! Character styles
 

-: apply-style ( style gadget key quot -- style gadget )
-    [ pick at ] dip when* ; inline
-
-: apply-foreground-style ( style gadget -- style gadget )
-    foreground [ >>color ] apply-style ;
-
-: apply-background-style ( style gadget -- style gadget )
-    background [ solid-interior ] apply-style ;
-
-MEMO: specified-font ( font style size -- font )
+MEMO: specified-font ( assoc -- font )

     #! We memoize here to avoid creating lots of duplicate font objects.
     #! We memoize here to avoid creating lots of duplicate font objects.

-    [ <font> ] 3dip
-    [ "monospace" or >>name ]
-    [
-        {
-            { f [ ] }
-            { plain [ ] }
-            { bold [ t >>bold? ] }
-            { italic [ t >>italic? ] }
-            { bold-italic [ t >>bold? t >>italic? ] }
-        } case
-    ]
-    [ 12 or >>size ]
-    tri* ;
+    [ <font> ] dip
+    {
+        [ font-name swap at "monospace" or >>name ]
+        [
+            font-style swap at {
+                { f [ ] }
+                { plain [ ] }
+                { bold [ t >>bold? ] }
+                { italic [ t >>italic? ] }
+                { bold-italic [ t >>bold? t >>italic? ] }
+            } case
+        ]
+        [ font-size swap at 12 or >>size ]
+        [ foreground swap at black or >>foreground ]
+        [ background swap at white or >>background ]
+    } cleave ;

 
 : apply-font-style ( style gadget -- style gadget )
 
 : apply-font-style ( style gadget -- style gadget )

-    over
-    [ font-name swap at ]
-    [ font-style swap at ]
-    [ font-size swap at ]
-    tri specified-font >>font ;
+    { font-name font-style font-size foreground background }
+    pick extract-keys specified-font >>font ;
+
+: apply-style ( style gadget key quot -- style gadget )
+    [ pick at ] dip when* ; inline

 
 : apply-presentation-style ( style gadget -- style gadget )
     presented [ <presentation> ] apply-style ;
 
 : style-label ( style gadget -- gadget )
 
 : apply-presentation-style ( style gadget -- style gadget )
     presented [ <presentation> ] apply-style ;
 
 : style-label ( style gadget -- gadget )

-    apply-foreground-style
-    apply-background-style

     apply-font-style
     apply-presentation-style
     nip ; inline
     apply-font-style
     apply-presentation-style
     nip ; inline

diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index bf158ae91b142d696f7fae1884ad1fb5c4f57444..dff4fa682ed610496060f814a3c2436895eb5732 100644 (file)
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -4,7 +4,7 @@ USING: accessors arrays colors fry 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.text
 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.text

-ui.gadgets.menus models math.ranges sequences combinators ;
+ui.gadgets.menus models math.ranges sequences combinators fonts ;

 IN: ui.gadgets.tables
 
 ! Row rendererer protocol
 IN: ui.gadgets.tables
 
 ! Row rendererer protocol

diff --git a/basis/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor
index 4160f6dcc5b4bbb901fb13092314cf00e47f4d6b..965a699a833f9b7a0b91c5a8d702a5b038e91740 100644 (file)
--- a/basis/ui/gadgets/theme/theme.factor
+++ b/basis/ui/gadgets/theme/theme.factor
@@ -57,7 +57,3 @@ IN: ui.gadgets.theme
         T{ gray f 0.43 1.0 }
         T{ gray f 0.5  1.0 }
     } <gradient> ;
         T{ gray f 0.43 1.0 }
         T{ gray f 0.5  1.0 }
     } <gradient> ;

-
-CONSTANT: sans-serif-font T{ font { name "sans-serif" } { size 12 } }
-
-CONSTANT: monospace-font T{ font { name "monospace" } { size 12 } }

diff --git a/basis/ui/render/render-docs.factor b/basis/ui/render/render-docs.factor
index 3fe687e869507574dfb691780b6600b5af7a99f3..b344d7844ddae9d1fac12deba8ce433a366517b6 100644 (file)
--- a/basis/ui/render/render-docs.factor
+++ b/basis/ui/render/render-docs.factor
@@ -1,6 +1,6 @@
 USING: ui.gadgets ui.gestures help.markup help.syntax
 kernel classes strings opengl opengl.gl models
 USING: ui.gadgets ui.gestures help.markup help.syntax
 kernel classes strings opengl opengl.gl models

-math.geometry.rect math ;
+math.geometry.rect math colors ;

 IN: ui.render
 
 HELP: gadget
 IN: ui.render
 
 HELP: gadget


@@ -39,25 +39,27 @@ HELP: draw-boundary
 { $contract "Draws the boundary of a gadget by making OpenGL calls. The " { $snippet "boundary" } " slot may be set to objects implementing this generic word." } ;
 
 HELP: solid
 { $contract "Draws the boundary of a gadget by making OpenGL calls. The " { $snippet "boundary" } " slot may be set to objects implementing this generic word." } ;
 
 HELP: solid

-{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid fill, respectively. The " { $snippet "color" } " slot stores a color specifier." } ;
+{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid fill, respectively. The " { $snippet "color" } " slot stores an instance of " { $link color } "." }
+{ $notes "See " { $link "colors" } "." } ;

 
 HELP: gradient
 
 HELP: gradient

-{ $class-description "A class implementing the " { $link draw-interior } " generic word to draw a smoothly shaded transition between colors. The " { $snippet "colors" } " slot stores a sequence of color specifiers and the gradient is drawn in the direction given by the " { $snippet "orientation" } " slot of the gadget." } ;
+{ $class-description "A class implementing the " { $link draw-interior } " generic word to draw a smoothly shaded transition between colors. The " { $snippet "colors" } " slot stores a sequence of " { $link color } " instances, and the gradient is drawn in the direction given by the " { $snippet "orientation" } " slot of the gadget." }
+{ $notes "See " { $link "colors" } "." } ;

 
 HELP: polygon
 { $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid filled polygon, respectively. Instances of " { $link polygon } " have two slots:"
     { $list
 
 HELP: polygon
 { $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid filled polygon, respectively. Instances of " { $link polygon } " have two slots:"
     { $list

-        { { $snippet "color" } " - a color specifier" }
+        { { $snippet "color" } " - a " { $link color } }

         { { $snippet "points" } " - a sequence of points" }
     }
 } ;
 
 HELP: <polygon>
         { { $snippet "points" } " - a sequence of points" }
     }
 } ;
 
 HELP: <polygon>

-{ $values { "color" "a color specifier" } { "points" "a sequence of points" } { "polygon" polygon } }
+{ $values { "color" color } { "points" "a sequence of points" } { "polygon" polygon } }

 { $description "Creates a new instance of " { $link polygon } "." } ;
 
 HELP: <polygon-gadget>
 { $description "Creates a new instance of " { $link polygon } "." } ;
 
 HELP: <polygon-gadget>

-{ $values { "color" "a color specifier" } { "points" "a sequence of points" } { "gadget" "a new " { $link gadget } } }
+{ $values { "color" color } { "points" "a sequence of points" } { "gadget" "a new " { $link gadget } } }

 { $description "Creates a gadget which is drawn as a solid filled polygon. The gadget's size is the minimum bounding box containing all the points of the polygon." } ;
 
 ARTICLE: "gadgets-polygons" "Polygon gadgets"
 { $description "Creates a gadget which is drawn as a solid filled polygon. The gadget's size is the minimum bounding box containing all the points of the polygon." } ;
 
 ARTICLE: "gadgets-polygons" "Polygon gadgets"


@@ -102,4 +104,4 @@ ARTICLE: "ui-paint-coord" "The UI co-ordinate system"
 $nl
 "Gadgets must not draw outside of their bounding box, however clipping is not enforced by default, for performance reasons. This can be changed by setting the " { $slot "clipped?" } " slot to " { $link t } " in the gadget's constructor." ;
 
 $nl
 "Gadgets must not draw outside of their bounding box, however clipping is not enforced by default, for performance reasons. This can be changed by setting the " { $slot "clipped?" } " slot to " { $link t } " in the gadget's constructor." ;
 

-ABOUT: "ui-paint-custom"
+ABOUT: "ui-paint"

diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor
index 34e2ddfdf7f168e24b23887be140f9ff05e3ff98..35a9f9aed9ff4c77f5d1f9a2049b6b8b9d4f237c 100644 (file)
--- a/basis/ui/text/core-text/core-text.factor
+++ b/basis/ui/text/core-text/core-text.factor
@@ -1,56 +1,20 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 ! 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.text
-ui.text.private opengl opengl.gl destructors combinators core-foundation
-core-foundation.strings memoize math math.vectors init colors ;
+USING: assocs accessors alien core-graphics.types core-text
+core-text.fonts kernel hashtables namespaces sequences
+ui.gadgets.worlds ui.text ui.text.private opengl opengl.gl destructors
+combinators core-foundation core-foundation.strings memoize math
+math.vectors init colors ;

 IN: ui.text.core-text
 
 SINGLETON: core-text-renderer
 
 IN: ui.text.core-text
 
 SINGLETON: core-text-renderer
 

-CONSTANT: font-names
-    H{
-        { "monospace" "Monaco" }
-        { "sans-serif" "Helvetica" }
-        { "serif" "Times" }
-    }
-
-: font-name ( string -- string' )
-    font-names at-default ;
-
-: (bold) ( x -- y ) kCTFontBoldTrait bitor ; inline
-
-: (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
-
-: font-traits ( font -- n )
-    [ 0 ] dip
-    [ bold?>> [ (bold) ] when ]
-    [ italic?>> [ (italic) ] when ] bi ;
-
-: apply-font-traits ( font style -- font' )
-    [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi
-    CTFontCreateCopyWithSymbolicTraits
-    dup [ [ CFRelease ] dip ] [ drop ] if ;
-
-MEMO: cache-font ( font -- open-font )
-    [
-        [
-            [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
-            f CTFontCreateWithName
-        ] keep apply-font-traits
-    ] with-destructors ;
-
-[ \ cache-font reset-memoized ] "ui.text.core-text" add-init-hook
-
-M: core-text-renderer open-font
-    dup alien? [ cache-font ] unless ;
-

 M: core-text-renderer string-dim
     [ " " string-dim { 0 1 } v* ] [ swap cached-line dim>> ] if-empty ;
 
 TUPLE: rendered-line line texture display-list age disposed ;
 
 M: core-text-renderer string-dim
     [ " " string-dim { 0 1 } v* ] [ swap cached-line dim>> ] if-empty ;
 
 TUPLE: rendered-line line texture display-list age disposed ;
 

-: make-line-display-list ( rendered-line texture -- dlist )
+: make-line-display-list ( line texture -- dlist )

     GL_COMPILE [
         GL_TEXTURE_2D [
             GL_TEXTURE_BIT [
     GL_COMPILE [
         GL_TEXTURE_2D [
             GL_TEXTURE_BIT [


@@ -82,8 +46,9 @@ M: rendered-line dispose*
     [ texture>> delete-texture ]
     [ display-list>> delete-dlist ] tri ;
 
     [ texture>> delete-texture ]
     [ display-list>> delete-dlist ] tri ;
 

-: rendered-line ( string open-font -- line-display-list )
-    world get fonts>> [ cached-line <rendered-line> ] 2cache 0 >>age ;
+: rendered-line ( string font -- rendered-line )
+    world get fonts>>
+    [ cached-line <rendered-line> ] 2cache 0 >>age ;

 
 : age-rendered-lines ( world -- )
     [ [ age ] age-assoc ] change-fonts drop ;
 
 : age-rendered-lines ( world -- )
     [ [ age ] age-assoc ] change-fonts drop ;


@@ -93,18 +58,18 @@ M: core-text-renderer finish-text-rendering
 
 M: core-text-renderer draw-string ( font string loc -- )
     [
 
 M: core-text-renderer draw-string ( font string loc -- )
     [

-        swap open-font rendered-line
+        swap rendered-line

         display-list>> glCallList
     ] with-translation ;
 
 M: core-text-renderer x>offset ( x font string -- n )
     [ 2drop 0 ] [
         display-list>> glCallList
     ] with-translation ;
 
 M: core-text-renderer x>offset ( x font string -- n )
     [ 2drop 0 ] [

-        swap open-font cached-line line>>
+        swap cached-line line>>

         swap 0 <CGPoint> CTLineGetStringIndexForPosition
     ] if-empty ;
 
 M: core-text-renderer offset>x ( n font string -- x )
         swap 0 <CGPoint> CTLineGetStringIndexForPosition
     ] if-empty ;
 
 M: core-text-renderer offset>x ( n font string -- x )

-    swap open-font cached-line line>> swap f
+    swap cached-line line>> swap f

     CTLineGetOffsetForStringIndex ;
 
 M: core-text-renderer free-fonts ( fonts -- )
     CTLineGetOffsetForStringIndex ;
 
 M: core-text-renderer free-fonts ( fonts -- )

diff --git a/basis/ui/text/freetype/freetype-docs.factor b/basis/ui/text/freetype/freetype-docs.factor
index d8e18cfe4219077f6571ed13c073e93298ed7720..cf72e9af2f62d86538322999669777474bf4b6fe 100644 (file)
--- a/basis/ui/text/freetype/freetype-docs.factor
+++ b/basis/ui/text/freetype/freetype-docs.factor
@@ -22,25 +22,24 @@ HELP: close-freetype
 { $notes "Do not call this word if you are using the UI." } ;
 
 HELP: open-face
 { $notes "Do not call this word if you are using the UI." } ;
 
 HELP: open-face

-{ $values { "font" font } { "face" "alien pointer to an " { $snippet "FT_Face" } } }
-{ $description "Loads a TrueType font with the requested logical font name and style." }
-{ $notes "This is a low-level word. Call " { $link open-font } " instead." } ;
+{ $values { "font" freetype-font } { "face" "alien pointer to an " { $snippet "FT_Face" } } }
+{ $description "Loads a TrueType font with the requested logical font name and style." } ;

 
 HELP: render-glyph
 
 HELP: render-glyph

-{ $values  { "font" font } { "char" "a non-negative integer" } { "bitmap" alien } }
+{ $values  { "font" freetype-font } { "char" "a non-negative integer" } { "bitmap" alien } }

 { $description "Renders a character and outputs a pointer to the bitmap." } ;
 
 HELP: <char-sprite>
 { $description "Renders a character and outputs a pointer to the bitmap." } ;
 
 HELP: <char-sprite>

-{ $values { "open-font" font } { "char" "a non-negative integer" } { "sprite" sprite } }
+{ $values { "font" freetype-font } { "char" "a non-negative integer" } { "sprite" sprite } }

 { $description "Renders a character to an OpenGL texture and records a display list which draws a quad with this texture. This word allocates native resources which must be freed by " { $link free-sprites } "." } ;
 
 HELP: (draw-string)
 { $description "Renders a character to an OpenGL texture and records a display list which draws a quad with this texture. This word allocates native resources which must be freed by " { $link free-sprites } "." } ;
 
 HELP: (draw-string)

-{ $values { "open-font" font } { "sprites" "a vector of " { $link sprite } " instances" } { "string" string } { "loc" "a pair of integers" } }
+{ $values { "font" freetype-font } { "sprites" "a vector of " { $link sprite } " instances" } { "string" string } { "loc" "a pair of integers" } }

 { $description "Draws a line of text." }
 { $notes "This is a low-level word, UI code should use " { $link draw-string } " or " { $link draw-text } " instead." }
 { $side-effects "sprites" } ;
 
 HELP: run-char-widths
 { $description "Draws a line of text." }
 { $notes "This is a low-level word, UI code should use " { $link draw-string } " or " { $link draw-text } " instead." }
 { $side-effects "sprites" } ;
 
 HELP: run-char-widths

-{ $values { "open-font" font } { "string" string } { "widths" "a sequence of integers" } }
+{ $values { "font" freetype-font } { "string" string } { "widths" "a sequence of integers" } }

 { $description "Outputs a sequence of x co-ordinates of the midpoint of each character in the string." }
 { $notes "This word is used to convert x offsets to document locations, for example when the user moves the caret by clicking the mouse." } ;
 { $description "Outputs a sequence of x co-ordinates of the midpoint of each character in the string." }
 { $notes "This word is used to convert x offsets to document locations, for example when the user moves the caret by clicking the mouse." } ;

diff --git a/basis/ui/text/freetype/freetype.factor b/basis/ui/text/freetype/freetype.factor
index d9031e3878ab3efeea2e386e769efeb782122325..c84dbcce1728c8e73da761321834190352f40242 100644 (file)
--- a/basis/ui/text/freetype/freetype.factor
+++ b/basis/ui/text/freetype/freetype.factor
@@ -107,10 +107,8 @@ SYMBOL: dpi
         swap size>> set-char-size
         init-font ;
 
         swap size>> set-char-size
         init-font ;
 

-M: freetype-renderer open-font ( font -- open-font )
-    dup freetype-font? [
-        freetype drop open-fonts get [ <freetype-font> ] cache
-    ] unless ;
+: open-font ( font -- open-font )
+    freetype drop open-fonts get [ <freetype-font> ] cache ;

 
 : load-glyph ( font char -- glyph )
     [ handle>> dup ] dip 0 FT_Load_Char
 
 : load-glyph ( font char -- glyph )
     [ handle>> dup ] dip 0 FT_Load_Char


@@ -121,11 +119,11 @@ M: freetype-renderer open-font ( font -- open-font )
         dupd load-glyph glyph-hori-advance ft-ceil
     ] cache nip ;
 
         dupd load-glyph glyph-hori-advance ft-ceil
     ] cache nip ;
 

-M: freetype-renderer string-width ( open-font string -- w )
-    [ [ 0 ] dip ] dip [ char-width + ] with each ;
+M: freetype-renderer string-width ( font string -- w )
+    [ [ 0 ] dip open-font ] dip [ char-width + ] with each ;

 
 

-M: freetype-renderer string-height ( open-font string -- h )
-    drop height>> ;
+M: freetype-renderer string-height ( font string -- h )
+    drop open-font height>> ;

 
 : glyph-size ( glyph -- dim )
     [ glyph-hori-advance ft-ceil ]
 
 : glyph-size ( glyph -- dim )
     [ glyph-hori-advance ft-ceil ]

diff --git a/basis/ui/text/text-docs.factor b/basis/ui/text/text-docs.factor
index 8005c778d8e6718fcd9a4990671cc7e3099f0b56..b89d1f71961b2a78d25cf719289978a377eff5bc 100644 (file)
--- a/basis/ui/text/text-docs.factor
+++ b/basis/ui/text/text-docs.factor
@@ -1,14 +1,8 @@
 IN: ui.text
 IN: ui.text

-USING: help.markup help.syntax kernel ui.text.private strings math ;
-
-HELP: open-font
-{ $values { "font" font } { "open-font" object } }
-{ $contract "Loads a font if it has not already been loaded, otherwise outputs the existing font." }
-{ $errors "Throws an error if the font does not exist." }
-{ $notes "This word should not be called by user code. All high-level text rendering words will call " { $link open-font } " automatically." } ;
+USING: help.markup help.syntax kernel ui.text.private strings math fonts ;

 
 HELP: string-width
 
 HELP: string-width

-{ $values { "open-font" "a value output by " { $link open-font } } { "string" string } { "w" "a positive integer" } }
+{ $values { "font" font } { "string" string } { "w" "a positive integer" } }

 { $contract "Outputs the width of a string." }
 { $notes "This is a low-level word; use " { $link text-width } " instead." } ;
 
 { $contract "Outputs the width of a string." }
 { $notes "This is a low-level word; use " { $link text-width } " instead." } ;
 


@@ -17,7 +11,7 @@ HELP: text-width
 { $description "Outputs the width of a piece of text." } ;
 
 HELP: string-height
 { $description "Outputs the width of a piece of text." } ;
 
 HELP: string-height

-{ $values { "open-font" "a value output by " { $link open-font } } { "string" string } { "h" "a positive integer" } }
+{ $values { "font" font } { "string" string } { "h" "a positive integer" } }

 { $contract "Outputs the height of a string." }
 { $notes "This is a low-level word; use " { $link text-height } " instead." } ;
 
 { $contract "Outputs the height of a string." }
 { $notes "This is a low-level word; use " { $link text-height } " instead." } ;
 


@@ -26,7 +20,7 @@ HELP: text-height
 { $description "Outputs the height of a piece of text." } ;
 
 HELP: string-dim
 { $description "Outputs the height of a piece of text." } ;
 
 HELP: string-dim

-{ $values { "open-font" "a value output by " { $link open-font } } { "string" string } { "dim" "a pair of integers" } }
+{ $values { "font" font } { "string" string } { "dim" "a pair of integers" } }

 { $contract "Outputs the dimensions of a string." }
 { $notes "This is a low-level word; use " { $link text-dim } " instead." } ;
 
 { $contract "Outputs the dimensions of a string." }
 { $notes "This is a low-level word; use " { $link text-dim } " instead." } ;
 


@@ -52,7 +46,7 @@ HELP: offset>x
 
 ARTICLE: "text-rendering" "Rendering text"
 "The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X and FreeType on Windows and X11."
 
 ARTICLE: "text-rendering" "Rendering text"
 "The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X and FreeType on Windows and X11."

-$nl
+{ $subsection "fonts" }

 "Measuring text:"
 { $subsection text-dim }
 { $subsection text-width }
 "Measuring text:"
 { $subsection text-dim }
 { $subsection text-width }


@@ -63,7 +57,6 @@ $nl
 "Rendering text:"
 { $subsection draw-text }
 "Low-level text protocol for UI backends:"
 "Rendering text:"
 { $subsection draw-text }
 "Low-level text protocol for UI backends:"

-{ $subsection open-font }

 { $subsection string-width }
 { $subsection string-height }
 { $subsection string-dim }
 { $subsection string-width }
 { $subsection string-height }
 { $subsection string-dim }

diff --git a/basis/ui/text/text.factor b/basis/ui/text/text.factor
index 452344ef8ea9ca973b6a9b791e4ad3bb40d01187..062a20adabf2ac6dd6c26f8cbf9d575ce06a863a 100644 (file)
--- a/basis/ui/text/text.factor
+++ b/basis/ui/text/text.factor
@@ -1,12 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.

-USING: kernel arrays sequences math math.order opengl opengl.gl strings ;
+USING: kernel arrays sequences math math.order opengl opengl.gl
+strings fonts colors ;

 IN: ui.text
 
 IN: ui.text
 

-TUPLE: font name size bold? italic? ;
-
-: <font> ( -- font ) font new ; inline
-

 <PRIVATE
 
 SYMBOL: font-renderer
 <PRIVATE
 
 SYMBOL: font-renderer


@@ -15,13 +12,11 @@ HOOK: finish-text-rendering font-renderer ( world -- )
 
 M: object finish-text-rendering drop ;
 
 
 M: object finish-text-rendering drop ;
 

-HOOK: open-font font-renderer ( font -- open-font )
-
-HOOK: string-dim font-renderer ( open-font string -- dim )
+HOOK: string-dim font-renderer ( font string -- dim )

 
 

-HOOK: string-width font-renderer ( open-font string -- w )
+HOOK: string-width font-renderer ( font string -- w )

 
 

-HOOK: string-height font-renderer ( open-font string -- h )
+HOOK: string-height font-renderer ( font string -- h )

 
 M: object string-dim [ string-width ] [ string-height ] 2bi 2array ;
 
 
 M: object string-dim [ string-width ] [ string-height ] 2bi 2array ;
 


@@ -46,11 +41,10 @@ HOOK: offset>x font-renderer ( n font string -- x )
 
 GENERIC: text-dim ( font text -- dim )
 
 
 GENERIC: text-dim ( font text -- dim )
 

-M: string text-dim [ open-font ] dip string-dim ;
+M: string text-dim string-dim ;

 
 M: sequence text-dim
 
 M: sequence text-dim

-    [ { 0 0 } ] [ open-font ] [ ] tri*
-    [ string-dim combine-text-dim ] with each ;
+    [ { 0 0 } ] 2dip [ string-dim combine-text-dim ] with each ;

 
 : text-width ( font text -- w ) text-dim first ;
 
 
 : text-width ( font text -- w ) text-dim first ;
 


@@ -64,7 +58,6 @@ M: sequence draw-text
     [
         [
             2dup { 0 0 } draw-string
     [
         [
             2dup { 0 0 } draw-string

-            [ open-font ] dip string-height
-            0.0 swap 0.0 glTranslated
+            0.0 swap string-height 0.0 glTranslated

         ] with each
     ] with-translation ;
\ No newline at end of file
         ] with each
     ] with-translation ;
\ No newline at end of file

diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index bf6ac03b55f913ebaa8a597b33938eb1e3eb5b0e..a2ec6df6a784939bcc6c8e1da8cec49a02b15529 100644 (file)
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/basis/ui/tools/inspector/inspector.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors inspector namespaces kernel models fry
 models.filter prettyprint sequences mirrors assocs classes
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors inspector namespaces kernel models fry
 models.filter prettyprint sequences mirrors assocs classes

-io io.styles arrays hashtables math.order sorting refs
+io io.styles arrays hashtables math.order sorting refs fonts

 ui.tools.browser ui.commands ui.operations ui.gadgets ui.gadgets.panes
 ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks
 ui.gestures ui.gadgets.buttons ui.gadgets.tables
 ui.tools.browser ui.commands ui.operations ui.gadgets ui.gadgets.panes
 ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks
 ui.gestures ui.gadgets.buttons ui.gadgets.tables

diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor
index 1ef874aa1dfb18abf8d047f97432391c3ffaece9..ae2d6d7645dc54913845402bae749fd8a761d6c0 100644 (file)
--- a/basis/ui/tools/listener/completion/completion.factor
+++ b/basis/ui/tools/listener/completion/completion.factor
@@ -4,7 +4,7 @@ USING: accessors arrays assocs calendar colors documents
 documents.elements fry kernel words sets splitting math math.vectors
 models.delay models.filter combinators.short-circuit parser present
 sequences tools.completion generic generic.standard.engines.tuple
 documents.elements fry kernel words sets splitting math math.vectors
 models.delay models.filter combinators.short-circuit parser present
 sequences tools.completion generic generic.standard.engines.tuple

-ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.glass
+fonts ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.glass

 ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.theme
 ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.render
 ui.tools.listener.history ;
 ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.theme
 ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.render
 ui.tools.listener.history ;

diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index db44e0bddd235c1c1b0d9d49817fc94a9754fc89..ae50ee2c6e792662020b97def8d071ca9916be8e 100644 (file)
--- a/basis/ui/ui-docs.factor
+++ b/basis/ui/ui-docs.factor
@@ -1,7 +1,7 @@
 USING: help.markup help.syntax strings quotations debugger
 namespaces ui.backend ui.gadgets ui.gadgets.worlds
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
 USING: help.markup help.syntax strings quotations debugger
 namespaces ui.backend ui.gadgets ui.gadgets.worlds
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids

-math.geometry.rect colors ui.text ;
+math.geometry.rect colors ui.text fonts ;

 IN: ui
 
 HELP: windows
 IN: ui
 
 HELP: windows