working on styled text output in UI

diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index 4742d80c58665b921ac230a1674fdf3f4911520d..75960eb0863c56919a39f4a8fb458cbd46ea35cb 100644 (file)
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -58,6 +58,7 @@ parser prettyprint sequences io vectors words ;
         "/library/io/files.factor"
 
         "/library/threads.factor"
+        "/library/styles.factor"
 
         "/library/syntax/parse-numbers.factor"
         "/library/syntax/parse-words.factor"

diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor
index 7cbcbc5d0785640bde10cc8c8f6f36e27e3140ed..cb29ba95f9abb3b56b061b38ba1ac3e62332b21c 100644 (file)
--- a/library/collections/hashtables.factor
+++ b/library/collections/hashtables.factor
@@ -158,3 +158,10 @@ M: hashtable hashcode ( hash -- n )
     ] [
         0 swap hash-bucket hashcode
     ] ifte ;
+
+: cache ( key hash quot -- value | quot: key -- value )
+    pick pick hash [
+        >r 3drop r>
+    ] [
+        pick rot >r >r call dup r> r> set-hash
+    ] ifte* ; inline

diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor
index 456db2085b6c8704a8da1b9493fab5d968e5bcc7..9ec69536c9c15e0d66caa10f7669143b83206f76 100644 (file)
--- a/library/sdl/sdl-utils.factor
+++ b/library/sdl/sdl-utils.factor
@@ -15,7 +15,7 @@ SYMBOL: surface
 
 : with-screen ( width height bpp flags quot -- )
     #! Set up SDL graphics and call the quotation.
-    SDL_INIT_EVERYTHING SDL_Init drop  TTF_Init
+    SDL_INIT_EVERYTHING SDL_Init drop
     1 SDL_EnableUNICODE drop
     SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL
     SDL_EnableKeyRepeat drop

diff --git a/library/styles.factor b/library/styles.factor
new file mode 100644 (file)
index 0000000..c063f17
--- /dev/null
+++ b/library/styles.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: styles
+USING: kernel namespaces ;
+
+! Colors are lists of three integers, 0..255.
+SYMBOL: foreground ! Used for text and outline shapes.
+SYMBOL: background ! Used for filled shapes.
+SYMBOL: reverse-video
+
+: fg reverse-video get background foreground ? get ;
+: bg reverse-video get foreground background ? get ;
+
+SYMBOL: font
+SYMBOL: font-size
+SYMBOL: font-style
+
+SYMBOL: plain
+SYMBOL: bold
+SYMBOL: italic
+SYMBOL: bold-italic

diff --git a/library/syntax/see.factor b/library/syntax/see.factor
index 4f97c6e5f0a37b2fb8f14f426ad742b549b4a054..7a13b41fb06e7ac878640b79346ce787c4023543 100644 (file)
--- a/library/syntax/see.factor
+++ b/library/syntax/see.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: prettyprint
 USING: generic hashtables io kernel lists namespaces sequences
-streams strings unparser words ;
+streams strings styles unparser words ;
 
 ! Prettyprinting words
 : vocab-actions ( search -- list )
@@ -40,6 +40,7 @@ streams strings unparser words ;
         [[ "ansi-fg" "0" ]]
         [[ "ansi-bg" "2" ]]
         [[ "fg" [ 255 0 0 ] ]]
+        [[ foreground [ 192 0 0 ] ]]
     ] ;
 
 : comment. ( comment -- ) comment-style write-attr ;

diff --git a/library/test/hashtables.factor b/library/test/hashtables.factor
index 036f00c545dad8efdb32f4f2d874b64c13f73ee4..af75d5c79597bd55945cd1cb786b0a461f0f5598 100644 (file)
--- a/library/test/hashtables.factor
+++ b/library/test/hashtables.factor
@@ -129,3 +129,10 @@ f 100000000000000000000000000 "testhash" get set-hash
         uncons + +
     ] hash-each
 ] unit-test
