From bf3b15409148ce2a0cdedb285e87a460111ebf63 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Sep 2009 19:43:57 -0500 Subject: [PATCH 1/8] rename a couple of strings.parser words --- core/strings/parser/parser.factor | 36 +++++++++++++++---------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 49287ed112..6ef5075fd9 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -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,10 +102,6 @@ ERROR: escaped-char-expected ; escaped-char-expected ] if ; -: next-line% ( lexer -- ) - [ rest-of-line % ] - [ next-line "\n" % ] bi ; - : rest-begins? ( string -- ? ) [ lexer get [ line-text>> ] [ column>> ] bi tail-slice @@ -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,38 +138,38 @@ 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 CHAR: \ = [ - lexer get [ next-char , ] [ next-char , ] bi (parse-long-string) + lexer get [ next-char , ] [ next-char , ] bi ((parse-multiline-string)) ] [ dup rest-begins? [ 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 ] if ; -PRIVATE> +: (parse-multiline-string) ( string -- string' ) + [ ((parse-multiline-string)) ] "" make ; -: parse-long-string ( string -- string' ) - [ (parse-long-string) ] "" make ; +PRIVATE> : parse-multiline-string ( -- string ) lexer get rest-of-line "\"\"" head? [ @@ -177,4 +177,4 @@ PRIVATE> "\"\"\"" ] [ "\"" - ] if parse-long-string unescape-string ; + ] if (parse-multiline-string) unescape-string ; From c0294195e67f4e9b65c3d332ebd5a2eaa871d306 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Sep 2009 19:45:03 -0500 Subject: [PATCH 2/8] rename another strings.parser word --- core/strings/parser/parser.factor | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 6ef5075fd9..a69c3becc3 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -138,37 +138,34 @@ ERROR: escaped-char-expected ; lexer get advance-char ] if ; -DEFER: ((parse-multiline-string)) +DEFER: (parse-multiline-string) : parse-found-token ( i string token -- ) [ lexer-before % ] dip CHAR: \ = [ - lexer get [ next-char , ] [ next-char , ] bi ((parse-multiline-string)) + lexer get [ next-char , ] [ next-char , ] bi (parse-multiline-string) ] [ dup rest-begins? [ end-string-parse ] [ - lexer get next-char , ((parse-multiline-string)) + lexer get next-char , (parse-multiline-string) ] if ] if ; ERROR: trailing-characters string ; -: ((parse-multiline-string)) ( string -- ) +: (parse-multiline-string) ( string -- ) lexer get still-parsing? [ dup first find-next-token [ parse-found-token ] [ drop lexer get next-line% - ((parse-multiline-string)) + (parse-multiline-string) ] if* ] [ unexpected-eof ] if ; -: (parse-multiline-string) ( string -- string' ) - [ ((parse-multiline-string)) ] "" make ; - PRIVATE> : parse-multiline-string ( -- string ) @@ -177,4 +174,4 @@ PRIVATE> "\"\"\"" ] [ "\"" - ] if (parse-multiline-string) unescape-string ; + ] if [ (parse-multiline-string) ] "" make unescape-string ; From 9963213900f0b758cc38d263bc1f51265e330030 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Sep 2009 19:47:44 -0500 Subject: [PATCH 3/8] rename a couple more words --- core/strings/parser/parser.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index a69c3becc3..0a5572e530 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -74,7 +74,7 @@ name>char-hook [ > ] [ column>> ] bi tail-slice ] dip head? ; @@ -141,11 +141,11 @@ ERROR: escaped-char-expected ; 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-multiline-string) ] [ - dup rest-begins? [ + dup lexer-head? [ end-string-parse ] [ lexer get next-char , (parse-multiline-string) From 28d78c99543c41d0c3520c1213cac595f7ff5450 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 24 Sep 2009 20:25:41 -0500 Subject: [PATCH 4/8] fix cocoa bootstrap --- basis/ui/backend/cocoa/cocoa.factor | 2 +- basis/ui/backend/x11/x11.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index f6745e4bc2..ad710092c3 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 ; diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor index 049c7886fd..6f9c8589fc 100755 --- a/basis/ui/backend/x11/x11.factor +++ b/basis/ui/backend/x11/x11.factor @@ -64,7 +64,7 @@ M: x11-ui-backend (pixel-format-attribute) ] if-empty ; M: x11-ui-backend system-background-color - T{ rgba f 0.0 0.0 0.0 0.0 } ; inline + T{ rgba f 1.0 1.0 1.0 0.0 } ; inline CONSTANT: modifiers { From 5e9de85aac9b55171c06916049ea7341485946f2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Sep 2009 22:11:23 -0500 Subject: [PATCH 5/8] add benchmarks to cacluate e using decimals, ratios --- work/benchmark/e-decimals/authors.txt | 1 + work/benchmark/e-decimals/e-decimals.factor | 14 ++++++++++++++ work/benchmark/e-ratios/authors.txt | 1 + work/benchmark/e-ratios/e-ratios.factor | 12 ++++++++++++ 4 files changed, 28 insertions(+) create mode 100644 work/benchmark/e-decimals/authors.txt create mode 100644 work/benchmark/e-decimals/e-decimals.factor create mode 100644 work/benchmark/e-ratios/authors.txt create mode 100644 work/benchmark/e-ratios/e-ratios.factor diff --git a/work/benchmark/e-decimals/authors.txt b/work/benchmark/e-decimals/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/work/benchmark/e-decimals/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/work/benchmark/e-decimals/e-decimals.factor b/work/benchmark/e-decimals/e-decimals.factor new file mode 100644 index 0000000000..d202e5ff76 --- /dev/null +++ b/work/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/work/benchmark/e-ratios/authors.txt b/work/benchmark/e-ratios/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/work/benchmark/e-ratios/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/work/benchmark/e-ratios/e-ratios.factor b/work/benchmark/e-ratios/e-ratios.factor new file mode 100644 index 0000000000..4957822b5e --- /dev/null +++ b/work/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 From b85616fa6197a0c1834940fbd60eadba29bb211e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Sep 2009 22:58:42 -0500 Subject: [PATCH 6/8] move benchmarks from work to extra. wtf oops --- {work => extra}/benchmark/e-decimals/authors.txt | 0 {work => extra}/benchmark/e-decimals/e-decimals.factor | 0 {work => extra}/benchmark/e-ratios/authors.txt | 0 {work => extra}/benchmark/e-ratios/e-ratios.factor | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename {work => extra}/benchmark/e-decimals/authors.txt (100%) rename {work => extra}/benchmark/e-decimals/e-decimals.factor (100%) rename {work => extra}/benchmark/e-ratios/authors.txt (100%) rename {work => extra}/benchmark/e-ratios/e-ratios.factor (100%) diff --git a/work/benchmark/e-decimals/authors.txt b/extra/benchmark/e-decimals/authors.txt similarity index 100% rename from work/benchmark/e-decimals/authors.txt rename to extra/benchmark/e-decimals/authors.txt diff --git a/work/benchmark/e-decimals/e-decimals.factor b/extra/benchmark/e-decimals/e-decimals.factor similarity index 100% rename from work/benchmark/e-decimals/e-decimals.factor rename to extra/benchmark/e-decimals/e-decimals.factor diff --git a/work/benchmark/e-ratios/authors.txt b/extra/benchmark/e-ratios/authors.txt similarity index 100% rename from work/benchmark/e-ratios/authors.txt rename to extra/benchmark/e-ratios/authors.txt diff --git a/work/benchmark/e-ratios/e-ratios.factor b/extra/benchmark/e-ratios/e-ratios.factor similarity index 100% rename from work/benchmark/e-ratios/e-ratios.factor rename to extra/benchmark/e-ratios/e-ratios.factor From 97985645361659598b1ee080525606cbf4f9a62b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 25 Sep 2009 09:42:09 -0500 Subject: [PATCH 7/8] clean up textured window code --- basis/ui/backend/backend.factor | 2 -- basis/ui/backend/cocoa/cocoa.factor | 6 ++---- basis/ui/backend/cocoa/views/views.factor | 2 +- basis/ui/backend/windows/windows.factor | 19 +++++++++++-------- basis/ui/backend/x11/x11.factor | 3 --- basis/ui/gadgets/worlds/worlds.factor | 18 +++++++++++++----- basis/ui/render/render.factor | 21 +++++++-------------- 7 files changed, 34 insertions(+), 37 deletions(-) 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 ad710092c3..0213b8433c 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -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..88e1e39fd8 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,18 @@ 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 { + [ composition-enabled? ] + [ window-controls>> textured-background swap memq? ] + } 1&& + [ + full-window-margins DwmExtendFrameIntoClientArea drop + T{ rgba f 0.0 0.0 0.0 0.0 } + ] [ system-background-color ] if >>background-color ; : 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 6f9c8589fc..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 1.0 1.0 1.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 -- ) From bcd5e72989918cd1788cc927616577c78126e071 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 25 Sep 2009 10:00:23 -0500 Subject: [PATCH 8/8] fix windows --- basis/ui/backend/windows/windows.factor | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 88e1e39fd8..0e07ff6611 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -537,14 +537,13 @@ SYMBOL: nc-buttons COLOR_BTNFACE GetSysColor RGB>color ; : ?make-glass ( world hwnd -- ) - over { - [ composition-enabled? ] - [ window-controls>> textured-background swap memq? ] - } 1&& - [ - full-window-margins DwmExtendFrameIntoClientArea drop - T{ rgba f 0.0 0.0 0.0 0.0 } - ] [ system-background-color ] if >>background-color ; + 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 ;