]> gitweb.factorcode.org Git - factor.git/commitdiff
guid, system-info
authorDoug Coleman <doug.coleman@gmail.com>
Sat, 29 Aug 2009 22:41:08 +0000 (17:41 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sat, 29 Aug 2009 22:41:08 +0000 (17:41 -0500)
basis/calendar/windows/windows.factor
basis/windows/kernel32/kernel32.factor
basis/windows/ole32/ole32.factor
basis/windows/winsock/winsock.factor
extra/system-info/windows/windows.factor

index 65c922f1197e9efbea67cdcc9d0e17af809c442c..265a58507c739dfc1b254ef0fdc4b32110fcd676 100644 (file)
@@ -1,6 +1,6 @@
 USING: calendar namespaces alien.c-types system
 windows.kernel32 kernel math combinators windows.errors
-classes.struct accessors ;
+accessors classes.struct ;
 IN: calendar.windows
 
 M: windows gmt-offset ( -- hours minutes seconds )
index 1adb07cf1e1db0813836dc7186b02cce1e815691..2182088efe066e9a90da1c571d8b1462f728f00c 100755 (executable)
@@ -307,13 +307,13 @@ STRUCT: MEMORYSTATUSEX
 
 TYPEDEF: void* LPMEMORYSTATUSEX
 
-C-STRUCT: OSVERSIONINFO
-    { "DWORD" "dwOSVersionInfoSize" }
-    { "DWORD" "dwMajorVersion" }
-    { "DWORD" "dwMinorVersion" }
-    { "DWORD" "dwBuildNumber" }
-    { "DWORD" "dwPlatformId" }
-    { { "WCHAR" 128 } "szCSDVersion" } ;
+STRUCT: OSVERSIONINFO
+    { dwOSVersionInfoSize DWORD }
+    { dwMajorVersion DWORD }
+    { dwMinorVersion DWORD }
+    { dwBuildNumber DWORD }
+    { dwPlatformId DWORD }
+    { szCSDVersion WCHAR[128] } ;
 
 TYPEDEF: void* LPOSVERSIONINFO
 
@@ -326,11 +326,11 @@ C-STRUCT: MEMORY_BASIC_INFORMATION
   { "DWORD" "protect" }
   { "DWORD" "type" } ;
 
-C-STRUCT: GUID
-    { "ULONG" "Data1" }
-    { "WORD"  "Data2" }
-    { "WORD"  "Data3" }
-    { { "UCHAR" 8 } "Data4" } ;
+STRUCT: GUID
+    { Data1 ULONG }
+    { Data2 WORD }
+    { Data3 WORD }
+    { Data4 UCHAR[8] } ;
 
 /*
     fBinary  :1;
index 639a9ba63749aed2ac066f9458f2fc9a939a15b2..37a3a90d3b4e0995a70358b74208bdffef28fb36 100755 (executable)
@@ -1,7 +1,8 @@
 USING: alien alien.syntax alien.c-types alien.strings math
 kernel sequences windows.errors windows.types io
 accessors math.order namespaces make math.parser windows.kernel32
-combinators locals specialized-arrays.direct.uchar ;
+combinators locals specialized-arrays.direct.uchar
+literals splitting grouping classes.struct combinators.smart ;
 IN: windows.ole32
 
 LIBRARY: ole32
@@ -130,60 +131,34 @@ TUPLE: ole32-error code message ;
 : guid= ( a b -- ? )
     [ 16 memory>byte-array ] bi@ = ;
 
-: GUID-STRING-LENGTH ( -- n )
-    "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
-
-:: (guid-section>guid) ( string guid start end quot -- )
-    start end string subseq hex> guid quot call ; inline
-
-:: (guid-byte>guid) ( string guid start end byte -- )
-    start end string subseq hex> byte guid set-nth ; inline
+CONSTANT: GUID-STRING-LENGTH
+    $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
 
 : string>guid ( string -- guid )
-    "GUID" <c-object> [
-        {
-            [  1  9 [ set-GUID-Data1 ] (guid-section>guid) ]
-            [ 10 14 [ set-GUID-Data2 ] (guid-section>guid) ]
-            [ 15 19 [ set-GUID-Data3 ] (guid-section>guid) ]
-            [ ]
-        } 2cleave
-
-        GUID-Data4 {
-            [ 20 22 0 (guid-byte>guid) ]
-            [ 22 24 1 (guid-byte>guid) ]
-
-            [ 25 27 2 (guid-byte>guid) ]
-            [ 27 29 3 (guid-byte>guid) ]
-            [ 29 31 4 (guid-byte>guid) ]
-            [ 31 33 5 (guid-byte>guid) ]
-            [ 33 35 6 (guid-byte>guid) ]
-            [ 35 37 7 (guid-byte>guid) ]
-        } 2cleave
-    ] keep ;
-
-: (guid-section%) ( guid quot len -- )
-    [ call >hex ] dip CHAR: 0 pad-head % ; inline
-
-: (guid-byte%) ( guid byte -- )
-    swap nth >hex 2 CHAR: 0 pad-head % ; inline
+    "{-}" split harvest
+    [ first3 [ hex> ] tri@ ]
+    [ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
+    GUID <struct-boa> ;
 
 : guid>string ( guid -- string )
     [
-        "{" % {
-            [ [ GUID-Data1 ] 8 (guid-section%) "-" % ]
-            [ [ GUID-Data2 ] 4 (guid-section%) "-" % ]
-            [ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
-            [ ]
+        [ "{" ] dip {
+            [ Data1>> >hex "-" ]
+            [ Data2>> >hex "-" ]
+            [ Data3>> >hex "-" ]
+            [
+                Data4>> [
+                    {
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head "-" ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                    } spread
+                ] input<sequence "}"
+            ]
         } cleave
-        GUID-Data4 {
-            [ 0 (guid-byte%) ]
-            [ 1 (guid-byte%) "-" % ]
-            [ 2 (guid-byte%) ]
-            [ 3 (guid-byte%) ]
-            [ 4 (guid-byte%) ]
-            [ 5 (guid-byte%) ]
-            [ 6 (guid-byte%) ]
-            [ 7 (guid-byte%) "}" % ]
-        } cleave
-    ] "" make ;
-
+    ] "" append-outputs-as ;
index f0d32588f5d7278ed9c155bb58dcacd88a37fe6f..7e6b2bd80364ad768633c641dfcef86b5be788b7 100755 (executable)
@@ -377,8 +377,6 @@ FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
                                            BOOL fAlertable ) ;
 
 
-
-
 LIBRARY: mswsock
 
 ! Not in Windows CE
@@ -388,14 +386,13 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 
 : WSAID_CONNECTEX ( -- GUID )
-    "GUID" <c-object>
-    HEX: 25a207b9 over set-GUID-Data1
-    HEX: ddf3 over set-GUID-Data2
-    HEX: 4660 over set-GUID-Data3
+    HEX: 25a207b9
+    HEX: ddf3
+    HEX: 4660
     B{
         HEX: 8e HEX: e9 HEX: 76 HEX: e5
         HEX: 8c HEX: 74 HEX: 06 HEX: 3e
-    } over set-GUID-Data4 ;
+    } GUID <struct-boa> ;
 
 : winsock-expected-error? ( n -- ? )
     ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ;
index e68f6ce62f111b595bee2bba6ed3d3a712d618fe..8e0dc60e25f15e712b953e2ee36221d7315e14a8 100755 (executable)
@@ -21,24 +21,24 @@ IN: system-info.windows
     system-info dwOemId>> HEX: ffff0000 bitand ;
 
 : os-version ( -- os-version )
-    "OSVERSIONINFO" <c-object>
-    "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
+    OSVERSIONINFO <struct>
+        OSVERSIONINFO heap-size >>dwOSVersionInfoSize
     dup GetVersionEx win32-error=0/f ;
 
 : windows-major ( -- n )
-    os-version OSVERSIONINFO-dwMajorVersion ;
+    os-version dwMajorVersion>> ;
 
 : windows-minor ( -- n )
-    os-version OSVERSIONINFO-dwMinorVersion ;
+    os-version dwMinorVersion>> ;
 
 : windows-build# ( -- n )
-    os-version OSVERSIONINFO-dwBuildNumber ;
+    os-version dwBuildNumber>> ;
 
 : windows-platform-id ( -- n )
-    os-version OSVERSIONINFO-dwPlatformId ;
+    os-version dwPlatformId>> ;
 
 : windows-service-pack ( -- string )
-    os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
+    os-version szCSDVersion>> alien>native-string ;
 
 : feature-present? ( n -- ? )
     IsProcessorFeaturePresent zero? not ;