]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/calendar/windows/windows.factor
factor: trim using lists
[factor.git] / basis / calendar / windows / windows.factor
index 508cbb0a49596f6839bd65b60751097e85e1b443..d17e1efbf1b0684b763f27b90fa4efd1b442964e 100644 (file)
@@ -1,15 +1,40 @@
-USING: calendar namespaces alien.c-types system windows
-windows.kernel32 kernel math combinators ;
+USING: accessors calendar combinators kernel math math.functions
+system windows.errors windows.kernel32 ;
 IN: calendar.windows
 
-M: windows gmt-offset ( -- hours minutes seconds )
-    "TIME_ZONE_INFORMATION" <c-object>
+: timestamp>SYSTEMTIME ( timestamp -- SYSTEMTIME )
+    {
+        [ year>> ]
+        [ month>> ]
+        [ day-of-week ]
+        [ day>> ]
+        [ hour>> ]
+        [ minute>> ]
+        [
+            second>> dup floor
+            [ nip >integer ]
+            [ - 1000 * >integer ] 2bi
+        ]
+    } cleave \ SYSTEMTIME boa ;
+
+: SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
+    {
+        [ wYear>> ]
+        [ wMonth>> ]
+        [ wDay>> ]
+        [ wHour>> ]
+        [ wMinute>> ]
+        [ [ wSecond>> ] [ wMilliseconds>> 1000 / ] bi + ]
+    } cleave instant <timestamp> ;
+
+M: windows gmt-offset
+    TIME_ZONE_INFORMATION new
     dup GetTimeZoneInformation {
-        { TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
-        { TIME_ZONE_ID_UNKNOWN [ TIME_ZONE_INFORMATION-Bias ] }
-        { TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias ] }
-        { TIME_ZONE_ID_DAYLIGHT [
-            [ TIME_ZONE_INFORMATION-Bias ]
-            [ TIME_ZONE_INFORMATION-DaylightBias ] bi +
-        ] }
+        { TIME_ZONE_ID_INVALID [ win32-error ] }
+        { TIME_ZONE_ID_UNKNOWN [ Bias>> ] }
+        { TIME_ZONE_ID_STANDARD [ Bias>> ] }
+        { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
     } case neg 60 /mod 0 ;
+
+M: windows now-gmt
+    SYSTEMTIME new [ GetSystemTime ] keep SYSTEMTIME>timestamp ;