From 469e7e8d67979fac70becbc25ac2140540d2c9a3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Aug 2009 20:35:37 -0500 Subject: [PATCH 1/3] newstructify PIXELFORMAT --- basis/io/backend/windows/nt/nt.factor | 8 +-- basis/ui/backend/windows/windows.factor | 77 +++++++++++++------------ basis/windows/types/types.factor | 56 +++++++++--------- basis/windows/user32/user32.factor | 2 +- 4 files changed, 72 insertions(+), 71 deletions(-) diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index e29aa6c618..aa113c0efe 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -3,7 +3,7 @@ destructors io io.backend io.ports io.timeouts io.backend.windows io.files.windows io.files.windows.nt io.files io.pathnames io.buffers io.streams.c io.streams.null libc kernel math namespaces sequences threads windows windows.errors windows.kernel32 strings splitting -ascii system accessors locals classes.struct ; +ascii system accessors locals classes.struct combinators.short-circuit ; QUALIFIED: windows.winsock IN: io.backend.windows.nt @@ -36,7 +36,7 @@ M: winnt add-completion ( win32-handle -- ) handle>> master-completion-port get-global drop ; : eof? ( error -- ? ) - [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ; + { [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ; : twiddle-thumbs ( overlapped port -- bytes-transferred ) [ @@ -66,9 +66,9 @@ M: winnt add-completion ( win32-handle -- ) : handle-overlapped ( us -- ? ) wait-for-overlapped [ - dup [ + [ [ drop GetLastError 1array ] dip resume-callback t - ] [ 2drop f ] if + ] [ drop f ] if* ] [ resume-callback t ] if ; M: win32-handle cancel-operation diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index f23989a1e2..7ce9afe5e6 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -11,7 +11,7 @@ threads libc combinators fry combinators.short-circuit continuations command-line shuffle opengl ui.render math.bitwise locals accessors math.rectangles math.order calendar ascii sets io.encodings.utf16n windows.errors literals ui.pixel-formats -ui.pixel-formats.private memoize classes struct-arrays ; +ui.pixel-formats.private memoize classes struct-arrays classes.struct ; IN: ui.backend.windows SINGLETON: windows-ui-backend @@ -89,26 +89,27 @@ CONSTANT: pfd-flag-map H{ [ value>> ] [ 0 ] if* ; : >pfd ( attributes -- pfd ) - "PIXELFORMATDESCRIPTOR" - "PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize - 1 over set-PIXELFORMATDESCRIPTOR-nVersion - over >pfd-flags over set-PIXELFORMATDESCRIPTOR-dwFlags - PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType - over color-bits attr-value over set-PIXELFORMATDESCRIPTOR-cColorBits - over red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cRedBits - over green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cGreenBits - over blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cBlueBits - over alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAlphaBits - over accum-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBits - over accum-red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumRedBits - over accum-green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumGreenBits - over accum-blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBlueBits - over accum-alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumAlphaBits - over depth-bits attr-value over set-PIXELFORMATDESCRIPTOR-cDepthBits - over stencil-bits attr-value over set-PIXELFORMATDESCRIPTOR-cStencilBits - over aux-buffers attr-value over set-PIXELFORMATDESCRIPTOR-cAuxBuffers - PFD_MAIN_PLANE over set-PIXELFORMATDESCRIPTOR-dwLayerMask - nip ; + [ PIXELFORMATDESCRIPTOR ] dip + { + [ drop PIXELFORMATDESCRIPTOR heap-size >>nSize ] + [ drop 1 >>nVersion ] + [ >pfd-flags >>dwFlags ] + [ drop PFD_TYPE_RGBA >>iPixelType ] + [ color-bits attr-value >>cColorBits ] + [ red-bits attr-value >>cRedBits ] + [ green-bits attr-value >>cGreenBits ] + [ blue-bits attr-value >>cBlueBits ] + [ alpha-bits attr-value >>cAlphaBits ] + [ accum-bits attr-value >>cAccumBits ] + [ accum-red-bits attr-value >>cAccumRedBits ] + [ accum-green-bits attr-value >>cAccumGreenBits ] + [ accum-blue-bits attr-value >>cAccumBlueBits ] + [ accum-alpha-bits attr-value >>cAccumAlphaBits ] + [ depth-bits attr-value >>cDepthBits ] + [ stencil-bits attr-value >>cStencilBits ] + [ aux-buffers attr-value >>cAuxBuffers ] + [ drop PFD_MAIN_PLANE >>dwLayerMask ] + } cleave ; : pfd-make-pixel-format ( world attributes -- pf ) [ handle>> hDC>> ] [ >pfd ] bi* @@ -116,12 +117,12 @@ CONSTANT: pfd-flag-map H{ : get-pfd ( pixel-format -- pfd ) [ world>> handle>> hDC>> ] [ handle>> ] bi - "PIXELFORMATDESCRIPTOR" heap-size - "PIXELFORMATDESCRIPTOR" + PIXELFORMATDESCRIPTOR heap-size + PIXELFORMATDESCRIPTOR [ DescribePixelFormat win32-error=0/f ] keep ; : pfd-flag? ( pfd flag -- ? ) - [ PIXELFORMATDESCRIPTOR-dwFlags ] dip bitand c-bool> ; + [ dwFlags>> ] dip bitand c-bool> ; : (pfd-pixel-format-attribute) ( pfd attribute -- value ) { @@ -131,19 +132,19 @@ CONSTANT: pfd-flag-map H{ { fullscreen [ PFD_DRAW_TO_WINDOW pfd-flag? ] } { windowed [ PFD_DRAW_TO_WINDOW pfd-flag? ] } { software-rendered [ PFD_GENERIC_FORMAT pfd-flag? ] } - { color-bits [ PIXELFORMATDESCRIPTOR-cColorBits ] } - { red-bits [ PIXELFORMATDESCRIPTOR-cRedBits ] } - { green-bits [ PIXELFORMATDESCRIPTOR-cGreenBits ] } - { blue-bits [ PIXELFORMATDESCRIPTOR-cBlueBits ] } - { alpha-bits [ PIXELFORMATDESCRIPTOR-cAlphaBits ] } - { accum-bits [ PIXELFORMATDESCRIPTOR-cAccumBits ] } - { accum-red-bits [ PIXELFORMATDESCRIPTOR-cAccumRedBits ] } - { accum-green-bits [ PIXELFORMATDESCRIPTOR-cAccumGreenBits ] } - { accum-blue-bits [ PIXELFORMATDESCRIPTOR-cAccumBlueBits ] } - { accum-alpha-bits [ PIXELFORMATDESCRIPTOR-cAccumAlphaBits ] } - { depth-bits [ PIXELFORMATDESCRIPTOR-cDepthBits ] } - { stencil-bits [ PIXELFORMATDESCRIPTOR-cStencilBits ] } - { aux-buffers [ PIXELFORMATDESCRIPTOR-cAuxBuffers ] } + { color-bits [ cColorBits>> ] } + { red-bits [ cRedBits>> ] } + { green-bits [ cGreenBits>> ] } + { blue-bits [ cBlueBits>> ] } + { alpha-bits [ cAlphaBits>> ] } + { accum-bits [ cAccumBits>> ] } + { accum-red-bits [ cAccumRedBits>> ] } + { accum-green-bits [ cAccumGreenBits>> ] } + { accum-blue-bits [ cAccumBlueBits>> ] } + { accum-alpha-bits [ cAccumAlphaBits>> ] } + { depth-bits [ cDepthBits>> ] } + { stencil-bits [ cStencilBits>> ] } + { aux-buffers [ cAuxBuffers>> ] } [ 2drop f ] } case ; @@ -663,7 +664,7 @@ M: windows-ui-backend do-events : set-pixel-format ( pixel-format hdc -- ) swap handle>> - "PIXELFORMATDESCRIPTOR" SetPixelFormat win32-error=0/f ; + PIXELFORMATDESCRIPTOR SetPixelFormat win32-error=0/f ; : setup-gl ( world -- ) [ get-dc ] keep diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index b99e7ffe6f..36823db424 100755 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax namespaces kernel words sequences math math.bitwise math.vectors colors -io.encodings.utf16n ; +io.encodings.utf16n classes.struct ; IN: windows.types TYPEDEF: char CHAR @@ -301,33 +301,33 @@ C-STRUCT: MSG TYPEDEF: MSG* LPMSG -C-STRUCT: PIXELFORMATDESCRIPTOR - { "WORD" "nSize" } - { "WORD" "nVersion" } - { "DWORD" "dwFlags" } - { "BYTE" "iPixelType" } - { "BYTE" "cColorBits" } - { "BYTE" "cRedBits" } - { "BYTE" "cRedShift" } - { "BYTE" "cGreenBits" } - { "BYTE" "cGreenShift" } - { "BYTE" "cBlueBits" } - { "BYTE" "cBlueShift" } - { "BYTE" "cAlphaBits" } - { "BYTE" "cAlphaShift" } - { "BYTE" "cAccumBits" } - { "BYTE" "cAccumRedBits" } - { "BYTE" "cAccumGreenBits" } - { "BYTE" "cAccumBlueBits" } - { "BYTE" "cAccumAlphaBits" } - { "BYTE" "cDepthBits" } - { "BYTE" "cStencilBits" } - { "BYTE" "cAuxBuffers" } - { "BYTE" "iLayerType" } - { "BYTE" "bReserved" } - { "DWORD" "dwLayerMask" } - { "DWORD" "dwVisibleMask" } - { "DWORD" "dwDamageMask" } ; +STRUCT: PIXELFORMATDESCRIPTOR + { nSize WORD } + { nVersion WORD } + { dwFlags DWORD } + { iPixelType BYTE } + { cColorBits BYTE } + { cRedBits BYTE } + { cRedShift BYTE } + { cGreenBits BYTE } + { cGreenShift BYTE } + { cBlueBits BYTE } + { cBlueShift BYTE } + { cAlphaBits BYTE } + { cAlphaShift BYTE } + { cAccumBits BYTE } + { cAccumRedBits BYTE } + { cAccumGreenBits BYTE } + { cAccumBlueBits BYTE } + { cAccumAlphaBits BYTE } + { cDepthBits BYTE } + { cStencilBits BYTE } + { cAuxBuffers BYTE } + { iLayerType BYTE } + { bReserved BYTE } + { dwLayerMask DWORD } + { dwVisibleMask DWORD } + { dwDamageMask DWORD } ; C-STRUCT: RECT { "LONG" "left" } diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index 40c10d0f5b..58981920da 100755 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.syntax parser namespaces kernel math -windows.types generalizations math.bitwise ; +windows.types generalizations math.bitwise classes.struct ; IN: windows.user32 ! HKL for ActivateKeyboardLayout From eb4081c696414ecc6c62af43f9b2c5bd3879fd9f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 27 Aug 2009 21:16:41 -0500 Subject: [PATCH 2/3] return YES from cocoa app delegate's applicationShouldHandleReopen: method. this allows app-icon-minimized windows on snow leopard to automatically restore when the dock icon is clicked --- basis/ui/backend/cocoa/tools/tools.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor index cf5493f33d..b8c01f0bd9 100644 --- a/basis/ui/backend/cocoa/tools/tools.factor +++ b/basis/ui/backend/cocoa/tools/tools.factor @@ -30,7 +30,7 @@ CLASS: { } { "applicationShouldHandleReopen:hasVisibleWindows:" "int" { "id" "SEL" "id" "int" } - [ [ 3drop ] dip 0 = [ show-listener ] when 0 ] + [ [ 3drop ] dip 0 = [ show-listener ] when 1 ] } { "factorListener:" "id" { "id" "SEL" "id" } From 80a5bf7138716517efc068bf87d886d26298e464 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 27 Aug 2009 21:39:43 -0500 Subject: [PATCH 3/3] support { type dimension } c-type syntax in STRUCT: definitions --- basis/classes/struct/prettyprint/prettyprint.factor | 4 ++-- basis/classes/struct/struct-tests.factor | 2 +- basis/classes/struct/struct.factor | 5 ++++- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor index feeecd881b..6368424ec6 100644 --- a/basis/classes/struct/prettyprint/prettyprint.factor +++ b/basis/classes/struct/prettyprint/prettyprint.factor @@ -1,7 +1,7 @@ ! (c)Joe Groff bsd license USING: accessors assocs classes classes.struct combinators kernel math prettyprint.backend prettyprint.custom -prettyprint.sections see.private sequences words ; +prettyprint.sections see.private sequences strings words ; IN: classes.struct.prettyprint > text ] - [ c-type>> text ] + [ c-type>> dup string? [ text ] [ pprint* ] if ] [ read-only>> [ \ read-only pprint-word ] when ] [ initial>> [ \ initial: pprint-word pprint* ] when* ] } cleave diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 64b8ba83e2..2995e9d6d6 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -187,7 +187,7 @@ STRUCT: struct-test-array-slots ] unit-test STRUCT: struct-test-optimization - { x int[3] } { y int } ; + { x { "int" 3 } } { y int } ; [ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test [ t ] [ diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 52f3b7df9f..2cafb5e8fe 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -232,10 +232,13 @@ ERROR: invalid-struct-slot token ; c-type c-type-boxed-class dup \ byte-array = [ drop \ c-ptr ] when ; +: scan-c-type ( -- c-type ) + scan dup "{" = [ drop \ } parse-until >array ] when ; + : parse-struct-slot ( -- slot ) struct-slot-spec new scan >>name - scan [ >>c-type ] [ struct-slot-class >>class ] bi + scan-c-type [ >>c-type ] [ struct-slot-class >>class ] bi \ } parse-until [ dup empty? ] [ peel-off-attributes ] until drop ; : parse-struct-slots ( slots -- slots' more? )