fork download
copy 
  1. ; greek time
  2.  
  3. (define (range . args)
  4.   (case (length args)
  5.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  6.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  7.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  8.            (let loop ((x(car args)) (xs '()))
  9.              (if (le? (cadr args) x)
  10.                  (reverse xs)
  11.                  (loop (+ x (caddr args)) (cons x xs))))))
  12.     (else (error 'range "unrecognized arguments"))))
  13.  
  14. (define (duration start end)
  15.   (when (< (cdr end) (cdr start))
  16.     (set! end (cons (- (car end) 1) (+ (cdr end) 60))))
  17.   (+ (* (- (car end) (car start)) 60)
  18.      (- (cdr end) (cdr start))))
  19.  
  20. (define (add-duration start duration)
  21.   (let ((end (cons (+ (car start) (quotient duration 60))
  22.                    (+ (cdr start) (modulo duration 60)))))
  23.     (if (< (cdr end) 60) end
  24.       (cons (+ (car end) 1) (- (cdr end) 60)))))
  25.  
  26. (define (greek-time sunrise sunset)
  27.   (let ((hour-length (/ (duration sunrise sunset) 12)))
  28.     (map (lambda (dur) (add-duration sunrise dur))
  29.          (map (lambda (hour) (round (* hour hour-length)))
  30.               (range 13)))))
  31.  
  32. (display (greek-time '(5 . 45) '(20 . 29))) (newline)
Success #stdin #stdout 0.03s 8616KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((5 . 45) (6 . 59) (8 . 12) (9 . 26) (10 . 40) (11 . 53) (13 . 7) (14 . 21) (15 . 34) (16 . 48) (18 . 2) (19 . 15) (20 . 29))
https://ideone.com/G5PwOK
language:
Scheme (guile 2.2.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!