Move UI text backends to ui.text.*, move UI backends to ui.backend.*, add font datatype

basis/bootstrap/ui/ui.factor

@@ -9,5 +9,13 @@ IN: bootstrap.ui
             { [ os windows? ] [ "windows" ] }
             { [ os unix? ] [ "x11" ] }
         } cond
-    ] unless* "ui." prepend require
+    ] unless* "ui.backend." prepend require
+
+    "ui-text-backend" get [
+        {
+            { [ os macosx? ] [ "core-text" ] }
+            { [ os windows? ] [ "freetype" ] }
+            { [ os unix? ] [ "freetype" ] }
+        } cond
+    ] unless* "ui.text." prepend require
 ] when

basis/ui/backend/cocoa/cocoa.factor

@@ -5,11 +5,11 @@ command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
 cocoa.windows cocoa.classes cocoa.nibs sequences system ui
 ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.cocoa.views core-foundation core-foundation.run-loop
+ui.backend.cocoa.views core-foundation core-foundation.run-loop
 core-graphics.types threads math.geometry.rect fry libc
-generalizations alien.c-types cocoa.views ui.cocoa.text
+generalizations alien.c-types cocoa.views
 combinators io.thread ;
-IN: ui.cocoa
+IN: ui.backend.cocoa
 
 TUPLE: handle ;
 TUPLE: window-handle < handle view window ;

basis/ui/backend/cocoa/tools/tools.factor

@@ -4,8 +4,8 @@ USING: alien.syntax cocoa cocoa.nibs cocoa.application
 cocoa.classes cocoa.dialogs cocoa.pasteboard cocoa.subclassing
 core-foundation core-foundation.strings help.topics kernel
 memory namespaces parser system ui ui.tools.browser
-ui.tools.listener ui.cocoa eval locals tools.vocabs ;
-IN: ui.cocoa.tools
+ui.tools.listener ui.backend.cocoa eval locals tools.vocabs ;
+IN: ui.backend.cocoa.tools
 
 : finder-run-files ( alien -- )
     CF>string-array listener-run-files

basis/ui/backend/cocoa/views/views-tests.factor

