diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor index d877ad9b81..62636fdcdf 100755 --- a/basis/ui/backend/backend.factor +++ b/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 -- ) diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index f6745e4bc2..0213b8433c 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/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 [ 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 @@ -133,7 +130,8 @@ CONSTANT: window-control>styleMask M:: cocoa-ui-backend (open-window) ( world -- ) world [ [ dim>> ] dip ] 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 :> window view -> release world view register-window diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 4c581a86e3..9577696314 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -401,7 +401,7 @@ CLASS: { { "isOpaque" "char" { "id" "SEL" } [ - drop window transparent?>> not >c-bool + 2drop 0 ] } diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 3d8f5b1530..0e07ff6611 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/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 ; 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&& - [ full-window-margins DwmExtendFrameIntoClientArea drop ] - [ drop ] if ; + over window-controls>> textured-background swap memq? [ + composition-enabled? [ + 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 ; diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor index 049c7886fd..56bc3364ac 100755 --- a/basis/ui/backend/x11/x11.factor +++ b/basis/ui/backend/x11/x11.factor @@ -63,9 +63,6 @@ M: x11-ui-backend (pixel-format-attribute) 0 [ 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 } diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 535715b8ed..b736c3f74f 100755 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/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* ] diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 39be7936af..8ce9074225 100755 --- a/basis/ui/render/render.factor +++ b/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 ; - -: clear-gl ( transparent? -- ) + [ init-clip ] [ - system-background-color - [ red>> ] [ green>> ] [ blue>> ] tri 0.0 - glClearColor + background-color>> >rgba-components glClearColor GL_COLOR_BUFFER_BIT glClear - ] [ - ! 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 ; + ] bi ; GENERIC: draw-gadget* ( gadget -- ) diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 49287ed112..0a5572e530 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -74,7 +74,7 @@ name>char-hook [ 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 -- ) - [ rest-of-line % ] - [ next-line "\n" % ] bi ; - -: rest-begins? ( string -- ? ) +: lexer-head? ( 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 ; diff --git a/extra/benchmark/e-decimals/authors.txt b/extra/benchmark/e-decimals/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/benchmark/e-decimals/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/benchmark/e-decimals/e-decimals.factor b/extra/benchmark/e-decimals/e-decimals.factor new file mode 100644 index 0000000000..d202e5ff76 --- /dev/null +++ b/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 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 diff --git a/extra/benchmark/e-ratios/authors.txt b/extra/benchmark/e-ratios/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/benchmark/e-ratios/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/benchmark/e-ratios/e-ratios.factor b/extra/benchmark/e-ratios/e-ratios.factor new file mode 100644 index 0000000000..4957822b5e --- /dev/null +++ b/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