(define-module (game scripts) #:export (make-scheduler current-scheduler scheduler-tick! scheduler-reset! script? run-script script-cancel! wait forever tween) #:use-module (ice-9 match) #:use-module (srfi srfi-9)) (define-record-type (%make-scheduler ticks num-tasks max-tasks tasks) scheduler? (ticks scheduler-ticks set-scheduler-ticks!) (num-tasks scheduler-num-tasks set-scheduler-num-tasks!) (max-tasks scheduler-max-tasks) (tasks scheduler-tasks)) (define (make-scheduler max-tasks) (%make-scheduler 0 0 max-tasks (make-vector max-tasks))) (define (scheduler-add! scheduler thunk delay) (match scheduler (($ ticks num-tasks max-tasks tasks) (unless (= num-tasks max-tasks) (vector-set! tasks num-tasks (cons (+ ticks delay) thunk)) (set-scheduler-num-tasks! scheduler (+ num-tasks 1)))))) (define (scheduler-tick! scheduler) (define (run-thunks thunks) (for-each (lambda (thunk) (thunk)) thunks)) (run-thunks (match scheduler (($ ticks num-tasks max-tasks tasks) (let ((t (+ ticks 1))) (let loop ((i 0) (k num-tasks) (to-run '())) (if (< i k) (match (vector-ref tasks i) ((t* . thunk) (if (<= t* t) (let ((k* (- k 1))) (vector-set! tasks i (vector-ref tasks k*)) (vector-set! tasks k* #f) (loop i k* (cons thunk to-run))) (loop (+ i 1) k to-run)))) (begin (set-scheduler-ticks! scheduler t) (set-scheduler-num-tasks! scheduler k) to-run)))))))) (define (scheduler-reset! scheduler) (match scheduler (($ ticks num-tasks max-tasks tasks) (set-scheduler-ticks! scheduler 0) (set-scheduler-num-tasks! scheduler 0) (do ((i 0 (+ i 1))) ((= i num-tasks)) (vector-set! tasks i #f))))) (define *scheduler* (make-scheduler 100)) (define current-scheduler (make-parameter *scheduler*)) (define current-script (make-parameter #f)) (define %script-tag (make-prompt-tag "script")) (define-record-type