hackerbase/src/export-sheet.scm

;;
;; export-sheet.scm
;;
;; Export attendance sheet as MarkDown document.
;;
;; ISC License
;;
;; Copyright 2024 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(declare (unit export-sheet))

(module
 export-sheet
 (
  print-attendance-sheet
  )

 (import scheme
	 (chicken base)
	 (chicken string)
	 (chicken format)
	 (chicken sort)
	 srfi-1
	 mbase
	 brmember
	 brmember-format
	 util-bst-ldict
	 members-payments
	 util-format
	 members-fees
	 cal-period
	 cal-day)

 (define (print-attendance-sheet MB number)
   (print "\\documentclass{article}")
   (print "\\usepackage{fancyhdr}")
   (print "\\usepackage{longtable}")
   (print "\\usepackage{lastpage}")
   (print "\\usepackage[top=3cm,left=1cm,right=2cm,bottom=3cm]{geometry}")
   (print "\\lhead{}")
   (print
    (format
     "\\chead{Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A. ~A. ~A v sídle spolku}"
     number  
     (cal-day-day (*current-day*))
     (cal-day-month (*current-day*))
     (cal-day-year (*current-day*))
     ))
   (print "\\rhead{}")
   (print "\\renewcommand{\\headrulewidth}{0pt}")
   (print "\\lfoot{}")
   (print "\\cfoot{Strana \\thepage{} ze \\pageref*{LastPage}}")
   (print "\\rfoot{}")   
   (print "\\pagestyle{fancy}")
   (print "\\begin{document}")
   (print "\\begin{center}")
   (newline)
   (print "\\vskip1em")
   (newline)
   (define colnames
     '((id) Nick "Jméno" "Příjmení" (Fee) (Bilance) ("\\begin{minipage}{15mm}\\begin{center}Aktivní\\\\Měsíce\\end{center}\\end{minipage}") OK? Podpis))
   (print "\\renewcommand\\arraystretch{2.1}")
   (print
    (format
     "\\begin{longtable}{|~A|}"
     (string-intersperse
      (map
       (lambda (x)
	 (if (list? x)
	     "r" "l"))
       colnames)
      "|")))
   (print "\\hline")
   (print
    (string-intersperse
     (map
      (lambda (x)
	(format
	 "\\textbf{~A}"
	 (if (symbol? x)
	     (symbol->string x)
	     (if (string? x)
		 x
		 (if (string? (car x))
		     (car x)
		     (symbol->string (car x)))))))
      colnames)
     "&")
    "\\\\")
   (print "\\hline")
   (print "\\endhead")
   (define valid-voters 0)
   (define ok-balances 0)
   (define ok-actives 0)
   (let loop ((mrs (sort
		    (find-members-by-predicate
		     MB (lambda (mr)
			  (brmember-active? mr)))
		    (lambda (a b)
		      (string<? (brmember-nick a)
				(brmember-nick b))))))
     (when (not (null? mrs))
       (let* ((mr (car mrs))
	      (info (ldict-ref mr 'info))
	      (name (ldict-ref info 'name "ERROR"))
	      (name* (string-translate*
		      name
		      '(("_" . " "))))
	      (namel (string-split name*))
	      (sname (car (reverse namel)))
	      (fname
	       (string-intersperse
		(reverse
		 (cdr
		  (reverse namel)))
		" "))
	      (cal (member-calendar mr))
	      (rcal (reverse cal))
	      (rcal12
	       (if (> (length rcal) 12)
		   (take rcal 12)
		   rcal))
	      (acal12 (map cadr rcal12))
	      (acal12* (map (lambda (f) (if (memq 'active f) 1 0)) acal12))
	      (numactive (foldl + 0 acal12*))
	      (spec-fee (brmember-spec-fee mr))
	      (current-fee (if spec-fee
			       spec-fee
			       (member-calendar-entry->fee
				(list (*current-month*)
				      (brmember-flags mr)
				      spec-fee))))
	      (balance-ok? (>= (member-total-balance mr)
			      (- current-fee)))
	      (active-ok? (>= numactive 9))
	      (vote-ok? (and balance-ok? active-ok?))
	      )
	 (when balance-ok?
	   (set! ok-balances (+ ok-balances 1)))
	 (when active-ok?
	   (set! ok-actives (+ ok-actives 1)))
	 (when vote-ok?
	   (set! valid-voters (+ valid-voters 1)))
	 (print
	  (brmember-id mr)
	  " & "
	  (string-translate*
	   (brmember-nick mr)
	   '(("_" . "\\_")))
	  " & "
	  fname
	  " & "
	  sname
	  " & "
	  current-fee
	  " & "
	  "\\begin{minipage}{15mm}\\begin{flushright}"
	  (format-amount-tex
	   (member-total-balance mr))
	  "\\\\"
	  (if balance-ok?
	      "Bez~dluhu"
	      "---~~~~~~")
	  "\\end{flushright}\\end{minipage}"
	  " & "
	  ;(if balance-ok?
	  ;    "Y"
	  ;    "--")
	  ;" & "
	  "\\begin{minipage}{12mm}\\begin{center}"
	  numactive "/" 12
	  "\\\\"
	  (if active-ok?
	      "Splněno"
	      "\\phantom{Sp}---\\phantom{Sp}")
	  "\\end{center}\\end{minipage}"
	  " & "
	  ;(if active-ok?
	  ;    "Y"
	  ;    "--")
	  ;" & "
	  (if vote-ok?
	      "Y"
	      "--")
	  " & "
	  "~\\hskip24mm~"
	  " \\\\")
	 (print "\\hline")
	 (loop (cdr mrs)))))
   (print "\\end{longtable}")
   (print "\\end{center}")
   (print "\\end{document}")
   (print "% valid-voters = " valid-voters)
   (print "% valid-balances = " ok-balances)
   (print "% valid-actives = " ok-actives)
   )

 (define (format-amount-tex amt)
   (string-translate*
    (format-amount amt)
    '(("--" . "--{}--"))))

 )