brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Keep track of last displayed value.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-30 21:15:00 +02:00
parent 08e305bd5b
commit ca1270d7ae
4 changed files with 34 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

9
progress.scm
View file

@ -103,6 +103,7 @@
(define *current-progress%* (make-parameter #f))
(define *current-progress%-echo?* (make-parameter #f))
(define *current-progress%-value* (make-parameter #f))
(define *current-progress%-last-value* (make-parameter #f))
(define *current-progress%-range* (make-parameter (cons 0 1)))
;; Unconditionally prints the current progress.
@ -117,15 +118,16 @@
(value% (* 100 value))
(ivalue% (inexact->exact (round value%))))
(display
(sprintf "\r[]~A%" ivalue%)))))
(sprintf "\r[]~A% ~A" ivalue% (*current-progress%*))))))
;; If the new value is different-enough from the current one, updates
;; it and re-prints the progress%
(define (progress%-advance new-value)
(when (*current-progress%*)
(let ((old-value (*current-progress%-value*)))
(*current-progress%-value* new-value)
(let ((old-value (*current-progress%-last-value*)))
(when (>= (abs (- new-value old-value)) (*progress%-step*))
(*current-progress%-value* new-value)
(*current-progress%-last-value* new-value)
(print-current-progress%)))))
;; Procedure realizing the actual progress tracking
@ -133,6 +135,7 @@
(parameterize ((*current-progress%* name)
(*current-progress%-echo?* echo?)
(*current-progress%-value* 0)
(*current-progress%-last-value* 0)
(*current-progress%-range* (cons 0 1)))
(print-current-progress%)
(let ((result (thunk)))