Merge git://factorcode.org/git/factor

core/source-files/source-files.factor

@@ -68,7 +68,7 @@ uses definitions ;
 : reset-checksums ( -- )
     source-files get [
         swap ?resource-path dup exists?
-        [ file-lines record-checksum ] [ 2drop ] if
+        [ file-lines swap record-checksum ] [ 2drop ] if
     ] assoc-each ;
 
 M: pathname where pathname-string 1 2array ;

extra/calendar/authors.txt

@@ -1 +1 @@
-Doug Coleman
+Slava Pestov

extra/calendar/calendar.factor

@@ -333,16 +333,18 @@ M: integer year. ( n -- )
 M: timestamp year. ( timestamp -- )
     timestamp-year year. ;
 
-: pad-00 number>string 2 CHAR: 0 pad-left write ;
+: pad-00 number>string 2 CHAR: 0 pad-left ;
+
+: write-00 pad-00 write ;
 
 : (timestamp>string) ( timestamp -- )
     dup day-of-week day-abbreviations3 nth write ", " write
     dup timestamp-day number>string write bl
     dup timestamp-month month-abbreviations nth write bl
     dup timestamp-year number>string write bl
-    dup timestamp-hour pad-00 ":" write
+    dup timestamp-hour write-00 ":" write
-    dup timestamp-minute pad-00 ":" write
+    dup timestamp-minute write-00 ":" write
-    timestamp-second >fixnum pad-00 ;
+    timestamp-second >fixnum write-00 ;
 
 : timestamp>string ( timestamp -- str )
     [ (timestamp>string) ] string-out ;
@@ -357,11 +359,11 @@ M: timestamp year. ( timestamp -- )
 
 : (timestamp>rfc3339) ( timestamp -- )
     dup timestamp-year number>string write CHAR: - write1
-    dup timestamp-month pad-00 CHAR: - write1
+    dup timestamp-month write-00 CHAR: - write1
-    dup timestamp-day pad-00 CHAR: T write1
+    dup timestamp-day write-00 CHAR: T write1
-    dup timestamp-hour pad-00 CHAR: : write1
+    dup timestamp-hour write-00 CHAR: : write1
-    dup timestamp-minute pad-00 CHAR: : write1
+    dup timestamp-minute write-00 CHAR: : write1
-    timestamp-second >fixnum pad-00 CHAR: Z write1 ;
+    timestamp-second >fixnum write-00 CHAR: Z write1 ;
 
 : timestamp>rfc3339 ( timestamp -- str )
     >gmt [ (timestamp>rfc3339) ] string-out ;
@@ -390,8 +392,8 @@ M: timestamp year. ( timestamp -- )
         [ timestamp-month month-abbreviations nth write ] keep bl
         [ timestamp-day number>string 2 32 pad-left write ] keep bl
         dup now [ timestamp-year ] 2apply = [
-            [ timestamp-hour pad-00 ] keep ":" write
+            [ timestamp-hour write-00 ] keep ":" write
-            timestamp-minute pad-00
+            timestamp-minute write-00
         ] [
             timestamp-year number>string 5 32 pad-left write
         ] if

extra/calendar/model/model.factor

@@ -0,0 +1,15 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar namespaces models threads init ;
+IN: calendar.model
+
+SYMBOL: time
+
+: (time-thread) ( -- )
+    now time get set-model
+    1000 sleep (time-thread) ;
+
+: time-thread ( -- ) [ (time-thread) ] in-thread ;
+
+f <model> time set-global
+[ time-thread ] "calendar.model" add-init-hook

extra/calendar/summary.txt

@@ -1 +1 @@
-Date and time classes
+Timestamp model updated every second

extra/catalyst-talk/catalyst-talk.factor

