steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2009-08-27 21:49:47 -05:00
parent 7cf4e608e5 80a5bf7138
commit e2ebc2ac76
8 changed files with 80 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/classes/struct/prettyprint/prettyprint.factor
View File

@ -1,7 +1,7 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors assocs classes classes.struct combinators USING: accessors assocs classes classes.struct combinators
kernel math prettyprint.backend prettyprint.custom kernel math prettyprint.backend prettyprint.custom
prettyprint.sections see.private sequences words ; prettyprint.sections see.private sequences strings words ;
IN: classes.struct.prettyprint IN: classes.struct.prettyprint
<PRIVATE <PRIVATE
@ -18,7 +18,7 @@ IN: classes.struct.prettyprint
<flow \ { pprint-word <flow \ { pprint-word
{ {
[ name>> text ] [ name>> text ]
[ c-type>> text ] [ c-type>> dup string? [ text ] [ pprint* ] if ]
[ read-only>> [ \ read-only pprint-word ] when ] [ read-only>> [ \ read-only pprint-word ] when ]
[ initial>> [ \ initial: pprint-word pprint* ] when* ] [ initial>> [ \ initial: pprint-word pprint* ] when* ]
} cleave } cleave

2
basis/classes/struct/struct-tests.factor
View File

@ -187,7 +187,7 @@ STRUCT: struct-test-array-slots
] unit-test ] unit-test
STRUCT: struct-test-optimization 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 ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [ [ t ] [

5
basis/classes/struct/struct.factor
View File

@ -232,10 +232,13 @@ ERROR: invalid-struct-slot token ;
c-type c-type-boxed-class c-type c-type-boxed-class
dup \ byte-array = [ drop \ c-ptr ] when ; dup \ byte-array = [ drop \ c-ptr ] when ;
: scan-c-type ( -- c-type )
scan dup "{" = [ drop \ } parse-until >array ] when ;
: parse-struct-slot ( -- slot ) : parse-struct-slot ( -- slot )
struct-slot-spec new struct-slot-spec new
scan >>name 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-until [ dup empty? ] [ peel-off-attributes ] until drop ;
: parse-struct-slots ( slots -- slots' more? ) : parse-struct-slots ( slots -- slots' more? )

8
basis/io/backend/windows/nt/nt.factor
View File

@ -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.files.windows io.files.windows.nt io.files io.pathnames io.buffers
io.streams.c io.streams.null libc kernel math namespaces sequences io.streams.c io.streams.null libc kernel math namespaces sequences
threads windows windows.errors windows.kernel32 strings splitting 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 QUALIFIED: windows.winsock
IN: io.backend.windows.nt IN: io.backend.windows.nt
@ -36,7 +36,7 @@ M: winnt add-completion ( win32-handle -- )
handle>> master-completion-port get-global <completion-port> drop ; handle>> master-completion-port get-global <completion-port> drop ;
: eof? ( error -- ? ) : eof? ( error -- ? )
[ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ; { [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ;
: twiddle-thumbs ( overlapped port -- bytes-transferred ) : twiddle-thumbs ( overlapped port -- bytes-transferred )
[ [
@ -66,9 +66,9 @@ M: winnt add-completion ( win32-handle -- )
: handle-overlapped ( us -- ? ) : handle-overlapped ( us -- ? )
wait-for-overlapped [ wait-for-overlapped [
dup [ [
[ drop GetLastError 1array ] dip resume-callback t [ drop GetLastError 1array ] dip resume-callback t
] [ 2drop f ] if ] [ drop f ] if*
] [ resume-callback t ] if ; ] [ resume-callback t ] if ;
M: win32-handle cancel-operation M: win32-handle cancel-operation

2
basis/ui/backend/cocoa/tools/tools.factor
View File

@ -30,7 +30,7 @@ CLASS: {
} }
{ "applicationShouldHandleReopen:hasVisibleWindows:" "int" { "id" "SEL" "id" "int" } { "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" } { "factorListener:" "id" { "id" "SEL" "id" }

77
basis/ui/backend/windows/windows.factor
View File

@ -11,7 +11,7 @@ threads libc combinators fry combinators.short-circuit continuations
command-line shuffle opengl ui.render math.bitwise locals command-line shuffle opengl ui.render math.bitwise locals
accessors math.rectangles math.order calendar ascii sets accessors math.rectangles math.order calendar ascii sets
io.encodings.utf16n windows.errors literals ui.pixel-formats 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 IN: ui.backend.windows
SINGLETON: windows-ui-backend SINGLETON: windows-ui-backend
@ -89,26 +89,27 @@ CONSTANT: pfd-flag-map H{
[ value>> ] [ 0 ] if* ; [ value>> ] [ 0 ] if* ;
: >pfd ( attributes -- pfd ) : >pfd ( attributes -- pfd )
"PIXELFORMATDESCRIPTOR" <c-object> [ PIXELFORMATDESCRIPTOR <struct> ] dip
"PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize {
1 over set-PIXELFORMATDESCRIPTOR-nVersion [ drop PIXELFORMATDESCRIPTOR heap-size >>nSize ]
over >pfd-flags over set-PIXELFORMATDESCRIPTOR-dwFlags [ drop 1 >>nVersion ]
PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType [ >pfd-flags >>dwFlags ]
over color-bits attr-value over set-PIXELFORMATDESCRIPTOR-cColorBits [ drop PFD_TYPE_RGBA >>iPixelType ]
over red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cRedBits [ color-bits attr-value >>cColorBits ]
over green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cGreenBits [ red-bits attr-value >>cRedBits ]
over blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cBlueBits [ green-bits attr-value >>cGreenBits ]
over alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAlphaBits [ blue-bits attr-value >>cBlueBits ]
over accum-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBits [ alpha-bits attr-value >>cAlphaBits ]
over accum-red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumRedBits [ accum-bits attr-value >>cAccumBits ]
over accum-green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumGreenBits [ accum-red-bits attr-value >>cAccumRedBits ]
over accum-blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBlueBits [ accum-green-bits attr-value >>cAccumGreenBits ]
over accum-alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumAlphaBits [ accum-blue-bits attr-value >>cAccumBlueBits ]
over depth-bits attr-value over set-PIXELFORMATDESCRIPTOR-cDepthBits [ accum-alpha-bits attr-value >>cAccumAlphaBits ]
over stencil-bits attr-value over set-PIXELFORMATDESCRIPTOR-cStencilBits [ depth-bits attr-value >>cDepthBits ]
over aux-buffers attr-value over set-PIXELFORMATDESCRIPTOR-cAuxBuffers [ stencil-bits attr-value >>cStencilBits ]
PFD_MAIN_PLANE over set-PIXELFORMATDESCRIPTOR-dwLayerMask [ aux-buffers attr-value >>cAuxBuffers ]
nip ; [ drop PFD_MAIN_PLANE >>dwLayerMask ]
} cleave ;
: pfd-make-pixel-format ( world attributes -- pf ) : pfd-make-pixel-format ( world attributes -- pf )
[ handle>> hDC>> ] [ >pfd ] bi* [ handle>> hDC>> ] [ >pfd ] bi*
@ -116,12 +117,12 @@ CONSTANT: pfd-flag-map H{
: get-pfd ( pixel-format -- pfd ) : get-pfd ( pixel-format -- pfd )
[ world>> handle>> hDC>> ] [ handle>> ] bi [ world>> handle>> hDC>> ] [ handle>> ] bi
"PIXELFORMATDESCRIPTOR" heap-size PIXELFORMATDESCRIPTOR heap-size
"PIXELFORMATDESCRIPTOR" <c-object> PIXELFORMATDESCRIPTOR <struct>
[ DescribePixelFormat win32-error=0/f ] keep ; [ DescribePixelFormat win32-error=0/f ] keep ;
: pfd-flag? ( pfd flag -- ? ) : pfd-flag? ( pfd flag -- ? )
[ PIXELFORMATDESCRIPTOR-dwFlags ] dip bitand c-bool> ; [ dwFlags>> ] dip bitand c-bool> ;
: (pfd-pixel-format-attribute) ( pfd attribute -- value ) : (pfd-pixel-format-attribute) ( pfd attribute -- value )
{ {
@ -131,19 +132,19 @@ CONSTANT: pfd-flag-map H{
{ fullscreen [ PFD_DRAW_TO_WINDOW pfd-flag? ] } { fullscreen [ PFD_DRAW_TO_WINDOW pfd-flag? ] }
{ windowed [ PFD_DRAW_TO_WINDOW pfd-flag? ] } { windowed [ PFD_DRAW_TO_WINDOW pfd-flag? ] }
{ software-rendered [ PFD_GENERIC_FORMAT pfd-flag? ] } { software-rendered [ PFD_GENERIC_FORMAT pfd-flag? ] }
{ color-bits [ PIXELFORMATDESCRIPTOR-cColorBits ] } { color-bits [ cColorBits>> ] }
{ red-bits [ PIXELFORMATDESCRIPTOR-cRedBits ] } { red-bits [ cRedBits>> ] }
{ green-bits [ PIXELFORMATDESCRIPTOR-cGreenBits ] } { green-bits [ cGreenBits>> ] }
{ blue-bits [ PIXELFORMATDESCRIPTOR-cBlueBits ] } { blue-bits [ cBlueBits>> ] }
{ alpha-bits [ PIXELFORMATDESCRIPTOR-cAlphaBits ] } { alpha-bits [ cAlphaBits>> ] }
{ accum-bits [ PIXELFORMATDESCRIPTOR-cAccumBits ] } { accum-bits [ cAccumBits>> ] }
{ accum-red-bits [ PIXELFORMATDESCRIPTOR-cAccumRedBits ] } { accum-red-bits [ cAccumRedBits>> ] }
{ accum-green-bits [ PIXELFORMATDESCRIPTOR-cAccumGreenBits ] } { accum-green-bits [ cAccumGreenBits>> ] }
{ accum-blue-bits [ PIXELFORMATDESCRIPTOR-cAccumBlueBits ] } { accum-blue-bits [ cAccumBlueBits>> ] }
{ accum-alpha-bits [ PIXELFORMATDESCRIPTOR-cAccumAlphaBits ] } { accum-alpha-bits [ cAccumAlphaBits>> ] }
{ depth-bits [ PIXELFORMATDESCRIPTOR-cDepthBits ] } { depth-bits [ cDepthBits>> ] }
{ stencil-bits [ PIXELFORMATDESCRIPTOR-cStencilBits ] } { stencil-bits [ cStencilBits>> ] }
{ aux-buffers [ PIXELFORMATDESCRIPTOR-cAuxBuffers ] } { aux-buffers [ cAuxBuffers>> ] }
[ 2drop f ] [ 2drop f ]
} case ; } case ;
@ -663,7 +664,7 @@ M: windows-ui-backend do-events
: set-pixel-format ( pixel-format hdc -- ) : set-pixel-format ( pixel-format hdc -- )
swap handle>> swap handle>>
"PIXELFORMATDESCRIPTOR" <c-object> SetPixelFormat win32-error=0/f ; PIXELFORMATDESCRIPTOR <struct> SetPixelFormat win32-error=0/f ;
: setup-gl ( world -- ) : setup-gl ( world -- )
[ get-dc ] keep [ get-dc ] keep

56
basis/windows/types/types.factor
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: alien alien.c-types alien.syntax namespaces kernel words USING: alien alien.c-types alien.syntax namespaces kernel words
sequences math math.bitwise math.vectors colors sequences math math.bitwise math.vectors colors
io.encodings.utf16n ; io.encodings.utf16n classes.struct ;
IN: windows.types IN: windows.types
TYPEDEF: char CHAR TYPEDEF: char CHAR
@ -301,33 +301,33 @@ C-STRUCT: MSG
TYPEDEF: MSG* LPMSG TYPEDEF: MSG* LPMSG
C-STRUCT: PIXELFORMATDESCRIPTOR STRUCT: PIXELFORMATDESCRIPTOR
{ "WORD" "nSize" } { nSize WORD }
{ "WORD" "nVersion" } { nVersion WORD }
{ "DWORD" "dwFlags" } { dwFlags DWORD }
{ "BYTE" "iPixelType" } { iPixelType BYTE }
{ "BYTE" "cColorBits" } { cColorBits BYTE }
{ "BYTE" "cRedBits" } { cRedBits BYTE }
{ "BYTE" "cRedShift" } { cRedShift BYTE }
{ "BYTE" "cGreenBits" } { cGreenBits BYTE }
{ "BYTE" "cGreenShift" } { cGreenShift BYTE }
{ "BYTE" "cBlueBits" } { cBlueBits BYTE }
{ "BYTE" "cBlueShift" } { cBlueShift BYTE }
{ "BYTE" "cAlphaBits" } { cAlphaBits BYTE }
{ "BYTE" "cAlphaShift" } { cAlphaShift BYTE }
{ "BYTE" "cAccumBits" } { cAccumBits BYTE }
{ "BYTE" "cAccumRedBits" } { cAccumRedBits BYTE }
{ "BYTE" "cAccumGreenBits" } { cAccumGreenBits BYTE }
{ "BYTE" "cAccumBlueBits" } { cAccumBlueBits BYTE }
{ "BYTE" "cAccumAlphaBits" } { cAccumAlphaBits BYTE }
{ "BYTE" "cDepthBits" } { cDepthBits BYTE }
{ "BYTE" "cStencilBits" } { cStencilBits BYTE }
{ "BYTE" "cAuxBuffers" } { cAuxBuffers BYTE }
{ "BYTE" "iLayerType" } { iLayerType BYTE }
{ "BYTE" "bReserved" } { bReserved BYTE }
{ "DWORD" "dwLayerMask" } { dwLayerMask DWORD }
{ "DWORD" "dwVisibleMask" } { dwVisibleMask DWORD }
{ "DWORD" "dwDamageMask" } ; { dwDamageMask DWORD } ;
C-STRUCT: RECT C-STRUCT: RECT
{ "LONG" "left" } { "LONG" "left" }

2
basis/windows/user32/user32.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Doug Coleman. ! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax parser namespaces kernel math USING: alien alien.syntax parser namespaces kernel math
windows.types generalizations math.bitwise ; windows.types generalizations math.bitwise classes.struct ;
IN: windows.user32 IN: windows.user32
! HKL for ActivateKeyboardLayout ! HKL for ActivateKeyboardLayout