diff options
| -rw-r--r-- | 2d/agenda.scm | 61 |
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*)) |