diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 4742d80c58..75960eb086 100644 --- 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 7cbcbc5d07..cb29ba95f9 100644 --- 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 456db2085b..9ec69536c9 100644 --- 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 index 0000000000..c063f17910 --- /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 4f97c6e5f0..7a13b41fb0 100644 --- 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 036f00c545..af75d5c795 100644 --- 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 + + "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 f57e255c11..bf3fb64c5b 100644 --- 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 f805c85e04..2daeee6ee1 100644 --- 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 060c9ada42..1c66061f07 100644 --- 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 ba62376821..a54d52d947 100644 --- 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 ef4a99355f..eed13c5375 100644 --- 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 index 0000000000..a446da6936 --- /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 5b5b9ccda4..966b9f139a 100644 --- 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 71e3696e86..f4e06b591a 100644 --- 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 ) 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 ; : ( style text -- label ) -