Script Library: nistclock.r

Script Library: 1238 scripts
nistclock.r

REBOL [
    Title: "NIST clock"
    File: %nistclock.r
    Author: "Ladislav Mecir"
    Date: 10-Nov-2012/12:01:16+1:00
    Purpose: {
        Get the current time using the NIST service.
        
        Defines NIST-TIME, NIST-CORRECTED-TIME and SET-SYSTEM-TIME functions.

        Uses a GUI to display and (eventually) set system time.
    }
    Notes: {
        The servers that have been commented out seem to not work reliably
        at present.
        
        In some operating systems you may want to run the script as
        an administrator to be able to modify the system time.
    }
]

use [
    correction-interval nist-correction correction-time
    set-system-time-win set-system-time-lin time-servers
    server-no
] [
    time-servers: [
        daytime://nist1.aol-va.symmetricom.com
        daytime://nist1-atl.ustiming.org
        daytime://nist.expertsmi.com
        daytime://time.nist.gov
    ]
    
    server-no: 0

    nist-time: func [
        {Never use this function more often than once in four seconds!}
        /local nist-time mjd hms
    ] [
        until [
            server-no: server-no + 1
            if server-no > length? time-servers [server-no: 1]
            all [
                not error? try [nist-time: read pick time-servers server-no]
                parse/all nist-time [
                    skip copy mjd 5 skip 2 thru " " copy hms 8 skip to end
                ]
            ]
        ]
        nist-time: 17/Nov/1858 + to integer! mjd
        nist-time/time: to time! hms
        nist-time
    ]

    correction-interval: 0:8:0
    correction-time: now - correction-interval
    nist-correction: 0:0:0

    nist-corrected-time: func [
        {
            this function may be used as often as desired
            assuming that the system clock does not change faster
            than by CORRECTION-INTERVAL in four seconds
        }
        /local result
    ] [
        result: now + nist-correction
        if correction-interval <= difference result correction-time [
            correction-time: nist-time
            nist-correction: difference correction-time now
            result: now + nist-correction
        ]
        result
    ]

    set-system-time-win: func [
        {set system time in Windows; return True in case of success}
        [catch]
        date
        /local set-system-time
    ] [
        unless value? 'kernel32 [kernel32: load/library %kernel32.dll]
    
        set-system-time: make routine! [
            systemtime [struct! []]
            return: [int]
        ] kernel32 "SetSystemTime"
        
        ; date to UTC
        date: date - date/zone
        date/zone: 0:0
    
        0 <> set-system-time make struct! [
            wYear [short]
            wMonth [short]
            wDayOfWeek [short]
            wDay [short]
            wHour [short]
            wMinute [short]
            wSecond [short]
            wMilliseconds [short]
        ] reduce [
            date/year
            date/month
            date/weekday
            date/day
            date/time/hour
            date/time/minute
            to integer! date/time/second
            0
        ]
    ]
    
    set-system-time-lin: func [
        {set system time in Linux; return True in case of success}
        [catch]
        date
        /local settimeofday
    ] [
        unless value? 'libc.so [libc.so: load/library %/lib/libc.so.6]
        unless value? 'null-struct [
            null-struct: make struct! [struct [struct! []]] none
            null-struct: null-struct/struct
        ]
    
        settimeofday: make routine! [
            tv [struct! []]
            tz [struct! []]
            return: [integer!]
        ] libc.so "settimeofday"
        
        ; date to UTC
        date: date - date/zone
        date/zone: 0:0
        
        date: make struct! [
            tv_sec [int]
            tv_usec [int]
        ] reduce [
            date - 1/1/1970 * 86400 + to integer! date/time
            0
        ]
    
        0 = settimeofday date null-struct
    ]

    set-system-time: switch system/version and 0.0.0.255.255 [
        0.0.0.3.1 [:set-system-time-win]
        0.0.0.4.2 [:set-system-time-lin]
    ]

    ; View version
    current-time: nist-corrected-time
    current-time: form current-time/time
    view/new layout [
        banner 140x32 rate 1 current-time feel [
            engage: func [face action event] [
                current-time: nist-corrected-time
                face/text: current-time/time
                show face
            ]
        ]
        button 140x20 "Set System Time" [
            if set-system-time nist-corrected-time [nist-correction: 0:0]
        ] 
    ]
    do-events
]