Preliminary QR code embedding.

This commit is contained in:
Dominik Pantůček 2025-01-03 16:56:59 +01:00
parent bbbc6527a0
commit 4d73afe3c5
3 changed files with 29 additions and 8 deletions

View file

@ -475,7 +475,8 @@ box-drawing.import.scm: $(BOX-DRAWING-SOURCES)
EXPORT-WEB-STATIC-SOURCES=export-web-static.scm brmember.import.scm \ EXPORT-WEB-STATIC-SOURCES=export-web-static.scm brmember.import.scm \
util-dir.import.scm mbase.import.scm \ util-dir.import.scm mbase.import.scm \
members-payments.import.scm cal-day.import.scm \ members-payments.import.scm cal-day.import.scm \
util-git.import.scm configuration.import.scm texts.import.scm util-git.import.scm configuration.import.scm texts.import.scm \
members-fees.import.scm qr-payment.import.scm
export-web-static.o: export-web-static.import.scm export-web-static.o: export-web-static.import.scm
export-web-static.import.scm: $(EXPORT-WEB-STATIC-SOURCES) export-web-static.import.scm: $(EXPORT-WEB-STATIC-SOURCES)
@ -579,7 +580,7 @@ MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \
mbase-query.o: mbase-query.import.scm mbase-query.o: mbase-query.import.scm
mbase-query.import.scm: $(MBASE-QUERY-SOURCES) mbase-query.import.scm: $(MBASE-QUERY-SOURCES)
QR-PAYMENT-SOURCES=qr-payment.scm QR-PAYMENT-SOURCES=qr-payment.scm util-io.import.scm
qr-payment.o: qr-payment.import.scm qr-payment.o: qr-payment.import.scm
qr-payment.import.scm: $(QR-PAYMENT-SOURCES) qr-payment.import.scm: $(QR-PAYMENT-SOURCES)

View file

@ -45,7 +45,9 @@
util-git util-git
configuration configuration
texts texts
logging) logging
qr-payment
members-fees)
;; HTML entities ;; HTML entities
(define (sanitize-html str) (define (sanitize-html str)
@ -110,6 +112,13 @@
(print "</dl>") (print "</dl>")
(print "</div>") (print "</div>")
(print "<div class=\"bi\">") (print "<div class=\"bi\">")
(let ((fee (member-calendar-entry->fee
(make-member-calendar-entry mr))))
(print "Fee: " fee)
(print (make-brmlab-qrp-svg-string
fee "CZK" (brmember-id mr))))
(print "</div>")
(print "<div class=\"bi\">")
(print "<h2>Payments History</h2>") (print "<h2>Payments History</h2>")
(print "<table>") (print "<table>")
(print "<thead><tr><th>Date</th><th>Type</th><th>Comment</th><th>Amount</th><th>Currency</th><th>Amount [CZK]</th><th>Balance</th></tr></thead>") (print "<thead><tr><th>Date</th><th>Type</th><th>Comment</th><th>Amount</th><th>Currency</th><th>Amount [CZK]</th><th>Balance</th></tr></thead>")

View file

@ -36,7 +36,8 @@
(import scheme (import scheme
(chicken format) (chicken format)
(chicken string) (chicken string)
(chicken base)) (chicken base)
util-io)
(define (make-empty-qrp . vs) (define (make-empty-qrp . vs)
(let ((v (if (null? vs) "1.0" (car vs)))) (let ((v (if (null? vs) "1.0" (car vs))))
@ -54,7 +55,7 @@
(string->number amt) (string->number amt)
amt)) amt))
(s (number->string n)) (s (number->string n))
(f (string-split str ".")) (f (string-split s "."))
(i? (null? (cdr f)))) (i? (null? (cdr f))))
(format "~A.~A" (format "~A.~A"
(car f) (car f)
@ -65,7 +66,7 @@
0 2))))) 0 2)))))
(define (make-qrp iban amt cc vs msg) (define (make-qrp iban amt cc vs msg)
(let loop ((keys '(ACC AM CC MSG X-CS)) (let loop ((keys '(ACC AM CC MSG X-VS))
(vals (list iban (ensure-amount-format amt) cc msg vs)) (vals (list iban (ensure-amount-format amt) cc msg vs))
(qrp (make-empty-qrp))) (qrp (make-empty-qrp)))
(if (null? keys) (if (null? keys)
@ -83,8 +84,18 @@
(make-qrp iban amt cc vs "Brmlab"))) (make-qrp iban amt cc vs "Brmlab")))
(define (qrp-create-svg-string qrps) (define (qrp-create-svg-string qrps)
;; qrencode -t svg -o - -l M (let-values
"TODO") (((ec ol)
(get-process-exit+output-lines
"qrencode"
"-t" "svg"
"--inline"
"-o" "-"
"-l" "M"
qrps)))
(if (eq? ec 0)
(string-intersperse ol "\n")
#f)))
(define (make-brmlab-qrp-svg-string amt cc vs) (define (make-brmlab-qrp-svg-string amt cc vs)
(qrp-create-svg-string (qrp-create-svg-string