summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--2d/agenda.scm61
1 files changed, 30 insertions, 31 deletions
diff --git a/2d/agenda.scm b/2d/agenda.scm
index 6e9f61d..77983b2 100644
--- a/2d/agenda.scm
+++ b/2d/agenda.scm
@@ -46,15 +46,15 @@
(queue segment-queue))
(define (make-time-segment time . callbacks)
- "Constructs a new time segment with given time and enqueus all
-callback procedures."
+ "Create a new time segment at TIME and enqueus everything in the
+list CALLBACKS."
(let ((segment (%make-time-segment time (make-q))))
;; Enqueue all callbacks
(for-each (lambda (c) (segment-enq segment c)) callbacks)
segment))
(define (segment-enq segment callback)
- "Enqueues a callback procedure onto the segment queue."
+ "Add the CALLBACK procedure to SEGMENT's queue."
(enq! (segment-queue segment) callback))
;;;
@@ -68,7 +68,7 @@ callback procedures."
(segments agenda-segments set-agenda-segments!))
(define (make-agenda)
- "Creates a new empty agenda."
+ "Create a new, empty agenda."
(%make-agenda 0 '()))
;; The global agenda that will be used when schedule is called outside
@@ -86,49 +86,48 @@ callback procedures."
(set! *current-agenda* global-agenda)))
(define (agenda-empty? agenda)
- "Returns #t if agenda has no scheduled procedures."
+ "Return #t if AGENDA has no scheduled procedures."
(null? (agenda-segments agenda)))
(define (first-segment agenda)
- "Returns the first time segment in the agenda."
+ "Return the first time segment in AGENDA."
(car (agenda-segments agenda)))
(define (rest-segments agenda)
- "Returns everything but the first segment in the agenda."
+ "Return everything but the first segment in AGENDA."
(cdr (agenda-segments agenda)))
(define (agenda-add-segment agenda time callback)
- "Adds a new time segment to the beginning of the agenda and enqueues
-the given callback."
- (set-agenda-segments! agenda (cons (make-time-segment time callback)
- (agenda-segments agenda))))
+ "Add a new time segment to the beginning of AGENDA at the given TIME
+and enqueue CALLBACK."
+ (set-agenda-segments! agenda
+ (cons (make-time-segment time callback)
+ (agenda-segments agenda))))
(define (insert-segment segments time callback)
- "Inserts a new segment after the first segment in the list."
- (set-cdr! segments (cons (make-time-segment time callback) (cdr segments))))
+ "Insert a new time segment after the first segment in SEGMENTS."
+ (set-cdr! segments
+ (cons (make-time-segment time callback)
+ (cdr segments))))
(define (first-agenda-item agenda)
- "Returns the first time segment queue in the agenda."
+ "Return the first time segment queue in AGENDA."
(if (agenda-empty? agenda)
(error "Agenda is empty")
(segment-queue (first-segment agenda))))
(define (agenda-time-delay agenda dt)
- "Returns time given a delta from the current agenda time."
+ "Return the sum of the time delta, DT, and the current time of AGENDA."
(+ (agenda-time agenda) (inexact->exact (round dt))))
(define (%agenda-schedule agenda callback dt)
- "Schedules a callback procedure in the agenda relative to the
-current agenda time."
+ "Schedule the procedure CALLBACK in AGENDA to be run DT updates from now."
(let ((time (agenda-time-delay agenda dt)))
(define (belongs-before? segments)
- "Determines if the time segment belongs before the first segment
-in the list"
(or (null? segments)
(< time (segment-time (car segments)))))
(define (add-to-segments segments)
- "Schedules callback in the proper place."
;; Add to existing time segment if the times match
(if (= (segment-time (car segments)) time)
(segment-enq (car segments) callback)
@@ -148,13 +147,13 @@ in the list"
(add-to-segments (agenda-segments agenda)))))
(define (flush-queue! q)
- "Dequeues and executes every element of q."
+ "Dequeue and execute every member of Q."
(unless (q-empty? q)
((deq! q)) ;; Execute scheduled procedure
(flush-queue! q)))
(define (%update-agenda agenda)
- "Moves agenda forward in time and run scheduled procedures."
+ "Move AGENDA forward in time and run scheduled procedures."
(set-agenda-time! agenda (1+ (agenda-time agenda)))
(let next-segment ()
(unless (agenda-empty? agenda)
@@ -167,19 +166,19 @@ in the list"
(next-segment))))))
(define (%clear-agenda agenda)
- "Removes all scheduled procedures from the agenda."
+ "Remove all scheduled procedures from AGENDA."
(set-agenda-segments! agenda '()))
(define* (agenda-schedule thunk #:optional (delay 1))
- "Schedules THUNK in the current agenda to run after DELAY
-updates (1 by default)."
+ "Schedule THUNK in the current agenda to run after DELAY updates (1
+by default)."
(%agenda-schedule *current-agenda* thunk delay))
(define* (agenda-schedule-interval thunk #:optional (interval 1) (delay 1))
- "Schedules THUNK in the current agenda to run after DELAY updates
-and run every INTERVAL updates thereafter. Both DELAY and INTERVAL
-default to 1. Simply pass THUNK and nothing else to schedule THUNK to
-be run upon every update."
+ "Schedule THUNK in the current agenda to run after DELAY updates and
+run every INTERVAL updates thereafter. Both DELAY and INTERVAL default
+to 1. Simply pass THUNK and nothing else to schedule THUNK to be run
+upon every update."
(%agenda-schedule *current-agenda*
(lambda ()
(thunk)
@@ -187,9 +186,9 @@ be run upon every update."
delay))
(define (update-agenda)
- "Updates the current agenda."
+ "Update the current agenda."
(%update-agenda *current-agenda*))
(define (clear-agenda)
- "Clears the current agenda."
+ "Clear the current agenda."
(%clear-agenda *current-agenda*))