From d2d4ff9fc67f9221326c55c26c6de65372e62855 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 30 Mar 2023 20:16:08 +0200 Subject: [PATCH] Add progress% skeleton. --- progress.scm | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/progress.scm b/progress.scm index edec25b..fc74044 100644 --- a/progress.scm +++ b/progress.scm @@ -33,6 +33,12 @@ with-progress run-progress-break progress-break + + *progress%-width* + *progress%-step* + run-with-progress% + with-progress% + progress%-advance ) (import scheme @@ -87,6 +93,46 @@ ((_ body ...) (run-progress-break (lambda () body ...))))) + ;; Progress% visual configuration + (define *progress%-width* (make-parameter 40)) + + ;; Progress% time step configuration + (define *progress%-step* (make-parameter 0.01)) + + ;; Tracking the progress via set of parameters + (define *current-progress%* (make-parameter #f)) + (define *current-progress%-echo?* (make-parameter #f)) + (define *current-progress%-value* (make-parameter #f)) + + ;; Unconditionally prints the current progress. + (define (print-current-progress%) + (when (*current-progress%-echo?*) + #f)) + + ;; If the new value is different-enough from the current one, updates + ;; it and re-prints the progress% + (define (progress%-advance new-value) + (let ((old-value (*current-progress%-value*))) + #f)) + + ;; Procedure realizing the actual progress tracking + (define (run-with-progress% echo? name thunk) + (parameterize ((*current-progress%* name) + (*current-progress%-echo?* echo?) + (*current-progress%-value* 0)) + (print-current-progress%) + (let ((result (thunk))) + (print-current-progress%) + result))) + + ;; Runs named progress% + (define-syntax with-progress% + (syntax-rules () + ((_ echo? name body ...) + (run-with-progress% + echo? name + (lambda () body ...))))) + ;; If the program uses progress module, disable buffering (set-buffering-mode! (current-output-port) #:none)