76 lines
2.3 KiB
Racket
Executable File
76 lines
2.3 KiB
Racket
Executable File
#!/usr/bin/env racket
|
|
|
|
#lang racket
|
|
|
|
(require astro/calendar astro/lunar
|
|
racket/date
|
|
"fedibot.rkt")
|
|
|
|
(define (current-date/utc)
|
|
(seconds->date (* 0.001 (current-inexact-milliseconds)) #f))
|
|
|
|
(define (date->jd dt)
|
|
(match-define (date ss mm hh d m y _ _ _ _) dt)
|
|
(define d+ (+ d (/ hh 24) (/ mm 1440) (/ ss 86400)))
|
|
(date-values->jd y m d+))
|
|
|
|
(define (jd->date-values* jd)
|
|
(define-values [y m d] (jd->date-values jd))
|
|
(define dq (floor d))
|
|
(define df (- d dq))
|
|
(define h (* df 24))
|
|
(define hq (floor h))
|
|
(define hf (- h hq))
|
|
(define mm (* hf 60))
|
|
(define mmq (floor mm))
|
|
(define mmf (- mm mmq))
|
|
(define ssq (floor (* mmf 60)))
|
|
(values y m (inexact->exact dq) (inexact->exact hq) (inexact->exact mmq) (inexact->exact ssq)))
|
|
|
|
(define (do-awoo)
|
|
(define (str-rpt-random str)
|
|
(apply string-append (vector->list (make-vector (random 1 10) str))))
|
|
|
|
(define toot (make-toot (string-append "AWOO" (str-rpt-random "O") (str-rpt-random "!"))))
|
|
(send-toot/retry-on-err toot)
|
|
(void))
|
|
|
|
(define (run-bot)
|
|
(define now (current-date/utc))
|
|
(define now-jd (date->jd now))
|
|
(define DT (dynamical-delta-t (date-year now)))
|
|
(define fullmoon-jd (- (lunar-next-phase now-jd 'full)
|
|
(/ DT 86400)))
|
|
(displayln now-jd)
|
|
(displayln fullmoon-jd)
|
|
(define-values [y m d hh mm ss] (jd->date-values* fullmoon-jd))
|
|
|
|
(if (< (- fullmoon-jd now-jd) (/ 60 86400))
|
|
(begin
|
|
(displayln "preparing to awoo")
|
|
(sleep (inexact->exact (floor (* 86400 (- fullmoon-jd now-jd)))))
|
|
(do-awoo)
|
|
(sleep 5))
|
|
(displayln "not time to awoo yet")))
|
|
|
|
(define (schedule-next)
|
|
(define now (current-date/utc))
|
|
(define now-jd (date->jd now))
|
|
(define DT (dynamical-delta-t (date-year now)))
|
|
(define fullmoon-jd (- (lunar-next-phase now-jd 'full)
|
|
(/ DT 86400)))
|
|
(define-values [y m d hh mm ss] (jd->date-values* (- fullmoon-jd (/ 30 86400))))
|
|
(printf "schedule wakeup for: ~a ~a ~a ~a ~a ~a\n" y m d hh mm ss)
|
|
|
|
(displayln "invoking systemd")
|
|
(system* "/usr/bin/env" "systemd-run" "--user" "--same-dir"
|
|
(format "--on-calendar=~a-~a-~a ~a:~a:~a UTC" y m d hh mm ss)
|
|
(path->string (path->complete-path (find-system-path 'run-file)))))
|
|
|
|
|
|
(parameterize ([current-config (config-from-file "config.rktd")])
|
|
(run-bot)
|
|
(schedule-next)
|
|
|
|
(void))
|