#!/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 (+ 0.5 (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))))) (define selftest (make-parameter #f)) (command-line #:program "awoobot" #:once-each [("-t" "--test") "Send a test post" (selftest #t)] #:args () (parameterize ([current-config (config-from-file "config.rktd")]) (if (selftest) (begin (displayln "testing config") (send-toot/retry-on-err (make-toot "test post pls ignore,"))) (begin (run-bot) (schedule-next))) (void)))