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

db4
Doug Coleman 2009-09-25 16:51:53 -05:00
commit 6fb6cbf0fc
9 changed files with 37 additions and 41 deletions

View File

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

View File

@ -58,9 +58,6 @@ M: cocoa-ui-backend (pixel-format-attribute)
[ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ] [ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
if-empty ; if-empty ;
M: cocoa-ui-backend system-background-color
T{ rgba f 0.0 0.0 0.0 0.0 } ; inline
TUPLE: pasteboard handle ; TUPLE: pasteboard handle ;
C: <pasteboard> pasteboard C: <pasteboard> pasteboard
@ -133,7 +130,8 @@ CONSTANT: window-control>styleMask
M:: cocoa-ui-backend (open-window) ( world -- ) M:: cocoa-ui-backend (open-window) ( world -- )
world [ [ dim>> ] dip <FactorView> ] world [ [ dim>> ] dip <FactorView> ]
with-world-pixel-format :> view 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 world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
view -> release view -> release
world view register-window world view register-window

View File

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

View File

@ -165,11 +165,6 @@ M: windows-ui-backend (pixel-format-attribute)
over world>> has-wglChoosePixelFormatARB? over world>> has-wglChoosePixelFormatARB?
[ arb-pixel-format-attribute ] [ pfd-pixel-format-attribute ] if ; [ 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> PRIVATE>
: lo-word ( wparam -- lo ) <short> *short ; inline : lo-word ( wparam -- lo ) <short> *short ; inline
@ -538,10 +533,17 @@ SYMBOL: nc-buttons
#! message sent if mouse leaves main application #! message sent if mouse leaves main application
4drop forget-rollover ; 4drop forget-rollover ;
: system-background-color ( -- color )
COLOR_BTNFACE GetSysColor RGB>color ;
: ?make-glass ( world hwnd -- ) : ?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 -- ) : handle-wm-dwmcompositionchanged ( hWnd uMsg wParam lParam -- )
3drop [ window ] keep ?make-glass ; 3drop [ window ] keep ?make-glass ;

View File

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

View File

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

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math.rectangles math.vectors namespaces kernel accessors USING: math.rectangles math.vectors namespaces kernel accessors
assocs combinators sequences opengl opengl.gl colors assocs combinators sequences opengl opengl.gl colors
colors.constants ui.backend ui.gadgets ui.pens ; colors.constants ui.gadgets ui.pens ;
IN: ui.render IN: ui.render
SYMBOL: clip SYMBOL: clip
@ -27,27 +27,20 @@ SYMBOL: viewport-translation
[ clip set ] bi [ clip set ] bi
do-clip ; do-clip ;
: init-gl ( clip-rect -- ) SLOT: background-color
: init-gl ( world -- )
GL_SMOOTH glShadeModel GL_SMOOTH glShadeModel
GL_SCISSOR_TEST glEnable GL_SCISSOR_TEST glEnable
GL_BLEND glEnable GL_BLEND glEnable
GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
GL_VERTEX_ARRAY glEnableClientState GL_VERTEX_ARRAY glEnableClientState
init-matrices 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 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 -- ) GENERIC: draw-gadget* ( gadget -- )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax unix.types unix.stat classes.struct ; USING: alien.syntax alien.c-types unix.types unix.stat classes.struct ;
IN: unix.statfs.freebsd IN: unix.statfs.freebsd
CONSTANT: MFSNAMELEN 16 ! length of type name including null */ CONSTANT: MFSNAMELEN 16 ! length of type name including null */

View File

@ -139,14 +139,14 @@ CONSTANT: cpus
{ "macosx" "Mac OS X 10.5 Leopard" } { "macosx" "Mac OS X 10.5 Leopard" }
{ "linux" "Ubuntu Linux 9.04 (other distributions may also work)" } { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" }
{ "freebsd" "FreeBSD 7.0" } { "freebsd" "FreeBSD 7.0" }
{ "netbsd" "NetBSD 4.0" } { "netbsd" "NetBSD 5.0" }
{ "openbsd" "OpenBSD 4.4" } { "openbsd" "OpenBSD 4.4" }
} at } at
] [ ] [
dup cpu>> "x86.32" = [ dup cpu>> "x86.32" = [
os>> { os>> {
{ [ dup { "winnt" "linux" "freebsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } { [ dup { "winnt" "linux" "freebsd" "netbsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] }
{ [ dup { "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } { [ dup {"openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] }
{ [ t ] [ drop f ] } { [ t ] [ drop f ] }
} cond } cond
] [ drop f ] if ] [ drop f ] if