[invoice.scm] add qrcode section

gnucash/report/reports/standard/invoice.scm

@@ -30,6 +30,9 @@
 (use-modules (gnucash app-utils))
 (use-modules (gnucash report))
 (use-modules (srfi srfi-1))
+(use-modules (ice-9 match))
+(use-modules (sxml simple))
+(use-modules (gnucash gnome-utils))
 
 (define (addif pred . data) (if pred data '()))
 
@@ -126,6 +129,9 @@
         (cons 'picture (list (cons 'text (G_ "Picture"))
                              (cons 'tip (G_ "Picture"))))
 
+        (cons 'qr (list (cons 'text (G_ "QR Code"))
+                        (cons 'tip (G_ "QR Code"))))
+
         ;; Translators: "(empty)" refers to invoice header section being left blank
         (cons 'none (list (cons 'text (G_ "(empty)"))
                           (cons 'tip (G_ "Empty space"))))))
@@ -179,6 +185,46 @@
 (define (multiline-to-html-text str)
   (gnc:multiline-to-html-text str))
 
+(define (data->svg data width size)
+  (define (make-rect row col)
+    (format #f "M~a,~ah~av~ah-~aZ " (* row size) (* col size) size size size))
+  (let lp ((col 0) (row 0) (data data) (retval '()))
+    (match data
+      (()
+       (call-with-output-string
+         (lambda (port)
+           (sxml->xml
+            `(svg (@ (xmlns "http://www.w3.org/2000/svg")
+                     (width ,(* width size))
+                     (height ,(* row size)))
+                  (title "QR code") (desc "QR code")
+                  (path (@ (d ,(string-concatenate retval)))))
+            port))))
+      ((datum . rest)
+       (let ((newcol (modulo (1+ col) width)))
+         (lp newcol (if (zero? newcol) (1+ row) row) rest
+             (if datum (cons (make-rect row col) retval) retval)))))))
+
+(define (make-qr-code invoice)
+  (let* ((book (gncInvoiceGetBook invoice))
+         (bic "*SAMPLE_BIC*")
+         (name (or (gnc:company-info book gnc:*company-name*) ""))
+         (iban "*SAMPLE_IBAN*")
+         (currency (gncInvoiceGetCurrency invoice))
+         (amt (string-append
+               (gnc-currency-get-mnemonic currency)
+               (xaccPrintAmount (gncInvoiceGetTotal invoice)
+                                (gnc-commodity-print-info currency #t))))
+         (purpose (gncInvoiceGetNotes invoice))
+         (ref (gncInvoiceGetID invoice))
+         (QRC
+          (string-join
+           (list "BCD\n001\n1\nSCT" bic name iban amt purpose ref)
+           "\n")))
+    (match (gnc-qrcode-encodestring QRC)
+      ((version width . data)
+       (data->svg data width 5)))))
+
 (define (options-generator variant)
 
   (define gnc:*report-options* (gnc:new-options))
@@ -799,6 +845,7 @@ for styling the invoice. Please see the exported report for the CSS class names.
                ;; Replace " #" by whatever is common as number abbreviation, i.e. "~a Nr. ~a"
                (invoice-title (format #f (G_"~a #~a") title (gncInvoiceGetID invoice)))
                (layout-lookup-table (list (cons 'none #f)
+                                          (cons 'qr (make-qr-code invoice))
                                           (cons 'picture (gnc:make-html-div/markup
                                                           "picture"
                                                           (make-img (opt-val "Layout" "Picture Location"))))