Added `status-bar-string()`, `progress-bar-string()`: Create text status (polycharacter) / progress (duocharacter) bar strings.

Fixed hygine of `popor()` macro.

Fortune for cl-utils's current commit: Half curse − 半凶

flan-utils.lisp

@@ -24,7 +24,7 @@
 
 (defmacro defexport (&rest val)
   "Same as export*! for some reason"
-  `(export*! ,@val))
+  `(export*! ,@val)) ; TODO: Make this filter out non-defun/defparameter/defmacro statements from `val` before passing to `export*!`
 (export 'defexport)
 
 (defun file-get-contents (filename)
@@ -140,10 +140,12 @@
      (loop while (null (setf ret ,stmt)))
      ret))
 
-(defmacro popor (li or)
+  (defmacro popor (li or)
-  "If li is list, pop it, else return or"
+    "If li is list, pop it, else return or"
-  `(if (atom ,li) ,or
+    (let ((liname (gensym)))
-     (pop ,li)))
+      `(let ((,liname ,li))
+	 (if (atom ,liname) ,or
+	     (pop ,liname)))))
 
 (defun rand-in (l &key (random #'random) )
   "Random member of, slide right if nil"
@@ -646,7 +648,39 @@
   (let ((out (make-paged-vector blocksize)))
     (mapc #'(lambda (x) (paged-vector->push out x)) elements) out))
 
-(defmacro paged-vector<- (vec) `(car ,vec))
+  (defmacro paged-vector<- (vec) `(car ,vec))
+
+  (defun status-bar-string (percs &optional (sz (length percs)) (max nil) (default #\-))
+    "Create a bar string of multiple characters at a ratio. The most simple variant of this uses 2 chars at a ratio to create a text-based progress bar. (see `progress-bar-string')
+`percs': a list of (fract . char) 
+`sz': the length of the bar (default: length of `percs')
+`max': the max for `fract' (default: sum of all `fract's in `percs')
+`default': the char to print if we run above `max' while still under `sz' (default #\-) (note: `default' will never appear in the output string unless `max' is user-provided; otherwise `percs' will be stretched to always completely fill `sz')"
+    (let ((max (or max (apply #'+ (mapcar #'car percs)))))
+      (flet ((write-single (stream fract char cur)
+	       (let ((sml (* (/ fract max) sz)))
+		 (length (loop for i from cur to (- sz 1)
+			       for j from 0 to (- sz 1)
+			       while (< j sml)
+			       collect i ; XXX: This is very inefficient, come on...
+			       do
+				  (write-char char stream))))))
+	(with-output-to-string (stream)
+	  (let ((i 0))
+	    (loop while (< i sz) do
+	      (let ((this (pop percs)))
+		(incf i (if this
+		    (destructuring-bind (fract . char) this
+		      (funcall #'write-single stream fract char i))
+		    (prog1 1 (write-char default stream)))))))))))
+;(print (status-bar-string '((2 . #\: ) (8 . #\|) (3 . #\_) (1 . #\!)) 60))
+
+  (defun progress-bar-string (perc len &optional (char #\#) (default #\-))
+    "Create a progress bar string of `len' size containing `perc'% `char', with the rest `default'"
+    (status-bar-string `((,perc . ,char)) len 100 default))
+;(print (progress-bar-string 10 60))
+
+      
 
 ) ;; -- end export