Merge branch 'master' of git://factorcode.org/git/factor

basis/ui/backend/backend.factor

@@ -21,8 +21,6 @@ HOOK: (close-offscreen-buffer) ui-backend ( handle -- )
 
 HOOK: raise-window* ui-backend ( world -- )
 
-HOOK: system-background-color ui-backend ( -- color )
-
 GENERIC: select-gl-context ( handle -- )
 
 GENERIC: flush-gl-context ( handle -- )

basis/ui/backend/cocoa/cocoa.factor

@@ -7,7 +7,7 @@ cocoa.views cocoa.windows combinators command-line
 core-foundation core-foundation.run-loop core-graphics
 core-graphics.types destructors fry generalizations io.thread
 kernel libc literals locals math math.bitwise math.rectangles memory
-namespaces sequences threads ui
+namespaces sequences threads ui colors
 ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
 ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
 ui.private words.symbol ;
@@ -58,9 +58,6 @@ M: cocoa-ui-backend (pixel-format-attribute)
     [ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
     if-empty ;
 
-M: cocoa-ui-backend system-background-color
-    T{ rgba f 0.0 0.0 0.0 0.0 } ; inline
-
 TUPLE: pasteboard handle ;
 
 C: <pasteboard> pasteboard
@@ -133,7 +130,8 @@ CONSTANT: window-control>styleMask
 M:: cocoa-ui-backend (open-window) ( world -- )
     world [ [ dim>> ] dip <FactorView> ]
     with-world-pixel-format :> view
-    world transparent?>> [ view make-context-transparent ] when
+    world window-controls>> textured-background swap memq?
+    [ view make-context-transparent ] when
     view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
     view -> release
     world view register-window

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

@@ -401,7 +401,7 @@ CLASS: {
 
 { "isOpaque" "char" { "id" "SEL" }
     [
-        drop window transparent?>> not >c-bool
+        2drop 0
     ]
 }
 

basis/ui/backend/windows/windows.factor

@@ -165,11 +165,6 @@ M: windows-ui-backend (pixel-format-attribute)
     over world>> has-wglChoosePixelFormatARB?
     [ arb-pixel-format-attribute ] [ pfd-pixel-format-attribute ] if ;
 
-M: windows-ui-backend system-background-color
-    composition-enabled?
-    [ T{ rgba f 0.0 0.0 0.0 0.0 } ]
-    [ COLOR_BTNFACE GetSysColor RGB>color ] if ;
-
 PRIVATE>
 
 : lo-word ( wparam -- lo ) <short> *short ; inline
@@ -538,10 +533,17 @@ SYMBOL: nc-buttons
     #! message sent if mouse leaves main application 
     4drop forget-rollover ;
 
+: system-background-color ( -- color )
+    COLOR_BTNFACE GetSysColor RGB>color ;
+
 : ?make-glass ( world hwnd -- )
-    swap { [ transparent?>> ] [ drop windows-major 6 >= ] } 1&&
+    over window-controls>> textured-background swap memq? [
-    [ full-window-margins DwmExtendFrameIntoClientArea drop ]
+        composition-enabled? [
-    [ drop ] if ;
+            full-window-margins DwmExtendFrameIntoClientArea drop
+            T{ rgba f 0.0 0.0 0.0 0.0 }
+        ] [ drop system-background-color ] if >>background-color
+        drop
+    ] [ 2drop ] if ;
 
 : handle-wm-dwmcompositionchanged ( hWnd uMsg wParam lParam -- )
     3drop [ window ] keep ?make-glass ;

basis/ui/backend/x11/x11.factor

@@ -63,9 +63,6 @@ M: x11-ui-backend (pixel-format-attribute)
         0 <int> [ glXGetConfig drop ] keep *int
     ] if-empty ;
 
-M: x11-ui-backend system-background-color
-    T{ rgba f 0.0 0.0 0.0 0.0 } ; inline
-
 CONSTANT: modifiers
     {
         { S+ HEX: 1 }

basis/ui/gadgets/worlds/worlds.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-namespaces opengl opengl.textures sequences io combinators
+namespaces opengl opengl.textures sequences io colors combinators
 combinators.short-circuit fry math.vectors math.rectangles cache
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 ui.pixel-formats destructors literals strings ;
@@ -17,7 +17,11 @@ SYMBOLS:
     textured-background ;
 
 CONSTANT: default-world-pixel-format-attributes
-    { windowed double-buffered T{ depth-bits { value 16 } } }
+    {
+        windowed
+        double-buffered
+        T{ depth-bits { value 16 } }
+    }
 
 CONSTANT: default-world-window-controls
     {
@@ -35,7 +39,7 @@ TUPLE: world < track
     text-handle handle images
     window-loc
     pixel-format-attributes
-    transparent?
+    background-color
     window-controls
     window-resources ;
 
@@ -115,13 +119,18 @@ M: world request-focus-on ( child gadget -- )
         f >>grab-input?
         V{ } clone >>window-resources ;
 
+: initial-background-color ( attributes -- color )
+    window-controls>> textured-background swap memq?
+    [ T{ rgba f 0.0 0.0 0.0 0.0 } ]
+    [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ;
+
 : apply-world-attributes ( world attributes -- world )
     {
         [ title>> >>title ]
         [ status>> >>status ]
         [ pixel-format-attributes>> >>pixel-format-attributes ]
         [ window-controls>> >>window-controls ]
-        [ window-controls>> textured-background swap memq? >>transparent? ]
+        [ initial-background-color >>background-color ]
         [ grab-input?>> >>grab-input? ]
         [ gadgets>> [ 1 track-add ] each ]
     } cleave ;
@@ -177,7 +186,6 @@ M: world draw-world*
     check-extensions
     {
         [ init-gl ]
-        [ transparent?>> clear-gl ]
         [ draw-gadget ]
         [ text-handle>> [ purge-cache ] when* ]
         [ images>> [ purge-cache ] when* ]

basis/ui/render/render.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math.rectangles math.vectors namespaces kernel accessors
 assocs combinators sequences opengl opengl.gl colors
-colors.constants ui.backend ui.gadgets ui.pens ;
+colors.constants ui.gadgets ui.pens ;
 IN: ui.render
 
 SYMBOL: clip
@@ -27,27 +27,20 @@ SYMBOL: viewport-translation
     [ clip set ] bi
     do-clip ;
 
-: init-gl ( clip-rect -- )
+SLOT: background-color
+
+: init-gl ( world -- )
     GL_SMOOTH glShadeModel
     GL_SCISSOR_TEST glEnable
     GL_BLEND glEnable
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
     GL_VERTEX_ARRAY glEnableClientState
     init-matrices
-    init-clip ;
+    [ init-clip ]
-
-: clear-gl ( transparent? -- )
     [
-        system-background-color
+        background-color>> >rgba-components glClearColor
-        [ red>> ] [ green>> ] [ blue>> ] tri 0.0
-        glClearColor
         GL_COLOR_BUFFER_BIT glClear
-    ] [
+    ] bi ;
-        ! white gl-clear is broken w.r.t window resizing
-        ! Linux/PPC Radeon 9200
-        COLOR: white gl-color
-        { 0 0 } clip get dim>> gl-fill-rect
-    ] if ;
 
 GENERIC: draw-gadget* ( gadget -- )
 

core/strings/parser/parser.factor

@@ -74,7 +74,7 @@ name>char-hook [
 
 <PRIVATE
 
-: lexer-before ( i -- before )
+: lexer-subseq ( i -- before )
     [
         [
             lexer get
@@ -84,11 +84,6 @@ name>char-hook [
         lexer get (>>column)
     ] bi ;
 
-: find-next-token ( ch -- i elt )
-    CHAR: \ 2array
-    [ lexer get [ column>> ] [ line-text>> ] bi ] dip
-    [ member? ] curry find-from ;
-
 : rest-of-line ( lexer -- seq )
     [ line-text>> ] [ column>> ] bi tail-slice ;
 
@@ -107,11 +102,7 @@ ERROR: escaped-char-expected ;
         escaped-char-expected
     ] if ;
 
-: next-line% ( lexer -- )
+: lexer-head? ( string -- ? )
-    [ rest-of-line % ]
-    [ next-line "\n" % ] bi ;
-
-: rest-begins? ( string -- ? )
     [
         lexer get [ line-text>> ] [ column>> ] bi tail-slice
     ] dip head? ;
@@ -119,6 +110,15 @@ ERROR: escaped-char-expected ;
 : advance-lexer ( n -- )
     [ lexer get ] dip [ + ] curry change-column drop ; inline
 
+: find-next-token ( ch -- i elt )
+    CHAR: \ 2array
+    [ lexer get [ column>> ] [ line-text>> ] bi ] dip
+    [ member? ] curry find-from ;
+
+: next-line% ( lexer -- )
+    [ rest-of-line % ]
+    [ next-line "\n" % ] bi ;
+
 : take-double-quotes ( -- string )
     lexer get dup current-char CHAR: " = [
         [ ] [ column>> ] [ line-text>> ] tri
@@ -138,29 +138,29 @@ ERROR: escaped-char-expected ;
         lexer get advance-char
     ] if ;
 
-DEFER: (parse-long-string)
+DEFER: (parse-multiline-string)
 
 : parse-found-token ( i string token -- )
-    [ lexer-before % ] dip
+    [ lexer-subseq % ] dip
     CHAR: \ = [
-        lexer get [ next-char , ] [ next-char , ] bi (parse-long-string)
+        lexer get [ next-char , ] [ next-char , ] bi (parse-multiline-string)
     ] [
-        dup rest-begins? [
+        dup lexer-head? [
             end-string-parse
         ] [
-            lexer get next-char , (parse-long-string)
+            lexer get next-char , (parse-multiline-string)
         ] if
     ] if ;
 
 ERROR: trailing-characters string ;
 
-: (parse-long-string) ( string -- )
+: (parse-multiline-string) ( string -- )
     lexer get still-parsing? [
         dup first find-next-token [
             parse-found-token
         ] [
             drop lexer get next-line%
-            (parse-long-string)
+            (parse-multiline-string)
         ] if*
     ] [
         unexpected-eof
@@ -168,13 +168,10 @@ ERROR: trailing-characters string ;
 
 PRIVATE>
 
-: parse-long-string ( string -- string' )
-    [ (parse-long-string) ] "" make ;
-
 : parse-multiline-string ( -- string )
     lexer get rest-of-line "\"\"" head? [
         lexer get [ 2 + ] change-column drop
         "\"\"\""
     ] [
         "\""
-    ] if parse-long-string unescape-string ;
+    ] if [ (parse-multiline-string) ] "" make unescape-string ;

extra/benchmark/e-decimals/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/benchmark/e-decimals/e-decimals.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: decimals kernel locals math math.combinatorics math.ranges
+sequences ;
+IN: benchmark.e-decimals
+
+:: calculate-e-decimals ( n -- e )
+    n [1,b] [ factorial 0 <decimal> D: 1 swap n D/ ] map
+    D: 1 [ D+ ] reduce ;
+
+: calculate-e-decimals-benchmark ( -- )
+    5 [ 800 calculate-e-decimals drop ] times ;
+
+MAIN: calculate-e-decimals-benchmark

extra/benchmark/e-ratios/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/benchmark/e-ratios/e-ratios.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.combinatorics math.ranges sequences ;
+IN: benchmark.e-ratios
+
+: calculate-e-ratios ( n -- e )
+    iota [ factorial recip ] sigma ;
+
+: calculate-e-ratios-benchmark ( -- )
+    5 [ 300 calculate-e-ratios drop ] times ;
+
+MAIN: calculate-e-ratios-benchmark