1
0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-06-05 01:09:17 +02:00

- added rendering of polls.

This commit is contained in:
cage
2020-05-31 12:47:48 +02:00
parent d33af4ecbe
commit ab50276605
9 changed files with 241 additions and 37 deletions

View File

@ -230,3 +230,30 @@
(right-padding boosted-label padding-length)
boosted-username)))
text))
(defun poll->text (poll-id width)
(when poll-id
(when-let* ((poll (db:find-poll poll-id))
(options (db:all-poll-options poll-id))
(all-titles (loop for option in options collect (db:row-title option)))
(vote-sum (reduce #'+
(mapcar #'db:row-votes-count options)))
(max-title-w (find-max-line-length all-titles))
(max-bar-width (- width max-title-w 6))
(bar-char (swconf:vote-vertical-bar))
(expiredp (db:row-poll-expired-p poll)))
(with-output-to-string (stream)
(loop for option in options do
(let* ((title (left-padding (db:row-title option) max-title-w))
(rate (handler-case
(/ (db:row-votes-count option)
vote-sum)
(error () 0)))
(vote (left-padding (format nil "~a%" (* 100 rate)) 4))
(bar-w (truncate (* rate max-bar-width))))
(format stream "~a " title)
(loop for i from 0 below bar-w do
(princ bar-char stream))
(format stream " ~a~%" (left-padding vote (- max-bar-width bar-w)))))
(when expiredp
(format stream "~%~a~%" (_ "The poll has expired")))))))