+
+<namespace> "cache-test" set
+
+[ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
+[ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
+[ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
+[ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test

diff --git a/library/tools/listener.factor b/library/tools/listener.factor
index f57e255c113a58f279b2d121b7b539a1ab66d88b..bf3fb64c5b56effbb6aa708f6e92a3bd13fd053d 100644 (file)
--- a/library/tools/listener.factor
+++ b/library/tools/listener.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: listener
-USING: errors kernel lists math memory namespaces parser
-sequences io strings presentation words unparser vectors ansi ;
+USING: ansi errors io kernel lists math memory namespaces parser
+presentation sequences strings styles unparser vectors words ;
 
 SYMBOL: cont-prompt
 SYMBOL: listener-prompt
@@ -14,7 +14,7 @@ global [
 ] bind
 
 : prompt. ( text -- )
-    [ [[ "bold" t ]] ] write-attr
+    [ [[ "bold" t ]] [[ font-style bold ]] ] write-attr
     ! Print the space without a style, to workaround a bug in
     ! the GUI listener where the style from the prompt carries
     ! over to the input

diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index f805c85e0486db4ece038e3865d5d0b24f4392fb..2daeee6ee1e42e91cadb05519f93f96a01b2449b 100644 (file)
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel lists math namespaces prettyprint sdl
-sequences io sequences ;
+sequences io sequences styles ;
 
 : button-down? ( n -- ? ) hand hand-buttons contains? ;
 

diff --git a/library/ui/checkboxes.factor b/library/ui/checkboxes.factor
index 060c9ada42fb88491e7c0eccbbe6a00bb40c6300..1c66061f07220441626ecc5ffb9260f39c60515a 100644 (file)
--- a/library/ui/checkboxes.factor
+++ b/library/ui/checkboxes.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl sequences ;
+USING: generic kernel lists math namespaces sdl sequences
+styles ;
 
 : check-size 8 ;
 

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index ba623768214262ccd43c42c3e7498bab2c0baa74..a54d52d947e3915e0c2c4c09a05473d8113ea9cd 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel line-editor lists math namespaces sdl
-sequences strings ;
+sequences strings styles ;
 
 ! An editor gadget wraps a line editor object and passes
 ! gestures to the line editor.
@@ -75,11 +75,11 @@ C: editor ( text -- )
     [ set-editor-text ] keep
     dup editor-actions ;
 
-: offset>x ( offset str -- x )
-    head font get swap size-string drop ;
+: offset>x ( gadget offset str -- x )
+    head >r gadget-font r> size-string drop ;
 
 : caret-pos ( editor -- x y )
-    editor-line [ caret get line-text get ] bind offset>x 0 ;
+    dup editor-line [ caret get line-text get ] bind offset>x 0 ;
 
 : caret-size ( editor -- w h )
     1 swap shape-h ;
@@ -96,4 +96,5 @@ M: editor layout* ( editor -- )
     dup editor-caret swap caret-pos rot move-gadget ;
 
 M: editor draw-shape ( editor -- )
-    [ editor-text ] keep [ draw-string ] with-trans ;
+    [ dup gadget-font swap editor-text ] keep
+    [ draw-string ] with-trans ;

diff --git a/library/ui/ellipses.factor b/library/ui/ellipses.factor
index ef4a99355f74d3dc3ed70b5f1c3a432835caf1fe..eed13c53755913a15d2fc3aab32ab13750836b08 100644 (file)
--- a/library/ui/ellipses.factor
+++ b/library/ui/ellipses.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl ;
+USING: generic kernel lists math namespaces sdl styles ;
 
 ! An ellipse.
 TUPLE: ellipse x y w h ;

diff --git a/library/ui/fonts.factor b/library/ui/fonts.factor
new file mode 100644 (file)
index 0000000..a446da6
--- /dev/null
+++ b/library/ui/fonts.factor
@@ -0,0 +1,44 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: alien hashtables io kernel lists namespaces sdl sequences
+styles ;
+
+: ttf-name ( font style -- name )
+    cons [
+        [[ [[ "Monospaced" plain       ]] "VeraMono" ]]
+        [[ [[ "Monospaced" bold        ]] "VeraMoBd" ]]
+        [[ [[ "Monospaced" bold-italic ]] "VeraMoBI" ]]
+        [[ [[ "Monospaced" 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"   ]]
+    ] assoc ;
+
+: ttf-path ( name -- string )
+    [ resource-path % "/fonts/" % % ".ttf" % ] make-string ;
+
+: open-font ( [ font style ptsize ] -- alien )
+    3unlist >r ttf-name ttf-path r> TTF_OpenFont ;
+
+SYMBOL: open-fonts
+
+: lookup-font ( font style ptsize -- font )
+    3list open-fonts get [ open-font ] cache ;
+
+global [ open-fonts nest drop ] bind
+
+: ttf-init ( -- )
+    TTF_Init
+    open-fonts [ [ cdr null? not ] hash-subset ] change ;
+
+: gadget-font ( gadget -- font )
+    [ font paint-prop ] keep
+    [ font-style paint-prop ] keep
+    font-size paint-prop
+    lookup-font ;

diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor
index 5b5b9ccda479ec0ae7be884d1bf34a1556a04ab2..966b9f139aa709283b158e35da60ae9a6b5ee1b9 100644 (file)
--- a/library/ui/init-world.factor
+++ b/library/ui/init-world.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel math namespaces ;
+USING: generic kernel math namespaces styles ;
 
 
 global [
@@ -12,7 +12,9 @@ global [
         [[ background [ 255 255 255 ] ]]
         [[ foreground [ 0 0 0 ] ]]
         [[ reverse-video f ]]
-        [[ font [[ "Sans Serif" 12 ]] ]]
+        [[ font "Sans Serif" ]]
+        [[ font-size 12 ]]
+        [[ font-style plain ]]
     }} world get set-gadget-paint
     
     1024 768 world get resize-gadget

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index 71e3696e868b3f8f1cfe5e30b8e439a0376dc7d0..f4e06b591ab73a3aabbf765a1edb592262070204 100644 (file)
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic hashtables io kernel lists math namespaces sdl
-sequences ;
+sequences styles ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;
@@ -11,18 +11,14 @@ C: label ( text -- label )
     <empty-gadget> over set-delegate [ set-label-text ] keep ;
 
 : label-size ( gadget text -- w h )
-    >r font paint-prop r> size-string ;
+    >r gadget-font r> size-string ;
 
 M: label pref-size ( label -- w h )
     dup label-text label-size ;
 
 M: label draw-shape ( label -- )
-    [ label-text ] keep [ draw-string ] with-trans ;
+    [ dup gadget-font swap label-text ] keep
+    [ draw-string ] with-trans ;
 
 : <styled-label> ( style text -- label )
-    <label> swap [
-        unswons [
-            [[ "fg" foreground ]]
-            [[ "bg" background ]]
-        ] assoc swons
-    ] map alist>hash over set-gadget-paint ;
+    <label> swap alist>hash over set-gadget-paint ;

diff --git a/library/ui/lines.factor b/library/ui/lines.factor
index 112da03a468b90d35cfee2a2f5d9a8eaac2ca3eb..01082d1b380d57f892dd0439a2baabb2a99031fd 100644 (file)
--- a/library/ui/lines.factor
+++ b/library/ui/lines.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl ;
+USING: generic kernel lists math namespaces sdl styles ;
 
 ! A line.
 TUPLE: line x y w h ;

diff --git a/library/ui/load.factor b/library/ui/load.factor
index 40d4d9a2627f8f6c431f2b9202cd23f4ebef5a26..76e144eb70065f46cd8257e24fb9fdd671082968 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -9,6 +9,7 @@ USING: kernel parser sequences io ;
     "/library/ui/gadgets.factor"
     "/library/ui/hierarchy.factor"
     "/library/ui/paint.factor"
+    "/library/ui/fonts.factor"
     "/library/ui/text.factor"
     "/library/ui/gestures.factor"
     "/library/ui/hand.factor"

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
index bff62ead41d3257a0c3618997d17a89c36df194c..85667f5fadc6fd8c57e95cbc8cccbdaad8933d04 100644 (file)
--- a/library/ui/panes.factor
+++ b/library/ui/panes.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel line-editor listener lists math namespaces
-sequences io strings threads ;
+sequences io strings threads styles ;
 
 ! A pane is an area that can display text.
 
@@ -23,7 +23,7 @@ TUPLE: pane output active current input continuation ;
     2dup set-pane-active add-gadget ;
 
 : pane-paint ( pane -- )
-    [[ "Monospaced" 12 ]] font set-paint-prop ;
+    "Monospaced" font set-paint-prop ;
 
 : pop-continuation ( pane -- quot )
     dup pane-continuation f rot set-pane-continuation ;
@@ -81,9 +81,3 @@ M: pane stream-close ( stream -- ) drop ;
     <pane> dup
     [ [ clear  print-banner listener ] in-thread ] with-stream
     <scroller> ;
-
-: console ( -- )
-    #! Open an UI console window.
-    <console> "Listener" <tile> world get [
-        shape-size rect> 3/4 * >rect rot resize-gadget
-    ] 2keep add-gadget ;

diff --git a/library/ui/rectangles.factor b/library/ui/rectangles.factor
index 15b5edf6bb6ab5713beb49d5aa9f3575fe606ce1..6e0cbacfd46a4b8c3a5b79cd4257d99f709d0e65 100644 (file)
--- a/library/ui/rectangles.factor
+++ b/library/ui/rectangles.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl ;
+USING: generic kernel lists math namespaces sdl styles ;
 
 ! A rectangle maps trivially to the shape protocol.
 TUPLE: rectangle x y w h ;

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 20b8863c4b80ac610823cc0ad0d585b78c05cf61..94ec70e87e19b265804919634d9cd8eaf56ad541 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel lists math matrices namespaces sequences
-threads vectors ;
+threads vectors styles ;
 
 ! A viewport can be scrolled.
 

diff --git a/library/ui/shapes.factor b/library/ui/shapes.factor
index 84e4897087da59fedbe0a9d445575c8b529db62f..d3eae001f538f9205936b8c26673f2807867c042 100644 (file)
--- a/library/ui/shapes.factor
+++ b/library/ui/shapes.factor
@@ -32,17 +32,7 @@ GENERIC: resize-shape ( w h shape -- )
     >r 3unseq drop r> resize-shape ;
 
 ! The painting protocol. Painting is controlled by various
-! dynamically-scoped variables.
-
-! Colors are lists of three integers, 0..255.
-SYMBOL: foreground ! Used for text and outline shapes.
-SYMBOL: background ! Used for filled shapes.
-SYMBOL: reverse-video
-
-: fg reverse-video get background foreground ? get ;
-: bg reverse-video get foreground background ? get ;
-
-SYMBOL: font  ! a list of two elements, a font name and size.
+! dynamically-scoped variables. See library/styles.factor.
 
 GENERIC: draw-shape ( obj -- )
 

diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index 3f4c0ee1b428c4fbfd8056fad13c79b171b79eaa..044b6a833a3d630be232e79e36395b92e5f772a4 100644 (file)
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math matrices namespaces sequences ;
+USING: generic kernel lists math matrices namespaces sequences
+styles ;
 
 TUPLE: divider splitter ;
 

diff --git a/library/ui/text.factor b/library/ui/text.factor
index b97a161b69f091c3f553aa9a7a098ff3e66fc287..c00eea7bcfee7cacb69ef92fd6fd2ddd6a52659d 100644 (file)
--- a/library/ui/text.factor
+++ b/library/ui/text.factor
@@ -1,42 +1,8 @@
-! Strings are shapes too. This is somewhat of a hack and strings
-! do not have x/y co-ordinates.
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: alien hashtables kernel lists namespaces sdl sequences
-io strings ;
-
-SYMBOL: fonts
-
-: <font> ( name ptsize -- font )
-    >r resource-path swap append r> TTF_OpenFont ;
-
-SYMBOL: logical-fonts
-
-: logical-font ( name -- name )
-    dup logical-fonts get hash dup [ nip ] [ drop ] ifte ;
-
-global [
-    {{
-        [[ "Monospaced" "/fonts/VeraMono.ttf" ]]
-        [[ "Serif" "/fonts/VeraSe.ttf" ]]
-        [[ "Sans Serif" "/fonts/Vera.ttf" ]]
-    }} logical-fonts set
-] bind
-
-: (lookup-font) ( [[ name ptsize ]] -- font )
-    unswons logical-font swons dup get dup alien? [
-        dup alien-address 0 = [
-            drop f
-        ] when
-    ] when ;
-
-: lookup-font ( [[ name ptsize ]] -- font )
-    fonts get [
-        (lookup-font) [
-            nip
-        ] [
-            [ uncons <font> dup ] keep set
-        ] ifte*
-    ] bind ;
+strings styles io ;
 
 : surface-rect ( x y surface -- rect )
     dup surface-w swap surface-h make-rect ;
@@ -56,23 +22,20 @@ global [
     ] when ;
 
 : size-string ( font text -- w h )
-    >r lookup-font r> filter-nulls dup empty? [
-        drop TTF_FontHeight 0 swap
+    filter-nulls dup empty? [
+        drop 0 swap TTF_FontHeight
     ] [
         0 <int> 0 <int> [ TTF_SizeUNICODE drop ] 2keep
         swap *int swap *int
     ] ifte ;
 
-: draw-string ( text -- )
-    dup empty? [
-        drop
+: draw-string ( font text -- )
+    filter-nulls dup empty? [
+        2drop
     ] [
-        filter-nulls font get lookup-font swap
         fg 3unlist make-color
         bg 3unlist make-color
         TTF_RenderUNICODE_Shaded
         [ >r x get y get r> draw-surface ] keep
         SDL_FreeSurface
     ] ifte ;
-
-global [ <namespace> fonts set ] bind

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 3a31dc2f7e5a25cda88633583b4d318e222fcb04..6ef894d8a5b52fd3adf21478cc81790018953fea 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -11,6 +11,7 @@ IN: shells
     world get shape-size 0 SDL_RESIZABLE [
         0 x set 0 y set [
             "Factor " version append dup SDL_WM_SetCaption
+            ttf-init
             start-world
             run-world
         ] with-screen

diff --git a/library/vocabularies.factor b/library/vocabularies.factor
index d62e7fac802a46ac591a2ba7861306f04eb3dccd..0286eaed6a2cebb41152d9090286ca338d94109a 100644 (file)
--- a/library/vocabularies.factor
+++ b/library/vocabularies.factor
@@ -97,6 +97,6 @@ SYMBOL: vocabularies
         "hashtables" "inference" "interpreter" "jedit" "kernel"
         "listener" "lists" "math" "matrices" "memory"
         "namespaces" "parser" "prettyprint" "processes"
-        "sequences" "io" "strings" "syntax" "test" "threads"
-        "unparser" "vectors" "words" "scratchpad"
+        "sequences" "io" "strings" "styles" "syntax" "test"
+        "threads" "unparser" "vectors" "words" "scratchpad"
     ] "use" set ;