@@ -1,5 +1,5 @@
-IN: ui.cocoa.views.tests
-USING: ui.cocoa.views tools.test kernel math.geometry.rect
+IN: ui.backend.cocoa.views.tests
+USING: ui.backend.cocoa.views tools.test kernel math.geometry.rect
 namespaces ;
 
 [ t ] [

basis/ui/backend/cocoa/views/views.factor

@@ -6,7 +6,7 @@ cocoa.application cocoa.pasteboard cocoa.types cocoa.windows
 sequences ui ui.gadgets ui.gadgets.worlds ui.gestures
 core-foundation.strings core-graphics core-graphics.types
 threads combinators math.geometry.rect ;
-IN: ui.cocoa.views
+IN: ui.backend.cocoa.views
 
 : send-mouse-moved ( view event -- )
     [ mouse-location ] [ drop window ] 2bi move-hand fire-motion ;

basis/ui/backend/windows/windows.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings arrays assocs ui
 ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
-ui.gestures ui.event-loop ui.freetype io kernel math
+ui.gestures ui.event-loop io kernel math
 math.vectors namespaces make sequences strings vectors words
 windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
 windows.messages windows.types windows.nt windows threads libc
@@ -11,7 +11,7 @@ combinators fry combinators.short-circuit continuations
 command-line shuffle opengl ui.render ascii math.bitwise locals
 accessors math.geometry.rect math.order ascii calendar
 io.encodings.utf16n ;
-IN: ui.windows
+IN: ui.backend.windows
 
 SINGLETON: windows-ui-backend
 

basis/ui/backend/x11/x11.factor

@@ -2,13 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays ui ui.gadgets
 ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
-ui.event-loop ui.freetype assocs kernel math namespaces opengl
+ui.event-loop assocs kernel math namespaces opengl
 sequences strings x11.xlib x11.events x11.xim x11.glx
 x11.clipboard x11.constants x11.windows io.encodings.string
 io.encodings.ascii io.encodings.utf8 combinators command-line
 math.vectors classes.tuple opengl.gl threads math.geometry.rect
 environment ascii ;
-IN: ui.x11
+IN: ui.backend.x11
 
 SINGLETON: x11-ui-backend
 

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

@@ -7,12 +7,12 @@ HELP: editor
 $nl
 "Editors have the following slots:"
 { $list
-    { { $snippet "font" } " - a font specifier." }
-    { { $snippet "color" } " - text color specifier." }
-    { { $snippet "caret-color" } " - caret color specifier." }
-    { { $snippet "selection-color" } " - selection background color specifier." }
-    { { $snippet "caret" } " - a model storing a line/column pair." }
-    { { $snippet "mark" } " - a model storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." }
+    { { $snippet "font" } " - a " { $link font } "." }
+    { { $snippet "color" } " - a " { $link color } "." }
+    { { $snippet "caret-color" } " - a " { $link color } ". }
+    { { $snippet "selection-color" } " - a " { $link color } ". }
+    { { $snippet "caret" } " - a " { $link model } " storing a line/column pair." }
+    { { $snippet "mark" } " - a " { $link model } " storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." }
     { { $snippet "focused?" } " - a boolean." }
 } } ;
 

basis/ui/gadgets/editors/editors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays documents kernel math models models.filter
-namespaces locals fry make opengl opengl.gl sequences strings io.styles
+namespaces locals fry make opengl opengl.gl sequences strings
 math.vectors sorting colors combinators assocs math.order fry
 calendar alarms continuations ui.clipboards ui.commands
 ui.gadgets ui.gadgets.borders ui.gadgets.buttons

basis/ui/gadgets/grids/grids.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces make sequences words io
-io.styles math.vectors ui.gadgets columns accessors
+math.vectors ui.gadgets columns accessors
 math.geometry.rect locals fry ;
 IN: ui.gadgets.grids
 

basis/ui/gadgets/panes/panes.factor

@@ -187,9 +187,19 @@ M: pane-stream make-span-stream
     background [ solid-interior ] apply-style ;
 
 : specified-font ( style -- font )
-    [ font swap at "monospace" or ] keep
-    [ font-style swap at plain or ] keep
-    font-size swap at 12 or 3array ;
+    <font>
+        swap
+        [ font swap at "monospace" or >>name ]
+        [
+            font-style swap at {
+                { plain [ ] }
+                { bold [ t >>bold ] }
+                { italic [ t >>italic ] }
+                { bold-italic [ t >>bold t >>italic ] }
+            } case
+        ]
+        [ font-size swap at 12 or >>size ]
+        tri ;
 
 : apply-font-style ( style gadget -- style gadget )
     over specified-font >>font ;

basis/ui/gadgets/presentations/presentations.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays accessors definitions hashtables io kernel
-sequences strings io.styles words help math models
-namespaces quotations
+sequences strings words help math models namespaces quotations
 ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
 ui.gadgets.status-bar ui.commands ui.operations ui.gestures ;

basis/ui/gadgets/tables/tables.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors fry io.styles kernel math
+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

basis/ui/gadgets/theme/theme.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! Copyright (C) 2006, 2007 Alex Chapman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences io.styles ui.gadgets ui.render
-colors colors.gray accessors ;
+USING: arrays kernel sequences ui.gadgets ui.render
+ui.text colors colors.gray accessors ;
 QUALIFIED: colors
 IN: ui.gadgets.theme
 
@@ -58,6 +58,6 @@ IN: ui.gadgets.theme
         T{ gray f 0.5  1.0 }
     } <gradient> ;
 
-: sans-serif-font { "sans-serif" plain 12 } ;
+CONSTANT: sans-serif-font T{ font { name "sans-serif" } { size 12 } }
 
-: monospace-font { "monospace" plain 12 } ;
+CONSTANT: monospace-font T{ font { name "monospace" } { size 12 } }

basis/ui/render/render.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays hashtables io kernel
 math namespaces opengl opengl.gl opengl.glu sequences strings
-io.styles vectors combinators math.vectors ui.gadgets colors
+vectors combinators math.vectors ui.gadgets colors
 math.order math.geometry.rect locals specialized-arrays.float ;
 IN: ui.render
 

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

@@ -1,4 +1,4 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test ui.cocoa.text ;
-IN: ui.cocoa.text.tests
+USING: tools.test ui.text.core-text ;
+IN: ui.text.core-text.tests

basis/ui/text/core-text/text.factor

@@ -3,8 +3,8 @@
 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 io.styles memoize math math.vectors ;
-IN: ui.cocoa.text
+core-foundation.strings memoize math math.vectors ;
+IN: ui.text.core-text
 
 SINGLETON: core-text-renderer
 
@@ -22,13 +22,10 @@ CONSTANT: font-names
 
 : (italic) ( x -- y ) kCTFontItalicTrait bitor ; inline
 
-: font-traits ( style -- mask )
-    [ 0 ] dip {
-        { plain [ ] }
-        { bold [ (bold) ] }
-        { italic [ (italic) ] }
-        { bold-italic [ (bold) (italic) ] }
-    } case ;
+: 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
@@ -38,9 +35,9 @@ CONSTANT: font-names
 MEMO: cache-font ( font -- open-font )
     [
         [
-            [ first font-name <CFString> &CFRelease ] [ third ] bi
+            [ name>> font-name <CFString> &CFRelease ] [ size>> ] bi
             f CTFontCreateWithName
-        ] [ second ] bi apply-font-traits
+        ] keep apply-font-traits
     ] with-destructors ;
 
 M: core-text-renderer open-font