@@ -1,121 +0,0 @@
-USING: slides help.markup math arrays hashtables namespaces
-sequences kernel sequences parser ;
-IN: catalyst-talk
-
-: catalyst-slides
-{
-    { $slide "What is Factor?"
-        "Originally scripting for a Java game"
-        "Language dev more fun than game dev"
-        "Start with ideas which were mostly dead"
-        "Throw in features from crazy languages"
-        "Develop practical libraries and tools"
-    }
-    { $slide "Factor: a stack language"
-        "Implicit parameter passing"
-        { "Each " { $emphasis "word" } " is a function call" }
-        { $code ": sq dup * ;" }
-        { $code "2 3 + sq ." }
-        "Minimal syntax and semantics = easy meta-programming"
-        { "Related languages: Forth, Joy, PostScript" }
-    }
-    { $slide "Factor: a functional language"
-        { { $emphasis "Quotations" } " can be passed around, constructed..." }
-        { $code "[ sq 3 + ]" }
-        { { $emphasis "Combinators" } " are words which take quotations, eg " { $link if } }
-        { "For FP buffs: " { $link each } ", " { $link map } ", " { $link reduce } ", " { $link accumulate } ", " { $link interleave } ", " { $link subset } }
-        { $code "{ 42 69 666 } [ sq 3 + ] map ." }
-    }
-    { $slide "Factor: an object-oriented language"
-        { "Everything is an " { $emphasis "object" } }
-        { "An object is an instance of a " { $emphasis "class" } }
-        "Methods"
-        "Generic words"
-        "For CLOS buffs: we allow custom method combination, classes are objects too, there's a MOP"
-    }
-    
-    STRIP-TEASE:
-        $slide "Primary school geometry recap"
-        { $code
-            "GENERIC: area ( shape -- meters^2 )"
-            "TUPLE: square dimension ;"
-            "M: square area square-dimension sq ;"
-            "TUPLE: circle radius ;"
-            "M: circle area circle-radius sq pi * ;"
-            "TUPLE: rectangle width height ;"
-            "M: rectangle area"
-            "    dup rectangle-width"
-            "    swap rectangle-height"
-            "    * ;"
-        }
-    ;
-
-    { $slide "Geometry example"
-        { $code "10 <square> area ." }
-        { $code "18 <circle> area ." }
-        { $code "20 40 <rectangle> area ." }
-    }
-!    { $slide "Factor: a meta language"
-!        "Writing code which writes code"
-!        "Extensible parser: define new syntax"
-!        "Compiler transforms"
-!        "Here's an inefficient word:"
-!        { $code
-!            ": fib ( x -- y )"
-!            "    dup 1 > ["
-!            "        1 - dup fib swap 1 - fib +"
-!            "    ] when ;"
-!        }
-!    }
-!    { $slide "Memoization"
-!        { { $link POSTPONE: : } " is just another word" }
-!        "What if we could define a word which caches its results?"
-!        { "The " { $vocab-link "memoize" } " library provides such a feature" }
-!        { "Just change " { $link POSTPONE: : } " to " { $link POSTPONE: MEMO: } }
-!        { $code
-!            "MEMO: fib ( x -- y )"
-!            "    dup 1 > ["
-!            "        1 - dup fib swap 1 - fib +"
-!            "    ] when ;"
-!        }
-!    }
-    { $slide "Factor: a tool-building language"
-        "Tools are not monolithic, but are themselves just sets of words"
-        "Examples: parser, compiler, etc"
-        "Parser: turns strings into objects"
-        { $code "\"1\" <file-reader> contents parse" }
-        "Prettyprinter: turns objects into strings"
-        { $code "\"2\" <file-writer> [ . ] with-stream" }
-    }
-    { $slide "Factor: an interactive language"
-        { "Let's hack " { $vocab-link "tetris" } }
-        "Editor integration"
-        { $code "\\ tetrominoes edit" }
-        "Inspector"
-        { $code "\\ tetrominoes get inspect" }
-    }
-    { $slide "C library interface"
-        "No need to write C glue code!"
-        "Callbacks from C to Factor"
-        "Factor can be embedded in C apps"
-        { "Example: " { $vocab-link "ogg.vorbis" } }
-        { "Other bindings: OpenGL, OpenAL, X11, Win32, Cocoa, OpenSSL, memory mapped files, ..." }
-    }
-    { $slide "Native libraries"
-        "XML, HTTP, SMTP, Unicode, calendar, ..."
-        "Lazy lists, pattern matching, packed arrays, ..."
-    }
-    { $slide "Factor: a fun language"
-        { "Let's play "
-        { $vocab-link "space-invaders" }
-        }
-        { $url "http://factorcode.org" }
-        { $url "http://factor-language.blogspot.com" }
-        "irc.freenode.net #concatenative"
-        "Have fun!"
-    }
-} ;
-
-: catalyst-talk catalyst-slides slides-window ;
-
-MAIN: catalyst-talk

extra/catalyst-talk/summary.txt

@@ -1 +0,0 @@
-Slides for a talk at Catalyst IT NZ, July 2007

extra/lcd/lcd.factor

@@ -1,19 +1,19 @@
 USING: sequences kernel math io ;
 IN: lcd
 
