]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 28 Aug 2009 02:49:47 +0000 (21:49 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 28 Aug 2009 02:49:47 +0000 (21:49 -0500)
basis/classes/struct/prettyprint/prettyprint.factor
basis/classes/struct/struct-tests.factor
basis/classes/struct/struct.factor
basis/io/backend/windows/nt/nt.factor
basis/ui/backend/cocoa/tools/tools.factor
basis/ui/backend/windows/windows.factor
basis/windows/types/types.factor
basis/windows/user32/user32.factor

index feeecd881ba5a7cb15731d078d0335af968ccfd7..6368424ec66ceb6e4aa18486752c66bd1909dfd9 100644 (file)
@@ -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
 
 <PRIVATE
@@ -18,7 +18,7 @@ IN: classes.struct.prettyprint
     <flow \ { pprint-word
     {
         [ name>> 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
index 64b8ba83e259246bbb4749e4a09f569ecbf5da5e..2995e9d6d6842b4b67d39c5043f052969e1fa88c 100644 (file)
@@ -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 ] [
index 52f3b7df9f4d7b8e33643769c38e32fd9dea2a68..2cafb5e8fe24b6d2770635e694210769f933ef9d 100644 (file)
@@ -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? )
index e29aa6c6188b70ed5683c7791adef1557113fa5c..aa113c0efe30cd7c0a71ddd8a71ac8d2a092598f 100755 (executable)
@@ -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 <completion-port> 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
index cf5493f33dd271b53d49f9115b8bfba99857e9d7..b8c01f0bd925882ebea16585f1ba03b07c7eeb39 100644 (file)
@@ -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" }
index f23989a1e264876164e63cced6eaefc00cc4e7c5..7ce9afe5e64e716bdd04b42f97ae00c8a52798b4 100755 (executable)
@@ -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" <c-object>
-    "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 <struct> ] 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" <c-object>
+    PIXELFORMATDESCRIPTOR heap-size
+    PIXELFORMATDESCRIPTOR <struct>
     [ 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" <c-object> SetPixelFormat win32-error=0/f ;
+    PIXELFORMATDESCRIPTOR <struct> SetPixelFormat win32-error=0/f ;
 
 : setup-gl ( world -- )
     [ get-dc ] keep
index b99e7ffe6f4cd0f94609b9da939fbbf2b209f4bf..36823db424386673cf1502f6e42c10af8c10ef6a 100755 (executable)
@@ -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" }
index 40c10d0f5b69a59d984501ba0461f05a2d8311f5..58981920dad45994febffba90dd7719aedea114d 100755 (executable)
@@ -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