basis/ui/text/freetype/freetype-docs.factor

@@ -1,6 +1,6 @@
 USING: help.syntax help.markup strings kernel alien opengl
-opengl.sprites quotations ui.render io.styles freetype ;
-IN: ui.freetype
+opengl.sprites quotations ui.render freetype ;
+IN: ui.text.freetype
 
 HELP: freetype
 { $values { "alien" alien } }

basis/ui/text/freetype/freetype.factor

@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 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.text ui.text.private ui.backend byte-arrays accessors
-locals specialized-arrays.direct.uchar ;
-IN: ui.freetype
+sequences io.files continuations freetype
+ui.gadgets.worlds ui.text ui.text.private ui.backend
+byte-arrays accessors locals specialized-arrays.direct.uchar
+combinators.smart ;
+IN: ui.text.freetype
 
 SINGLETON: freetype-renderer
 
@@ -27,10 +28,10 @@ DEFER: freetype
     \ freetype get-global expired? [ init-freetype ] when
     \ freetype get-global ;
 
-TUPLE: font < identity-tuple
+TUPLE: freetype-font < identity-tuple
 ascent descent height handle widths ;
 
-M: font hashcode* drop font hashcode* ;
+M: freetype-font hashcode* drop freetype-font hashcode* ;
 
 : close-font ( font -- ) handle>> FT_Done_Face ;
 
@@ -43,20 +44,20 @@ M: font hashcode* drop font hashcode* ;
 M: freetype-renderer free-fonts ( world -- )
     values [ second free-sprites ] each ;
 
