Implement set-time on Windows

basis/calendar/windows/windows.factor

@@ -1,6 +1,6 @@
 USING: calendar namespaces alien.c-types system
 windows.kernel32 kernel math combinators windows.errors
-accessors classes.struct ;
+accessors classes.struct calendar.format math.functions ;
 IN: calendar.windows
 
 M: windows gmt-offset ( -- hours minutes seconds )
@@ -11,3 +11,28 @@ M: windows gmt-offset ( -- hours minutes seconds )
         { TIME_ZONE_ID_STANDARD [ Bias>> ] }
         { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
     } case neg 60 /mod 0 ;
+
+: timestamp>SYSTEMTIME ( timestamp -- SYSTEMTIME )
+    {
+        [ year>> ]
+        [ month>> ]
+        [ day-of-week ]
+        [ day>> ]
+        [ hour>> ]
+        [ minute>> ]
+        [
+            second>> dup floor
+            [ nip >integer ]
+            [ - 1000 * >integer ] 2bi
+        ]
+    } cleave \ SYSTEMTIME <struct-boa> ;
+
+: SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
+    {
+        [ wYear>> ]
+        [ wMonth>> ]
+        [ wDay>> ]
+        [ wHour>> ]
+        [ wMinute>> ]
+        [ [ wSecond>> ] [ wMilliseconds>> 1000 /f ] bi + ]
+    } cleave gmt-offset-duration <timestamp> ;

basis/windows/kernel32/kernel32.factor

@@ -1800,7 +1800,7 @@ FUNCTION: BOOL SetProcessPriorityBoost ( HANDLE hProcess, BOOL disablePriorityBo
 ! FUNCTION: SetProcessWorkingSetSize
 ! FUNCTION: SetStdHandle
 ! FUNCTION: SetSystemPowerState
-! FUNCTION: SetSystemTime
+FUNCTION: BOOL SetSystemTime ( SYSTEMTIME* lpSystemTime ) ;
 ! FUNCTION: SetSystemTimeAdjustment
 ! FUNCTION: SetTapeParameters
 ! FUNCTION: SetTapePosition

extra/time/time.factor

@@ -1,7 +1,14 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system ;
+USING: combinators kernel system vocabs.loader ;
 IN: time
 
 HOOK: set-time os ( timestamp -- )
 HOOK: adjust-time-monotonic os ( timestamp -- seconds )
+
+os {
+    { [ dup macosx? ] [ drop "time.macosx" require ] }
+    { [ dup windows? ] [ drop "time.windows" require ] }
+    { [ dup unix? ] [ drop "time.unix" require ] }
+    [ drop ]
+} cond

extra/time/windows/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/time/windows/windows.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2010 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar.windows system time windows.errors 
+windows.kernel32 kernel classes.struct calendar ;
+IN: time.windows
+
+: windows-system-time ( -- SYSTEMTIME )
+    SYSTEMTIME <struct> [ GetSystemTime ] keep ;
+
+M: windows set-time
+    >gmt
+    timestamp>SYSTEMTIME SetSystemTime win32-error=0/f ;