-: lcd-digit ( digit row -- str )
+: lcd-digit ( row digit -- str )
-    {
+    dup CHAR: : = [ drop 10 ] [ CHAR: 0 - ] if swap {
-        "  _       _  _       _   _   _   _   _  "
+        "  _       _  _       _   _   _   _   _      "
-        " | |  |   _| _| |_| |_  |_    | |_| |_| "     
+        " | |  |   _| _| |_| |_  |_    | |_| |_|  *  "
-        " |_|  |  |_  _|   |  _| |_|   | |_|   | "
+        " |_|  |  |_  _|   |  _| |_|   | |_|   |  *  "
     } nth >r 4 * dup 4 + r> subseq ;
 
-: lcd-row ( num row -- )
+: lcd-row ( num row -- string )
-    swap [ CHAR: 0 - swap lcd-digit write ] with each ;
+    [ swap lcd-digit ] curry { } map-as concat ;
 
-: lcd ( digit-str -- )
+: lcd ( digit-str -- string )
-    3 [ lcd-row nl ] with each ;
+    3 [ lcd-row ] with map "\n" join ;
 
-: lcd-demo ( -- ) "31337" lcd ;
+: lcd-demo ( -- ) "31337" lcd print ;
 
 MAIN: lcd-demo

extra/minneapolis-talk/minneapolis-talk.factor

@@ -0,0 +1,182 @@
+USING: slides help.markup math arrays hashtables namespaces
+sequences kernel sequences parser memoize ;
+IN: minneapolis-talk
+
+: minneapolis-slides
+{
+    { $slide "What is Factor?"
+        "Dynamically typed, stack language"
+        "Have our cake and eat it too"
+        "Research -vs- production"
+        "High level -vs- performance"
+        "Interactive -vs- stand-alone apps"
+    }
+    { $slide "The view from 10,000 feet"
+        "Influenced by Forth, Lisp, Joy, Smalltalk, even Java..."
+        "Vocabularies: modules"
+        "Words: named functions, classes, variables"
+        "Combinators: higher-order functions"
+        "Quotations: anonymous functions"
+    }
+    { $slide "Stack-based programming"
+        { "Most languages are " { $emphasis "applicative" } }
+        "Words pop inputs from the stack and push outputs on the stack"
+        "Literals are pushed on the stack"
+        { $code "{ 1 2 } { 7 } append reverse sum ." }
+    }
+    { $slide "Stack-based programming"
+        "With the stack you can omit unnecessary names"
+        "You can still name things: lexical/dynamic variables, sequences, associations, objects, ..."
+    }
+    { $slide "Functional programming"
+        "A quotation is a sequence of literals and words"
+        "Combinators replace imperative-style loops"
+        "A simple example:"
+        { $code "10 [ \"Hello world\" print ] times" }
+        { "Partial application: " { $link curry } }
+        { $code "{ 3 1 3 3 7 } [ 5 + ] map ." }
+        { $code "{ 3 1 3 3 7 } 5 [ + ] curry map ." }
+    }
+    { $slide "Word definitions"
+        { $code ": name ( inputs -- outputs )"
+        "    definition ;" }
+        "Stack effect comments document stack inputs and outputs."
+        "Example from previous slide:"
+        { $code ": add-each ( seq n -- newseq )"
+        "    [ + ] curry map ;" }
+        { $code "{ 3 1 3 3 7 } 5 add-each ." }
+    }
+    { $slide "Object-oriented programming"
+        { "Define a tuple class and a constructor:"
+        { $code
+            "TUPLE: person name address ;"
+            "C: <person> person"
+        } }
+        { "Create an instance:"
+        { $code
+            "\"Cosmo Kramer\""
+            "\"100 Blah blah St, New York\""
+            "<person>"
+        } }
+    }
+    { $slide "Object-oriented programming"
+        "We can inspect it and edit objects"
+        "We can reshape the class!"
+        { $code "TUPLE: person" "name address age phone-number ;" }
+        { $code "TUPLE: person" "name address phone-number age ;" }
+    }
+    { $slide "An example"
+        { $code
+            "TUPLE: square dimension ;"
+            "C: <square> square"
+            ""
+            "TUPLE: circle radius ;"
+            "C: <circle> circle"
+            ""
+            "TUPLE: rectangle width height ;"
+            "C: <rectangle> rectangle"
+        }
+    }
+    STRIP-TEASE:
+        $slide "An example"
+        { $code
+            "USE: math.constants"
+            "GENERIC: area ( shape -- meters^2 )"
+            "M: square area square-dimension sq ;"
+            "M: circle area circle-radius sq pi * ;"
+            "M: rectangle area"
+            "    dup rectangle-width"
+            "    swap rectangle-height * ;"
+        }
+    ;
+
+    { $slide "An example"
+        { $code "10 <square> area ." }
+        { $code "18 <circle> area ." }
+        { $code "20 40 <rectangle> area ." }
+    }
+    { $slide "Meta language"
+        "Here's fibonacci:"
+        { $code
+            ": fib ( x -- y )"
+            "    dup 1 > ["
+            "        1 - dup fib swap 1 - fib +"
+            "    ] when ;"
+        }
+        "It is slow:"
+        { $code
+            "35 [ fib ] map ."
+        }
+        "Let's profile it!"
+    }
+    { $slide "Memoization"
+        { { $link POSTPONE: : } " is just another word" }
+        "What if we could define a word which caches its results?"
+        { "The " { $vocab-link "memoize" } " library provides such a feature" }
+        { "Just change " { $link POSTPONE: : } " to " { $link POSTPONE: MEMO: } }
+    }
+    { $slide "Memoization"
+        { $code
+            "USE: memoize"
+            ""
+            "MEMO: fib ( x -- y )"
+            "    dup 1 > ["
+            "        1 - dup fib swap 1 - fib +"
+            "    ] when ;"
+        }
+        "It is faster:"
+        { $code
+            "35 [ fib ] map ."
+        }
+    }
+    { $slide "The Factor UI"
+        "Written in Factor"
+        "Renders with OpenGL"
+        "Backends for Windows, X11, Cocoa"
+        "You can call Windows, X11, Cocoa APIs directly too"
+        "OpenGL 2.1 shaders, OpenAL 3D audio..."
+    }
+    { $slide "Live coding demo"
+        
+    }
+    { $slide "C library interface"
+        "Efficient"
+        "No need to write C code"
+        "Supports floats, structs, unions, ..."
+        "Function pointers, callbacks"
+    }
+    { $slide "Live coding demo"
+        
+    }
+    { $slide "Deployment"
+        { "Let's play " { $vocab-link "tetris" } }
+    }
+    { $slide "Implementation"
+        "Portable: Windows, Mac OS X, Linux"
+        "Non-optimizing compiler"
+        "Optimizing compiler: x86, x86-64, PowerPC, ARM"
+        "Generational garbage collector"
+        "Non-blocking I/O"
+    }
+    { $slide "Some statistics"
+        "VM: 11,800 lines of C"
+        "Core library: 22,600 lines of Factor"
+        "Docs, tests, extra libraries: 117,000 lines of Factor"
+    }
+    { $slide "But wait, there's more!"
+        "Web server and framework, syntax highlighting, Ogg Theora video, SMTP, embedded Prolog, efficient unboxed arrays, XML, Unicode 5.0, memory mapped files, regular expressions, LDAP, database access, coroutines, Factor->JavaScript compiler, JSON, pattern matching, advanced math, parser generators, serialization, RSS/Atom, ..."
+    }
+    { $slide "Community"
+        "Factor development began in 2003"
+        "About a dozen contributors"
+        "Handful of \"core contributors\""
+        { "Web site: " { $url "http://factorcode.org" } }
+        "IRC: #concatenative on irc.freenode.net"
+        "Mailing list: factor-talk@lists.sf.net"
+    }
+    { $slide "Questions?" }
+} ;
+
+: minneapolis-talk minneapolis-slides slides-window ;
+
+MAIN: minneapolis-talk

extra/minneapolis-talk/minneapolis-talk.txt

@@ -0,0 +1,116 @@
+- how to create a small module
+- editor integration
+- presentations
+- module system
+- copy and paste factoring, inverse
+- help system
+- tetris
+- memoization
+- editing inspector demo
+- dynamic scope, lexical scope
+
+Factor: contradictions?
+-----------------------
+
+Have our cake and eat it too
+
+Research -vs- practical
+High level -vs- fast
+Interactive -vs- deployment
+
+Factor from 10,000 feet
+-----------------------
+
+word: named function
+vocabulary: module
+quotation: anonymous function
+classes, objects, etc.
+
+The stack
+---------
+
+- Stack -vs- applicative
+- Pass by reference, dynamically typed
+- Stack languages: you can omit names where they're not needed
+- More compositional style
+- If you need to name things for clarity, you can:
+  lexical vars, dynamic vars, sequences, assocs, objects...
+
+Functional programming
+----------------------
+
+Quotations
+Curry
+Continuations
+
+Object-oriented programming
+---------------------------
+
+Generic words: sort of like open classes
+Tuple reshaping
+Editing inspector
+
+Meta programming
+----------------
+
+Simple, orthogonal core
+
+Why use a stack at all?
+-----------------------
+
+Nice idioms: 10 days ago
+Copy and paste factoring
+Easy meta-programming
+Sequence operations correspond to functional operations:
+- curry is adding at the front
+- compose is append
+
+UI
+--
+
+Written in Factor
+renders with OpenGL
+Windows, X11, Cocoa backends
+You can call Windows, X11, Cocoa APIs directly
+OpenGL 2.1 shaders, OpenAL 3D audio...
+
+Tools
+-----
+
+Edit
+Usages
+Profiler
+Easy to make your own tools
+
+Implementation
+--------------
+
+Two compilers
+Generational garbage collector
+Non-blocking I/O
+
+Hands on
+--------
+
+Community
+---------
+
+Factor started in 2003
+About a dozen contributors
+Handful of "core contributors"
+Web site: http://factorcode.org
+IRC: #concatenative on irc.freenode.net
+Mailing list: factor-talk@lists.sf.net
+
+C library interface
+-------------------
+
+Efficient
+No need to write C code
+Supports floats, structs, unions, ...
+Function pointers, callbacks
+Here is an example
+
+TerminateProcess
+
+process-handle TerminateProcess

extra/minneapolis-talk/summary.txt

@@ -0,0 +1 @@
+Slides for a talk at Ruby.mn, Minneapolis MN, January 2008

extra/tools/deploy/backend/backend.factor

@@ -9,50 +9,77 @@ quotations io.launcher words.private tools.deploy.config
 bootstrap.image ;
 IN: tools.deploy.backend
 
-: boot-image-name ( -- string )
-    "boot." my-arch ".image" 3append ;
-
-: stage1 ( -- )
-    #! If stage1 image doesn't exist, create one.
-    boot-image-name resource-path exists?
-    [ my-arch make-image ] unless ;
-
 : (copy-lines) ( stream -- stream )
     dup stream-readln [ print flush (copy-lines) ] when* ;
 
 : copy-lines ( stream -- )
     [ (copy-lines) ] [ stream-close ] [ ] cleanup ;
 
-: ?append swap [ append ] [ drop ] if ;
+: run-with-output ( descriptor -- )
+    <process-stream>
+    dup duplex-stream-out stream-close
+    copy-lines ;
 
-: profile-string ( config -- string )
+: boot-image-name ( -- string )
+    "boot." my-arch ".image" 3append ;
+
+: make-boot-image ( -- )
+    #! If stage1 image doesn't exist, create one.
+    boot-image-name resource-path exists?
+    [ my-arch make-image ] unless ;
+
+: ?, [ , ] [ drop ] if ;
+
+: bootstrap-profile ( config -- profile )
     [
-        ""
+        [
-        deploy-math? get " math" ?append
+            "math" deploy-math? get ?,
-        deploy-compiler? get " compiler" ?append
+            "compiler" deploy-compiler? get ?,
-        deploy-ui? get " ui" ?append
+            "ui" deploy-ui? get ?,
-        native-io? " io" ?append
+            "io" native-io? ?,
+        ] { } make
     ] bind ;
 
-: deploy-command-line ( vm image vocab config -- vm flags )
+: staging-image-name ( profile -- name )
+    "staging." swap bootstrap-profile "-" join ".image" 3append ;
+
+: staging-command-line ( config -- flags )
     [
-        "-include=" swap profile-string append ,
+        "-i=" boot-image-name append ,
 
-        "-deploy-vocab=" swap append ,
+        "-output-image=" over staging-image-name append ,
 
-        "-output-image=" swap append ,
+        "-include=" swap bootstrap-profile " " join append ,
 
         "-no-stack-traces" ,
 
         "-no-user-init" ,
     ] { } make ;
 
-: stage2 ( vm image vocab config -- )
+: run-factor ( vm flags -- )
-    deploy-command-line
+    dup . swap add* run-with-output ; inline
-    >r "-i=" boot-image-name append 2array r> append dup .
+
-    <process-stream>
+: make-staging-image ( vm config -- )
-    dup duplex-stream-out stream-close
+    staging-command-line run-factor ;
-    copy-lines ;
+
+: deploy-command-line ( image vocab config -- flags )
+    [
+        "-i=" swap staging-image-name append ,
+
+        "-run=tools.deploy.shaker" ,
+
+        "-deploy-vocab=" swap append ,
+
+        "-output-image=" swap append ,
+
+        "-no-stack-traces" ,
+    ] { } make ;
+
+: make-deploy-image ( vm image vocab config -- )
+    dup staging-image-name exists? [
+        >r pick r> tuck make-staging-image
+    ] unless
+    deploy-command-line run-factor ;
 
 SYMBOL: deploy-implementation
 

extra/tools/deploy/macosx/macosx.factor

@@ -72,13 +72,12 @@ T{ macosx-deploy-implementation } deploy-implementation set-global
     -> selectFile:inFileViewerRootedAtPath: drop ;
 
 M: macosx-deploy-implementation deploy* ( vocab -- )
-    stage1
     ".app deploy tool" assert.app
     "." resource-path cd
     dup deploy-config [
         bundle-name rm
         [ bundle-name create-app-dir ] keep
         [ bundle-name deploy.app-image ] keep
-        namespace stage2
+        namespace make-deploy-image
         bundle-name show-in-finder
     ] bind ;

extra/tools/deploy/windows/windows.factor

@@ -34,11 +34,10 @@ TUPLE: windows-deploy-implementation ;
 T{ windows-deploy-implementation } deploy-implementation set-global
 
 M: windows-deploy-implementation deploy*
-    stage1
     "." resource-path cd
     dup deploy-config [
         [ deploy-name get create-exe-dir ] keep
         [ deploy-name get image-name ] keep
-        [ namespace stage2 ] keep
+        [ namespace make-deploy-image ] keep
         open-in-explorer
     ] bind ;

extra/ui/freetype/freetype.factor

@@ -3,7 +3,7 @@
 USING: alien alien.c-types arrays io kernel libc math
 math.vectors namespaces opengl opengl.gl prettyprint assocs
 sequences io.files io.styles continuations freetype
-ui.gadgets.worlds ui.render ui.backend io.mmap ;
+ui.gadgets.worlds ui.render ui.backend byte-arrays ;
 IN: ui.freetype
 
 TUPLE: freetype-renderer ;
@@ -63,18 +63,23 @@ M: freetype-renderer free-fonts ( world -- )
 : ttf-path ( name -- string )
     "/fonts/" swap ".ttf" 3append resource-path ;
 
-: (open-face) ( mapped-file -- face )
+: (open-face) ( path length -- face )
     #! We use FT_New_Memory_Face, not FT_New_Face, since
     #! FT_New_Face only takes an ASCII path name and causes
     #! problems on localized versions of Windows
-    freetype swap dup mapped-file-address swap length 0 f
+    freetype -rot 0 f <void*> [
-    <void*> [ FT_New_Memory_Face freetype-error ] keep *void* ;
+        FT_New_Memory_Face freetype-error
+    ] keep *void* ;
 
 : open-face ( font style -- face )
-    ttf-name ttf-path dup file-length
+    ttf-name ttf-path
-    <mapped-file> (open-face) ;
+    dup file-contents >byte-array malloc-byte-array
+    swap file-length
+    (open-face) ;
 
-: dpi 72 ; inline
+SYMBOL: dpi
+
+72 dpi set-global
 
 : ft-floor -6 shift ; inline
 
@@ -101,7 +106,8 @@ M: freetype-renderer free-fonts ( world -- )
 
 : (open-font) ( font -- open-font )
     first3 >r open-face dup 0 r> 6 shift
-    dpi dpi FT_Set_Char_Size freetype-error <font> ;
+    dpi get-global dpi get-global FT_Set_Char_Size
+    freetype-error <font> ;
 
 M: freetype-renderer open-font ( font -- open-font )
     freetype drop open-fonts get [ (open-font) ] cache ;

extra/ui/gadgets/labels/labels.factor

@@ -40,7 +40,7 @@ M: label gadget-text* label-string % ;
 TUPLE: label-control ;
 
 M: label-control model-changed
-    swap model-value over set-label-text relayout ;
+    swap model-value over set-label-string relayout ;
 
 : <label-control> ( model -- gadget )
     "" <label> label-control construct-control ;

extra/ui/ui.factor

@@ -122,7 +122,7 @@ SYMBOL: ui-hook
 : notify ( gadget -- )
     dup gadget-graft-state dup first { f f } { t t } ? pick set-gadget-graft-state {
         { { f t } [ dup activate-control graft* ] }
-        { { t f } [ dup activate-control ungraft* ] }
+        { { t f } [ dup deactivate-control ungraft* ] }
     } case ;
 
 : notify-queued ( -- )