-: ttf-name ( font style -- name )
-    2array H{
-        { { "monospace" plain        } "VeraMono" }
-        { { "monospace" bold         } "VeraMoBd" }
-        { { "monospace" bold-italic  } "VeraMoBI" }
-        { { "monospace" italic       } "VeraMoIt" }
-        { { "sans-serif" plain       } "Vera"     }
-        { { "sans-serif" bold        } "VeraBd"   }
-        { { "sans-serif" bold-italic } "VeraBI"   }
-        { { "sans-serif" italic      } "VeraIt"   }
-        { { "serif" plain            } "VeraSe"   }
-        { { "serif" bold             } "VeraSeBd" }
-        { { "serif" bold-italic      } "VeraBI"   }
-        { { "serif" italic           } "VeraIt"   }
+: ttf-name ( font -- name )
+    [ [ name>> ] [ bold>> ] [ italic>> ] tri ] output>array H{
+        { { "monospace" f f } "VeraMono" }
+        { { "monospace" t f } "VeraMoBd" }
+        { { "monospace" t t } "VeraMoBI" }
+        { { "monospace" f t } "VeraMoIt" }
+        { { "sans-serif" f f } "Vera" }
+        { { "sans-serif" t f } "VeraBd" }
+        { { "sans-serif" t t } "VeraBI" }
+        { { "sans-serif" f t } "VeraIt" }
+        { { "serif" f f } "VeraSe" }
+        { { "serif" t f } "VeraSeBd" }
+        { { "serif" t t } "VeraBI" }
+        { { "serif" f t } "VeraIt" }
     } at ;
 
 : ttf-path ( name -- string )
@@ -99,16 +100,16 @@ SYMBOL: dpi
     [ dup handle>> 0 ] dip
     6 shift dpi get-global dup FT_Set_Char_Size freetype-error ;
 
-: <font> ( font -- open-font )
-    font new
+: <freetype-font> ( font -- open-font )
+    freetype-font new
         H{ } clone >>widths
-        over first2 open-face >>handle
-        swap third set-char-size
+        over open-face >>handle
+        swap size>> set-char-size
         init-font ;
 
 M: freetype-renderer open-font ( font -- open-font )
     dup font? [
-        freetype drop open-fonts get [ <font> ] cache
+        freetype drop open-fonts get [ <freetype-font> ] cache
     ] unless ;
 
 : load-glyph ( font char -- glyph )

basis/ui/text/text-docs.factor

@@ -2,7 +2,7 @@ IN: ui.text
 USING: help.markup help.syntax kernel ui.text.private strings math ;
 
 HELP: open-font
-{ $values { "font" "a font specifier" } { "open-font" object } }
+{ $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." } ;
@@ -13,7 +13,7 @@ HELP: string-width
 { $notes "This is a low-level word; use " { $link text-width } " instead." } ;
 
 HELP: text-width
-{ $values { "font" "a font specifier" } { "text" "a string or sequence of strings" } { "w" "a positive integer" } }
+{ $values { "font" font } { "text" "a string or sequence of strings" } { "w" "a positive integer" } }
 { $description "Outputs the width of a piece of text." } ;
 
 HELP: string-height
@@ -22,7 +22,7 @@ HELP: string-height
 { $notes "This is a low-level word; use " { $link text-height } " instead." } ;
 
 HELP: text-height
-{ $values { "font" "a font specifier" } { "text" "a string or sequence of strings" } { "h" "a positive integer" } }
+{ $values { "font" font } { "text" "a string or sequence of strings" } { "h" "a positive integer" } }
 { $description "Outputs the height of a piece of text." } ;
 
 HELP: string-dim
@@ -31,23 +31,23 @@ HELP: string-dim
 { $notes "This is a low-level word; use " { $link text-dim } " instead." } ;
 
 HELP: text-dim
-{ $values { "font" "a font specifier" } { "text" "a string or sequence of strings" } { "dim" "a pair of integers" } }
+{ $values { "font" font } { "text" "a string or sequence of strings" } { "dim" "a pair of integers" } }
 { $description "Outputs the dimensions of a piece of text, which is either a single-line string or an array of lines." } ;
 
 HELP: draw-string
-{ $values { "font" "a font specifier" } { "string" string } { "loc" "a pair of integers" } }
+{ $values { "font" font } { "string" string } { "loc" "a pair of integers" } }
 { $contract "Draws a line of text." } ;
 
 HELP: draw-text
-{ $values { "font" "a font specifier" } { "text" "a string or an array of strings" } { "loc" "a pair of integers" } }
+{ $values { "font" font } { "text" "a string or an array of strings" } { "loc" "a pair of integers" } }
 { $description "Draws a piece of text." } ;
 
 HELP: x>offset
-{ $values { "x" real } { "font" "a font specifier" } { "string" string } { "n" integer } }
+{ $values { "x" real } { "font" font } { "string" string } { "n" integer } }
 { $contract "Outputs the string index closest to the given x co-ordinate." } ;
 
 HELP: offset>x
-{ $values { "n" integer } { "font" "a font specifier" } { "string" string } { "x" real } }
+{ $values { "n" integer } { "font" font } { "string" string } { "x" real } }
 { $contract "Outputs the x co-ordinate of the character at the given index." } ;
 
 ARTICLE: "text-rendering" "Rendering text"

basis/ui/text/text.factor

@@ -3,6 +3,8 @@
 USING: kernel arrays sequences math math.order opengl opengl.gl strings ;
 IN: ui.text
 
+TUPLE: font name size bold? italic? ;
+
 <PRIVATE
 
 SYMBOL: font-renderer

basis/ui/tools/listener/history/history.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors documents io.styles kernel math math.order
+USING: accessors documents kernel math math.order
 sequences fry ;
 IN: ui.tools.listener.history
 

basis/ui/ui-docs.factor

@@ -1,6 +1,7 @@
 USING: help.markup help.syntax strings quotations debugger
-io.styles namespaces ui.backend ui.gadgets ui.gadgets.worlds
-ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids math.geometry.rect colors ;
+namespaces ui.backend ui.gadgets ui.gadgets.worlds
+ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
+math.geometry.rect colors ;
 IN: ui
 
 HELP: windows
@@ -67,15 +68,7 @@ ARTICLE: "ui-glossary" "UI glossary"
 { $table
     { "color" { "an instance of " { $link color } } }
     { "dimension" "a pair of integers denoting pixel size on screen" }
-    { "font specifier"
-        { "an array of three elements:"
-            { $list
-                { "font family - one of " { $snippet "serif" } ", " { $snippet "sans-serif" } " or " { $snippet "monospace" } }
-                { "font style - one of " { $link plain } ", " { $link bold } ", " { $link italic } " or " { $link bold-italic } }
-                "font size in points"
-            }
-        }
-    }
+    { "font" { "an instance of " { link font } } }
     { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) inherit from " { $link gadget } "." } }
     { "label specifier" { "a string, " { $link f } " or a gadget. See " { $link "ui.gadgets.buttons" } } }
     { "orientation specifier" { "one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } ", with the former denoting vertical orientation and the latter denoting horizontal. Using a vector instead of symbolic constants allows these values to be directly useful in co-ordinate calculations" } }